]> git.decadent.org.uk Git - maypole.git/blob - lib/Maypole/HTTPD.pm
added preprocess_location method
[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.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