]> git.decadent.org.uk Git - maypole.git/blob - lib/Maypole/HTTPD.pm
AsForm select handling tested and works, debug warnings removed
[maypole.git] / 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