/[mws]/trunk/httpd.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/httpd.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 28 by dpavlin, Sat May 8 22:18:38 2004 UTC revision 42 by dpavlin, Mon May 10 22:04:01 2004 UTC
# Line 5  Line 5 
5    
6  use strict;  use strict;
7  use warnings;  use warnings;
8    use MWS::SWISH;
9    #use MWS::Plucene;
10  use HTTP::Daemon;  use HTTP::Daemon;
11  use HTTP::Status;  use HTTP::Status;
12  use IO::String;  use IO::String;
13  use CGI::Lite;  use CGI::Lite;
14  use Template;  use Template;
 use MWS;  
15  use URI::Escape;  use URI::Escape;
16    
17  use Data::Dumper;  use Data::Dumper;
# Line 28  be used. Line 29  be used.
29          exit 1;          exit 1;
30  }  }
31    
32  my $d = HTTP::Daemon->new( Reuse => 1, LocalPort => 6969 ) || die;  my $mws = MWS::SWISH->new(config_file => $config_file);
33    #my $mws = MWS::Plucene->new(config_file => $config_file, debug => $debug);
34    
35    my ($local_addr,$local_port) = ('127.0.0.1',6969);
36    
37    my $listen = $mws->{config}->val('global', 'listen');
38    
39    print STDERR "using listen $listen\n" if ($listen);
40    
41    if ($listen && $listen =~ m/:/) {
42            ($local_addr,$local_port) = split(/:/,$listen,2);
43    } elsif ($listen) {
44            $local_addr = $listen;
45    }
46    
47    my $d = HTTP::Daemon->new(
48            Reuse => 1,
49            LocalAddr => $local_addr,
50            LocalPort => $local_port,
51    ) || die "can't create HTTP::Daemon on $local_addr:$local_port: $!";
52    
53  my $cgi = new CGI::Lite;  my $cgi = new CGI::Lite;
 my $mws = MWS->new($config_file);  
