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 (file)
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<Maypole>
+
+=head1 AUTHOR
+
+Marcus Ramberg, E<lt>marcus@thefeed.no<gt>
+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 (file)
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<Maypole::HTTPD>. It's used 
+automatically as the frontend by L<Maypole::Application>.
+
+It overrides the following functions in L<CGI::Maypole>:
+
+=over 4
+
+=item get_request
+
+Instantiates a L<CGI> 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<Maypole::HTTPD>
+
+=head1 SEE ALSO
+
+L<Maypole>, L<Maypole::HTTPD>
+
+=cut