/[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 34 by dpavlin, Sun May 9 10:16:51 2004 UTC revision 43 by dpavlin, Tue May 11 15:36:51 2004 UTC
# Line 3  Line 3 
3  # based on post  # based on post
4  # http://www.mail-archive.com/libwww@perl.org/msg04750.html  # http://www.mail-archive.com/libwww@perl.org/msg04750.html
5    
6    BEGIN {
7            my $basedir = readlink($0) || $0; $basedir =~ s#/[^/]+$##;
8            unshift(@INC, $basedir);
9    }
10    
11  use strict;  use strict;
12  use warnings;  use warnings;
13    use MWS::SWISH;
14    #use MWS::Plucene;
15  use HTTP::Daemon;  use HTTP::Daemon;
16  use HTTP::Status;  use HTTP::Status;
17  use IO::String;  use IO::String;
18  use CGI::Lite;  use CGI::Lite;
19  use Template;  use Template;
 use MWS;  
20  use URI::Escape;  use URI::Escape;
21    
22  use Data::Dumper;  use Data::Dumper;
# Line 28  be used. Line 34  be used.
34          exit 1;          exit 1;
35  }  }
36    
37  my $d = HTTP::Daemon->new( Reuse => 1, LocalPort => 6969 ) || die;  my $mws = MWS::SWISH->new(config_file => $config_file);
38    #my $mws = MWS::Plucene->new(config_file => $config_file, debug => $debug);
39    
40    my ($local_addr,$local_port) = ('127.0.0.1',6969);
41    
42    my $listen = $mws->{config}->val('global', 'listen');
43    
44    print STDERR "using listen $listen\n" if ($listen);
45    
46    if ($listen && $listen =~ m/:/) {
47            ($local_addr,$local_port) = split(/:/,$listen,2);
48    } elsif ($listen) {
49            $local_addr = $listen;
50    }
51    
52    my $d = HTTP::Daemon->new(
53            Reuse => 1,
54            LocalAddr => $local_addr,
55            LocalPort => $local_port,
56    ) || die "can't create HTTP::Daemon on $local_addr:$local_port: $!";
57    
58  my $cgi = new CGI::Lite;  my $cgi = new CGI::Lite;
 my $mws = MWS->new($config_file);  
59  my $tt = Template->new({  my $tt = Template->new({
60          INCLUDE_PATH => $mws->{config}->val('global', 'templates'),          INCLUDE_PATH => $mws->{config}->val('global', 'templates'),
61          FILTERS => {          FILTERS => {
# Line 86  while ( my $c = $d->accept ) { Line 111  while ( my $c = $d->accept ) {
111    
112                  # XXX LOG                  # XXX LOG
113                  print $r->method," ",$url,"\n";                  print $r->method," ",$url,"\n";
114                  print Dumper($param),"\n" if ($debug);                  print Dumper($param,$mws->{counter}),"\n" if ($debug);
115    
116                  # is this static page?                  # is this static page?
117                  if ($static_html && -f "$static_html/$url") {                  if ($static_html && -f "$static_html/$url") {
# Line 183  while ( my $c = $d->accept ) { Line 208  while ( my $c = $d->accept ) {
208    
209    
210                  # push counters to template                  # push counters to template
211                  foreach my $f (qw(from to cc bcc)) {                  foreach my $f (qw(from to cc bcc folder)) {
212                          my $h = $mws->counter($f) || next;                          my $h = $mws->counter($f) || next;
213                          my @a;                          my @a;
214                          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 217  sub html_escape($) { Line 242  sub html_escape($) {
242          my $text = shift || return;          my $text = shift || return;
243    
244          # don't re-escape html          # don't re-escape html
245          #return $text if ($text =~ /&(:?lt|gt|amp|quot);/);          #return $text if ($text =~ /&(?:lt|gt|amp|quot);/);
246    
247          # Escape <, >, & and ", and to produce valid XML          # Escape <, >, & and ", and to produce valid XML
248          my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');          my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
# Line 236  sub body5_filter { Line 261  sub body5_filter {
261          my $text = shift;          my $text = shift;
262    
263          # remove quote          # remove quote
264          $text =~ s/^[\>:\|=]+\s*.*?$/#-q-#/msg;          $text =~ s/^[\>:\|=]+[^\n\r]*[\n\r]*$/#-q-#/msg;
265          # remove quote author          # remove quote author
266          $text =~ s/[\n\r]+[^\n\r]+:\s*(:?#-q-#[\n\r*])+//gs;          $text =~ s/[\n\r]+[^\n\r]+:\s*(?:#-q-#[\n\r*])+//gs;
267          $text =~ s/^[^\n\r]+:\s*(:?#-q-#[\n\r]*)+//gs;          $text =~ s/^[^\n\r]+:\s*(?:#-q-#[\n\r]*)+//gs;
268          $text =~ s/#-q-#[\n\r]*//gs;          $text =~ s/#-q-#[\n\r]*//gs;
269          # outlook quoting          # outlook quoting
270          $text =~ s/(\s*--+\s*Original\s+Message\s*--+.*)$//si;          $text =~ s/(\s*--+\s*Original\s+Message\s*--+.*)$//si;
# Line 281  sub body_filter { Line 306  sub body_filter {
306          }          }
307    
308          # find quoted text          # find quoted text
309          $text =~ s/^([\>:\|=]+\s*.*?)$/#-#quote1##$1##quote1#-#/msg;          $text =~ s/^([\>:\|=]+[^\n\r]*[\n\r]*)$/#-#quote1##$1##quote1#-#/mg;
310          $text =~ s/(--+\s*Original\s+Message\s*--+.*)$/#-#quote2##$1##quote2#-#/si;          $text =~ s/(--+\s*Original\s+Message\s*--+.*)$/#-#quote2##$1##quote2#-#/si;
311          $text =~ s/(--+\s*Forwarded\s+message.+\s*--+.*)$/#-#quote3##$1##quote3#-#/si;          $text =~ s/(--+\s*Forwarded\s+message.+\s*--+.*)$/#-#quote3##$1##quote3#-#/si;
312    
Legend:
Removed from v.34  
changed lines
  Added in v.43
  ViewVC Help
Powered by ViewVC 1.1.26