54  my $tt = Template->new({  my $tt = Template->new({
55          INCLUDE_PATH => $mws->{config}->val('global', 'templates'),          INCLUDE_PATH => $mws->{config}->val('global', 'templates'),
56          FILTERS => {          FILTERS => {
# Line 85  while ( my $c = $d->accept ) { Line 105  while ( my $c = $d->accept ) {
105                  my $url = $r->url->path;                  my $url = $r->url->path;
106    
107                  # XXX LOG                  # XXX LOG
108                  print $r->method," ",$url,"\n",Dumper($param),"\n" if ($debug);                  print $r->method," ",$url,"\n";
109                    print Dumper($param,$mws->{counter}),"\n" if ($debug);
110    
111                  # is this static page?                  # is this static page?
112                  if ($static_html && -f "$static_html/$url") {                  if ($static_html && -f "$static_html/$url") {
# Line 173  while ( my $c = $d->accept ) { Line 194  while ( my $c = $d->accept ) {
194                          $tpl_var->{results} = \@res if (@res);                          $tpl_var->{results} = \@res if (@res);
195                          $tpl_var->{total_hits} = $mws->{total_hits} || 0;                          $tpl_var->{total_hits} = $mws->{total_hits} || 0;
196    
197                            # no hits, offer suggestions
198                            if (! $tpl_var->{results}) {
199                                    @{$tpl_var->{apropos}} = $mws->apropos_index($param->{'search_fld'}, $param->{'search_val'});
200                            }
201    
202                  }                  }
203    
204    
205                  # push counters to template                  # push counters to template
206                  foreach my $f (qw(from to cc bcc)) {                  foreach my $f (qw(from to cc bcc folder)) {
207                          my $h = $mws->counter($f) || next;                          my $h = $mws->counter($f) || next;
208                          my @a;                          my @a;
209                          foreach my $k (sort { $h->{$b}->{usage} <=> $h->{$a}->{usage} } keys %$h) {                          foreach my $k (sort { $h->{$b}->{usage} <=> $h->{$a}->{usage} } keys %$h) {
# Line 208  while ( my $c = $d->accept ) { Line 234  while ( my $c = $d->accept ) {
234  # template toolkit filter  # template toolkit filter
235    
236  sub html_escape($) {  sub html_escape($) {
237          my $text = shift;          my $text = shift || return;
238    
239            # don't re-escape html
240            #return $text if ($text =~ /&(?:lt|gt|amp|quot);/);
241    
242          # Escape <, >, & and ", and to produce valid XML          # Escape <, >, & and ", and to produce valid XML
243          my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');          my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
244          my $escape_re  = join '|' => keys %escape;          my $escape_re  = join '|' => keys %escape;
245    
246          $text =~ s/($escape_re)/$escape{$1}/gs;          $text =~ s/($escape_re)/$escape{$1}/gs;
247    
248            while ($text =~ s/#-#(quote|signature)(\d*)##(.+?)##\1\2#-#/<span class="$1">$3<\/span>/gs) { } ;
249    
250          return $text;          return $text;
251  }  }
252    
# Line 224  sub body5_filter { Line 256  sub body5_filter {
256          my $text = shift;          my $text = shift;
257    
258          # remove quote          # remove quote
259          $text =~ s/^[\>:\|=]+\s*.*?$/#-q-#/msg;          $text =~ s/^[\>:\|=]+[^\n\r]*[\n\r]*$/#-q-#/msg;
260          # remove quote author          # remove quote author
261          $text =~ s/[\n\r]+[^\n\r]+:\s*(:?#-q-#[\n\r*])+//gs;          $text =~ s/[\n\r]+[^\n\r]+:\s*(?:#-q-#[\n\r*])+//gs;
262          $text =~ s/^[^\n\r]+:\s*(:?#-q-#[\n\r]*)+//gs;          $text =~ s/^[^\n\r]+:\s*(?:#-q-#[\n\r]*)+//gs;
263            $text =~ s/#-q-#[\n\r]*//gs;
264          # outlook quoting          # outlook quoting
265          $text =~ s/(\s*--+\s*Original\s+Message\s*--+.*)$//si;          $text =~ s/(\s*--+\s*Original\s+Message\s*--+.*)$//si;
266          $text =~ s/(\s*--+\s*Forwarded\s+message\s*from\s+.+\s*--+.*)$//si;          $text =~ s/(\s*--+\s*Forwarded\s+message.+\s*--+.*)$//si;
267    
268          # remove signature          # remove signature
269          $text =~ s/[\n\r]+--\s*[\n\r]+.*$//s;          $text =~ s/[\n\r]+--\s*[\n\r]+.*$//s;
# Line 242  sub body5_filter { Line 275  sub body5_filter {
275          $text =~ s/^\n+//gs;          $text =~ s/^\n+//gs;
276          $text =~ s/[\s\n]+$//gs;          $text =~ s/[\s\n]+$//gs;
277    
278            if ($text eq "") {
279                    $text="#-#quote##forwarded message##quote#-#";
280            }
281    
282          # cut to 5 lines;          # cut to 5 lines;
283          if ($text =~ s,^((?:.*?[\n\r]){5}).*$,$1,s) {          if ($text =~ s,^((?:.*?[\n\r]){5}).*$,$1,s) {
284                  $text =~ s/[\n\r]*$/ .../;                  $text =~ s/[\n\r]*$/ .../;
# Line 264  sub body_filter { Line 301  sub body_filter {
301          }          }
302    
303          # find quoted text          # find quoted text
304          $text =~ s/^([\>:\|=]+\s*.*?)$/#-#quote##$1##quote#-#/msg;          $text =~ s/^([\>:\|=]+[^\n\r]*[\n\r]*)$/#-#quote1##$1##quote1#-#/mg;
305          $text =~ s/(--+\s*Original\s+Message\s*--+.*)$/#-#quote##$1##quote#-#/si || $text =~ s/(--+\s*Forwarded\s+message\s*from\s+.+\s*--+.*)$/#-#quote##$1##quote#-#/si;          $text =~ s/(--+\s*Original\s+Message\s*--+.*)$/#-#quote2##$1##quote2#-#/si;
306            $text =~ s/(--+\s*Forwarded\s+message.+\s*--+.*)$/#-#quote3##$1##quote3#-#/si;
307    
308          $text = html_escape($text . $sig);          $text = html_escape($text . $sig);
         $text =~ s/#-#(quote|signature)##(.+?)##(\1)#-#/<span class="$1">$2<\/span>/gs;  
309          return $text;          return $text;
310  }  }
311    
Legend:
Removed from v.28  
changed lines
  Added in v.42
  ViewVC Help
Powered by ViewVC 1.1.26