--- trunk/httpd.pl 2004/05/05 15:38:35 7 +++ trunk/httpd.pl 2004/05/07 11:25:01 17 @@ -14,18 +14,21 @@ use Data::Dumper; -my $d = HTTP::Daemon->new( Reuse => 1, LocalPort => 6969 ) || die; -print "Please contact me at: url, ">\n"; +my $debug = 1; +my $d = HTTP::Daemon->new( Reuse => 1, LocalPort => 6969 ) || die; my $cgi = new CGI::Lite; my $mws = MWS->new('global.conf'); my $tt = Template->new({ INCLUDE_PATH => $mws->{config}->val('global', 'templates'), FILTERS => { 'body5' => \&body5_filter, + 'subject_search' => \&subject_search_filter, }, }); +print "Web server ready at: ", $d->url, "\n"; + while ( my $c = $d->accept ) { while ( my $r = $c->get_request ) { @@ -67,7 +70,7 @@ my $url = $r->url->path; # XXX LOG - print $r->method," ",$url,Dumper($param); + print $r->method," ",$url,"\n",Dumper($param),"\n" if ($debug); # template file name (use ?format=html as default) my $tpl_file = 'master.'; @@ -78,6 +81,16 @@ # my $html; + if ($param->{'search_val'} && $param->{'search_fld'} && !$param->{'search'}) { + $param->{'search'} = $param->{'search_fld'}.":".$param->{'search_val'}; + } elsif ($param->{'search'}) { + ($param->{'search_fld'}, $param->{'search_val'}) = split(/:/,$param->{'search'},2); + } + + my $tpl_var = { + param => $param + }; + # show search results # ?search=foo:bar if ($param->{'search'}) { @@ -87,28 +100,26 @@ my $results = $mws->search($param->{'search'}); my @res = $mws->fetch_all_results(); - $tt->process($tpl_file, { - query => $param->{'search'}, - results => \@res, - param => $param, - }, \$html) || die $tt->error(); + $tpl_var->{results} = \@res; + $tpl_var->{total_hits} = $mws->{total_hits}; + # # ?show_id=XXXXxxxx___message_id___xxxxXXXX } elsif ($param->{'show_id'}) { my $row = $mws->fetch_result_by_id($param->{'show_id'}); - $tt->process($tpl_file, { - message => $row, - }, \$html) || die $tt->error(); + $tpl_var->{message} = $row; } + $tt->process($tpl_file, $tpl_var, \$html) || die $tt->error(); + # # send HTMLto client # my $res = HTTP::Response->new(RC_OK); - $res->header( 'Content-type' => 'text/html; charset=iso-8859-2' ); + $res->header( 'Content-type' => 'text/html; charset=ISO-8859-2' ); $res->content($html); $c->send_response($res); @@ -119,12 +130,31 @@ # template toolkit filter +#use Text::Context::EitherSide; + sub body5_filter { my $text = shift; $text =~ s/^\s+//gs; - $text =~ s/[\n\r]+[\>:\|=]+\s*.*?[\n\r]+//sg; # remove quoted text - $text =~ s,^((?:.*?[\n\r]){5}).*$,$1--8<--[cut]--8<--,s; + $text =~ s/^[\>:\|=]+\s*.*?$//msg; # remove quoted text + $text =~ s/[\n\r]+/\n/gs; # compress cr/lf + if ($text =~ s,^((?:.*?[\n\r]){5}).*$,$1,s) { + $text =~ s/[\n\r]*$/ .../; + } $text =~ s/[\n\r]+--\s*[\n\r]+.*$//s; + +# my $context = Text::Context::EitherSide->new($text, context => 5); +# return $context->as_string("perl"); + return $text; } +sub subject_search_filter { + my $s = shift; + # remove re: fdw: [list] preffixes from e-mail + while ( $s =~ s/^\s*\[(?:re|fwd|fw):\s+(.+)\]\s*$/$1/ig || + $s =~ s/^\s*(?:re|fwd|fw):\s+(.+?)\s*$/$1/ig || + $s =~ s/^\[\S+\]\s*//ig || + $s =~ s/^\[[^@]+@\w+\.\w+\s*:\s+(.+)\s*\]\s*$/$1/g + ) { }; + return $s; +}