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.2';
  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
  37 =cut
  38
  39 sub new
  40 {
  41         my ($class, %args) = @_;
  42         my $self = $class->SUPER::new($args{port});
  43         $self->module($args{module});
  44         #eval "use $self->{module}";
  45     #die $@ if $@;
  46     $self->module->require or die "Couldn't load driver: $@";
  47         $self->module->config->uri_base("http://localhost:".$self->port."/");
  48         return $self;
  49 }
  50
  51 =head2 module
  52
  53 Accessor for application module.
  54
  55 =cut
  56
  57 sub module {
  58     my $self = shift;
  59     $self->{'module'} = shift if (@_);
  60     return ( $self->{'module'} );
  61 }
  62
  63 =head2 handle_request
  64
  65 Handles the actual request processing. Should not be called directly.
  66
  67 =cut
  68
  69 sub handle_request
  70 {
  71         my ($self,$cgi) = @_;
  72
  73     my $rv;
  74         my $path = $cgi->url( -absolute => 1, -path_info => 1 );
  75
  76     if ($path =~ m|^/static|)
  77     {
  78                 $rv=DECLINED;
  79         }
  80     else
  81     {
  82                 $rv = $self->module->run;
  83         }
  84
  85         if ($rv == OK) {
  86                 print "HTTP/1.1 200 OK\n";
  87                 $self->module->output_now;
  88                 return;
  89         }
  90     elsif ($rv == DECLINED)
  91     {
  92                 return $self->serve_static($cgi,"./");
  93         }
  94     else
  95     {
  96                 print "HTTP/1.1 404 Not Found\n\nPage not found";
  97         }
  98 }
  99
 100 1;
 101
 102
 103 =head1 SEE ALSO
 104
 105 L<Maypole>
 106
 107 =head1 AUTHOR
 108
 109 Marcus Ramberg, E<lt>marcus@thefeed.no<gt>
 110 Based on Simon Cozens' original implementation.
 111
 112 =head1 COPYRIGHT AND LICENSE
 113
 114 Copyright 2004 by Marcus Ramberg
 115
 116
 117 This library is free software; you can redistribute it and/or modify
 118 it under the same terms as Perl itself.
 119
 120 =cut