From: Dave Howorth Date: Tue, 22 Nov 2005 13:47:12 +0000 (+0000) Subject: Added Maypole::HTTPD X-Git-Tag: 2.11~86 X-Git-Url: https://git.decadent.org.uk/gitweb/?a=commitdiff_plain;h=42037fd596bf3cda5209035c551afafdacbe6ff0;p=maypole.git Added Maypole::HTTPD git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@432 48953598-375a-da11-a14b-00016c27c3ee --- diff --git a/lib/Maypole/HTTPD.pm b/lib/Maypole/HTTPD.pm new file mode 100644 index 0000000..bda6a76 --- /dev/null +++ b/lib/Maypole/HTTPD.pm @@ -0,0 +1,120 @@ +package Maypole::HTTPD; +use strict; +use warnings; + +use base 'HTTP::Server::Simple::CGI'; +use HTTP::Server::Simple::Static; +#use Maypole::HTTPD::Frontend; +use Maypole::Constants; +use UNIVERSAL::require; + +# signal to Maypole::Application +BEGIN { $ENV{MAYPOLE_HTTPD} = 1 } + +our $VERSION = '0.1'; + +=head1 NAME + +Maypole::HTTPD - Stand alone HTTPD for running Maypole Applications + +=head1 SYNOPSIS + + use Maypole::HTTPD; + my $httpd=Maypole::HTTPD->new(module=>"BeerDB"); + $httpd->run(); + +=head1 DESCRIPTION + +This is a stand-alone HTTPD for running your Maypole Applications. + +=cut + +=head2 new + +The constructor. Takes a hash of arguments. Currently supported: + port - TCP port to listen to + module - Maypole application Module name. +=cut + +sub new +{ + my ($class, %args) = @_; + my $self = $class->SUPER::new($args{port}); + $self->module($args{module}); + #eval "use $self->{module}"; + #die $@ if $@; + $self->module->require or die "Couldn't load driver: $@"; + $self->module->config->uri_base("http://localhost:".$self->port."/"); + return $self; +} + +=head2 module + +Accessor for application module. + +=cut + +sub module { + my $self = shift; + $self->{'module'} = shift if (@_); + return ( $self->{'module'} ); +} + +=head2 handle_request + +Handles the actual request processing. Should not be called directly. + +=cut + +sub handle_request +{ + my ($self,$cgi) = @_; + + my $rv; + my $path = $cgi->url( -absolute => 1, -path_info => 1 ); + + if ($path =~ m|^/static|) + { + $rv=DECLINED; + } + else + { + $rv = $self->module->run; + } + + if ($rv == OK) { + print "HTTP/1.1 200 OK\n"; + $self->module->output_now; + return; + } + elsif ($rv == DECLINED) + { + return $self->serve_static($cgi,"./"); + } + else + { + print "HTTP/1.1 404 Not Found\n\nPage not found"; + } +} + +1; + + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Marcus Ramberg, Emarcus@thefeed.no +Based on Simon Cozens' original implementation. + +=head1 COPYRIGHT AND LICENSE + +Copyright 2004 by Marcus Ramberg + + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/Maypole/HTTPD/Frontend.pm b/lib/Maypole/HTTPD/Frontend.pm new file mode 100644 index 0000000..bea8aa6 --- /dev/null +++ b/lib/Maypole/HTTPD/Frontend.pm @@ -0,0 +1,50 @@ +package Maypole::HTTPD::Frontend; +use strict; +use warnings; + +use CGI::Maypole 2.11; # 2.11 has collect_output() + +use base 'CGI::Maypole'; + +sub get_request { shift->cgi(CGI->new) } + +{ + my $output; + sub send_output { $output = shift->collect_output } + sub output_now { print $output; undef $output } +} + +1; + +=head1 NAME + +Maypole::HTTPD::Frontend - Maypole driver class for Maypole::HTTPD + +=head1 DESCRIPTION + +This is a simple CGI based Maypole driver for L. It's used +automatically as the frontend by L. + +It overrides the following functions in L: + +=over 4 + +=item get_request + +Instantiates a L object representing the request. + +=item send_output + +Stores generated output in a buffer. + +=back + +=head2 output_now + +Actually output what's been buffered by send_output. Used by L + +=head1 SEE ALSO + +L, L + +=cut