lib/Maypole/HTTPD.pm

   1 package Maypole::HTTPD;
   2 use strict;
   3 use warnings;
   4
   5 use base 'HTTP::Server::Simple::CGI';
   6 use HTTP::Server::Simple::Static;
   7 use Maypole::Constants;
   8 use UNIVERSAL::require;
   9
  10 # signal to Maypole::Application
  11 BEGIN { $ENV{MAYPOLE_HTTPD} = 1 }
  12
  13 our $VERSION = '0.1';
  14
  15 =head1 NAME
  16
  17 Maypole::HTTPD - Stand alone HTTPD for running Maypole Applications
  18
  19 =head1 SYNOPSIS
  20
  21   use Maypole::HTTPD;
  22   my $httpd=Maypole::HTTPD->new(module=>"BeerDB");
  23   $httpd->run();
  24
  25 =head1 DESCRIPTION
  26
  27 This is a stand-alone HTTPD for running your Maypole Applications.
  28
  29 =cut
  30
  31 =head2 new
  32
  33 The constructor. Takes a hash of arguments. Currently supported:
  34     port - TCP port to listen to
  35     module - Maypole application Module name.
  36 =cut
  37
  38 sub new
  39 {
  40         my ($class, %args) = @_;
  41         my $self = $class->SUPER::new($args{port});
  42         $self->module($args{module});
  43         #eval "use $self->{module}";
  44     #die $@ if $@;
  45     $self->module->require or die "Couldn't load driver: $@";
  46         $self->module->config->uri_base("http://localhost:".$self->port."/");
  47         return $self;
  48 }
  49
  50 =head2 module
  51
  52 Accessor for application module.
  53
  54 =cut
  55
  56 sub module {
  57     my $self = shift;
  58     $self->{'module'} = shift if (@_);
  59     return ( $self->{'module'} );
  60 }
  61
  62 =head2 handle_request
  63
  64 Handles the actual request processing. Should not be called directly.
  65
  66 =cut
  67
  68 sub handle_request
  69 {
  70         my ($self,$cgi) = @_;
  71
  72     my $rv;
  73         my $path = $cgi->url( -absolute => 1, -path_info => 1 );
  74
  75     if ($path =~ m|^/static|)
  76     {
  77                 $rv=DECLINED;
  78         }
  79     else
  80     {
  81                 $rv = $self->module->run;
  82         }
  83
  84         if ($rv == OK) {
  85                 print "HTTP/1.1 200 OK\n";
  86                 $self->module->output_now;
  87                 return;
  88         }
  89     elsif ($rv == DECLINED)
  90     {
  91                 return $self->serve_static($cgi,"./");
  92         }
  93     else
  94     {
  95                 print "HTTP/1.1 404 Not Found\n\nPage not found";
  96         }
  97 }
  98
  99 1;
 100
 101
 102 =head1 SEE ALSO
 103
 104 L<Maypole>
 105
 106 =head1 AUTHOR
 107
 108 Marcus Ramberg, E<lt>marcus@thefeed.no<gt>
 109 Based on Simon Cozens' original implementation.
 110
 111 =head1 COPYRIGHT AND LICENSE
 112
 113 Copyright 2004 by Marcus Ramberg
 114
 115
 116 This library is free software; you can redistribute it and/or modify
 117 it under the same terms as Perl itself.
 118
 119 =cut