mws/trunk/httpd.pl

#!/usr/bin/perl

# based on post 
# http://www.mail-archive.com/libwww@perl.org/msg04750.html

use strict;
use warnings;
use HTTP::Daemon;
use HTTP::Status;
use IO::String;
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,
        },
});


while ( my $c = $d->accept ) {
        while ( my $r = $c->get_request ) {

                # environs that a webserver should set.
                $ENV{'REQUEST_METHOD'}    = $r->method;
                $ENV{'GATEWAY_INTERFACE'} = "CGI/1.0";
                $ENV{'SERVER_PROTOCOL'}   = $r->protocol;
                $ENV{'CONTENT_TYPE'}      = $r->content_type;

                # 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;

                if ( $r->method eq 'GET' || $r->uri =~ /\?/ ) {
                        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);
                }

                my $param = $cgi->{web_data};
                my $url = $r->url->path;

                # XXX LOG
                print $r->method," ",$url,Dumper($param);

                # generate HTML
                my $html;

                my $s=$param->{'search'};

                if ($s) {

                        print STDERR "search: $s\n";

                        my $results = $mws->search($s);

                        my @res = $mws->fetch_all_results();

                        my $tpl_file = 'master.';
                        $tpl_file .= $param->{'format'} || 'html';

                        $tt->process($tpl_file, {
                                query   => $s,
                                results => \@res,
                                param   => $param,
                        }, \$html) || die $tt->error();
                }

                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

sub body5_filter {
        my $text = shift;
        $text =~ s/^\s+//gs;
        $text =~ s/^(.*?[\n\r]+){5}.*$/$1/s;
        return $text;
}
1	dpavlin	5	#!/usr/bin/perl
2
3			# based on post
4			# http://www.mail-archive.com/libwww@perl.org/msg04750.html
5
6			use strict;
7			use warnings;
8			use HTTP::Daemon;
9			use HTTP::Status;
10			use IO::String;
11	dpavlin	6	use CGI::Lite;
12			use Template;
13			use MWS;
14	dpavlin	5
15	dpavlin	6	use Data::Dumper;
16
17	dpavlin	5	my $d = HTTP::Daemon->new( Reuse => 1, LocalPort => 6969 ) \|\| die;
18			print "Please contact me at: <URL:", $d->url, ">\n";
19
20	dpavlin	6	my $cgi = new CGI::Lite;
21			my $mws = MWS->new('global.conf');
22			my $tt = Template->new({
23			INCLUDE_PATH => $mws->{config}->val('global', 'templates'),
24			FILTERS => {
25			'body5' => \&body5_filter,
26			},
27			});
28
29
30	dpavlin	5	while ( my $c = $d->accept ) {
31			while ( my $r = $c->get_request ) {
32
33			# environs that a webserver should set.
34			$ENV{'REQUEST_METHOD'} = $r->method;
35			$ENV{'GATEWAY_INTERFACE'} = "CGI/1.0";
36			$ENV{'SERVER_PROTOCOL'} = $r->protocol;
37			$ENV{'CONTENT_TYPE'} = $r->content_type;
38
39	dpavlin	6	# this part is based on CGI::Lite
40	dpavlin	5
41	dpavlin	6	$cgi->close_all_files();
42			$cgi->{web_data} = {};
43			$cgi->{ordered_keys} = [];
44			$cgi->{all_handles} = [];
45			$cgi->{error_status} = 0;
46			$cgi->{error_message} = undef;
47
48	dpavlin	5	if ( $r->method eq 'GET' \|\| $r->uri =~ /\?/ ) {
49	dpavlin	6	my $query_string = $r->uri;
50			$query_string =~ s/[^\?]+\?(.*)/$1/;
51			$cgi->_decode_url_encoded_data (\$query_string, 'form');
52
53			} elsif ( $r->method eq 'POST' ) {
54
55			if ($r->content_type eq 'application/x-www-form-urlencoded') {
56			# local $^W = 0;
57			$cgi->_decode_url_encoded_data (\$r->content, 'form');
58			} elsif ($r->content_type =~ /multipart\/form-data/) {
59			my ($boundary) = $r->content_type =~ /boundary=(\S+)$/;
60			$cgi->_parse_multipart_data ($r->content_length, $boundary);
61			}
62			} else {
63			$c->send_error(RC_FORBIDDEN);
64	dpavlin	5	}
65
66	dpavlin	6	my $param = $cgi->{web_data};
67			my $url = $r->url->path;
68	dpavlin	5
69	dpavlin	6	# XXX LOG
70			print $r->method," ",$url,Dumper($param);
71	dpavlin	5
72	dpavlin	6	# generate HTML
73			my $html;
74	dpavlin	5
75	dpavlin	6	my $s=$param->{'search'};
76	dpavlin	5
77	dpavlin	6	if ($s) {
78	dpavlin	5
79	dpavlin	6	print STDERR "search: $s\n";
80	dpavlin	5
81	dpavlin	6	my $results = $mws->search($s);
82	dpavlin	5
83	dpavlin	6	my @res = $mws->fetch_all_results();
84	dpavlin	5
85	dpavlin	6	my $tpl_file = 'master.';
86			$tpl_file .= $param->{'format'} \|\| 'html';
87	dpavlin	5
88	dpavlin	6	$tt->process($tpl_file, {
89			query => $s,
90			results => \@res,
91			param => $param,
92			}, \$html) \|\| die $tt->error();
93			}
94	dpavlin	5
95			my $res = HTTP::Response->new(RC_OK);
96	dpavlin	6	$res->header( 'Content-type' => 'text/html; charset=iso-8859-2' );
97			$res->content($html);
98	dpavlin	5	$c->send_response($res);
99
100			$c->close;
101			}
102			undef($c);
103			}
104	dpavlin	6
105			# template toolkit filter
106
107			sub body5_filter {
108			my $text = shift;
109			$text =~ s/^\s+//gs;
110			$text =~ s/^(.?[\n\r]+){5}.$/$1/s;
111			return $text;
112			}