--- trunk/httpd.pl	2004/05/05 10:26:27	5
+++ trunk/httpd.pl	2004/05/06 23:06:08	16
@@ -8,10 +8,25 @@
 use HTTP::Daemon;
 use HTTP::Status;
 use IO::String;
-use CGI 2.50 qw/:standard :cgi-lib/;
+use CGI::Lite;
+use Template;
+use MWS;
+
+use Data::Dumper;
 
 my $d = HTTP::Daemon->new( Reuse => 1, LocalPort => 6969 ) || die;
-print "Please contact me at: <URL:", $d->url, ">\n";
+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 ) {
@@ -22,70 +37,121 @@
 		$ENV{'SERVER_PROTOCOL'}   = $r->protocol;
 		$ENV{'CONTENT_TYPE'}      = $r->content_type;
 
-		my $form_parameters;    # GET/POST storage.
+		# this part is based on CGI::Lite
+
+		$cgi->close_all_files();
+		$cgi->{web_data}       = {};
+		$cgi->{ordered_keys}   = [];
+		$cgi->{all_handles}    = [];
+		$cgi->{error_status}   = 0;
+		$cgi->{error_message}  = undef;
 
-		# is this a happy GET?
 		if ( $r->method eq 'GET' || $r->uri =~ /\?/ ) {
-			$form_parameters = $r->uri;
-			$form_parameters =~ s/[^\?]+\?(.*)/$1/;
-			$CGI::Q = new CGI($form_parameters);
+			my $query_string = $r->uri;
+			$query_string =~ s/[^\?]+\?(.*)/$1/;
+			$cgi->_decode_url_encoded_data (\$query_string, 'form');
+
+		} elsif ( $r->method eq 'POST' ) {
+
+			if ($r->content_type eq 'application/x-www-form-urlencoded') {
+#				local $^W = 0;
+				$cgi->_decode_url_encoded_data (\$r->content, 'form');
+			} elsif ($r->content_type =~ /multipart\/form-data/) {
+				my ($boundary) = $r->content_type =~ /boundary=(\S+)$/;
+				$cgi->_parse_multipart_data ($r->content_length, $boundary);
+			}
+		} else {
+			 $c->send_error(RC_FORBIDDEN);
 		}
 
-		# possibly POST?
-		if ( $r->method eq 'POST' ) {
+		my $param = $cgi->{web_data};
+		my $url = $r->url->path;
 
-			# now decide how we want to turn the parameters
-			# over to CGI.pm. note that this will cause
-			# problems with your STDIN with multipart forms.
-			my $form_parameters = $r->content;
-			$ENV{'CONTENT_LENGTH'} = $r->content_length || 0;
-
-			# sounds like multipart.
-			if ( $form_parameters =~ /^--/ ) {
-
-				my ($boundary) = split ( /\n/, $form_parameters );
-				chop($boundary);
-				substr( $boundary, 0, 2 ) = '';    # delete the leading "--" !!!
-				$ENV{'CONTENT_TYPE'} =
-				  $r->content_type . "; boundary=$boundary";
-
-				# this breaks STDIN forever. I've yet to discover
-				# how to properly save and reassign STDIN after
-				# we're done breaking things horrifically here.
-				close STDIN;
-				my $t = tie *STDIN, 'IO::String';
-				$t->open($form_parameters);
-				$CGI::Q = new CGI();
-			}
+		# XXX LOG
+		print $r->method," ",$url,Dumper($param);
 
-			else { $CGI::Q = new CGI($form_parameters); }
+		# template file name (use ?format=html as default)
+		my $tpl_file = 'master.';
+		$tpl_file .= $param->{'format'} || 'html';
+
+		#
+		# implement functionality and generate HTML
+		#
+		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);
 		}
 
-		if (! $CGI::Q) {
-			 $c->send_error(RC_FORBIDDEN);
-		}
+		my $tpl_var = {
+			param	=> $param
+		};
 
-		my $param = param("hello") || '';
-		my $url = $r->url->path;
+		# show search results
+		# ?search=foo:bar
+		if ($param->{'search'}) {
 
-		print "I saw: $param\n";
+			print STDERR "search: ",$param->{'search'},"\n";
 
-		#      my $f = param("thefile");
-		#      print "thefile filename: $f\n";
-		#      { undef $/; print "thefile size: ", length(<$f>), "\n" }
+			my $results = $mws->search($param->{'search'});
+			my @res = $mws->fetch_all_results();
+
+			$tpl_var->{results} = \@res;
 
-		my $res = HTTP::Response->new(RC_OK);
-		$res->content( qq{
-<html>
-	hello = $param<br>
-	URL: $url
-</html>
-	}
-		);
 
+		#
+		# ?show_id=XXXXxxxx___message_id___xxxxXXXX
+		} elsif ($param->{'show_id'}) {
+			
+			my $row = $mws->fetch_result_by_id($param->{'show_id'});
+			$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->content($html);
 		$c->send_response($res);
 
 		$c->close;
 	}
 	undef($c);
 }
+
+# template toolkit filter
+
+#use Text::Context::EitherSide;
+
+sub body5_filter {
+	my $text = shift;
+	$text =~ s/^\s+//gs;
+	$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;
+}