diff options
| author | Lorry Tar Creator <lorry-tar-importer@lorry> | 2015-02-02 15:36:39 +0000 |
|---|---|---|
| committer | Lorry Tar Creator <lorry-tar-importer@lorry> | 2015-02-02 15:36:39 +0000 |
| commit | e2d680ac7c6f0bb36808aa45e1453c8b585d2717 (patch) | |
| tree | 97944a18c68e27f1472b7c2221ead889b13de107 /lib/HTTP/Server/Simple/CGI.pm | |
| download | HTTP-Server-Simple-tarball-master.tar.gz | |
HTTP-Server-Simple-0.50HEADHTTP-Server-Simple-0.50master
Diffstat (limited to 'lib/HTTP/Server/Simple/CGI.pm')
| -rw-r--r-- | lib/HTTP/Server/Simple/CGI.pm | 178 |
1 files changed, 178 insertions, 0 deletions
diff --git a/lib/HTTP/Server/Simple/CGI.pm b/lib/HTTP/Server/Simple/CGI.pm new file mode 100644 index 0000000..b11fc12 --- /dev/null +++ b/lib/HTTP/Server/Simple/CGI.pm @@ -0,0 +1,178 @@ + +package HTTP::Server::Simple::CGI; + +use base qw(HTTP::Server::Simple HTTP::Server::Simple::CGI::Environment); +use strict; +use warnings; + +use vars qw($default_doc $DEFAULT_CGI_INIT $DEFAULT_CGI_CLASS); + +$DEFAULT_CGI_CLASS = "CGI"; +$DEFAULT_CGI_INIT = sub { require CGI; CGI::initialize_globals()}; + + +=head1 NAME + +HTTP::Server::Simple::CGI - CGI.pm-style version of HTTP::Server::Simple + +=head1 DESCRIPTION + +HTTP::Server::Simple was already simple, but some smart-ass pointed +out that there is no CGI in HTTP, and so this module was born to +isolate the CGI.pm-related parts of this handler. + + +=head2 accept_hook + +The accept_hook in this sub-class clears the environment to the +start-up state. + +=cut + +sub accept_hook { + my $self = shift; + $self->setup_environment(@_); +} + +=head2 post_setup_hook + +Initializes the global L<CGI> object, as well as other environment +settings. + +=cut + +sub post_setup_hook { + my $self = shift; + $self->setup_server_url; + if ( my $init = $self->cgi_init ) { + $init->(); + } +} + +=head2 cgi_class [Classname] + +Gets or sets the class to use for creating the C<$cgi> object passed to +C<handle_request>. + +Called with a single argument, it sets the coderef. Called with no arguments, +it returns this field's current value. + +To provide an initialization subroutine to be run in the post_setup_hook, +see L</cgi_init>. + +e.g. + + $server->cgi_class('CGI'); + + $server->cgi_init(sub { + require CGI; + CGI::initialize_globals(); + }); + +or, if you want to use L<CGI::Simple>, + + $server->cgi_class('CGI::Simple'); + $server->cgi_init(sub { + require CGI::Simple; + }); + +=cut + +sub cgi_class { + my $self = shift; + if (@_) { + $self->{cgi_class} = shift; + } + return $self->{cgi_class} || $DEFAULT_CGI_CLASS; +} + +=head2 cgi_init [CODEREF] + +A coderef to run in the post_setup_hook. + +Called with a single argument, it sets the coderef. Called with no arguments, +it returns this field's current value. + +=cut + +sub cgi_init { + my $self = shift; + if (@_) { + $self->{cgi_init} = shift; + } + return $self->{cgi_init} || $DEFAULT_CGI_INIT; + +} + + +=head2 setup + +This method sets up CGI environment variables based on various +meta-headers, like the protocol, remote host name, request path, etc. + +See the docs in L<HTTP::Server::Simple> for more detail. + +=cut + +sub setup { + my $self = shift; + $self->setup_environment_from_metadata(@_); +} + +=head2 handle_request CGI + +This routine is called whenever your server gets a request it can +handle. + +It's called with a CGI object that's been pre-initialized. +You want to override this method in your subclass + + +=cut + +$default_doc = ( join "", <DATA> ); + +sub handle_request { + my ( $self, $cgi ) = @_; + + print "HTTP/1.0 200 OK\r\n"; # probably OK by now + print "Content-Type: text/html\r\nContent-Length: ", length($default_doc), + "\r\n\r\n", $default_doc; +} + +=head2 handler + +Handler implemented as part of HTTP::Server::Simple API + +=cut + +sub handler { + my $self = shift; + my $cgi; + $cgi = $self->cgi_class->new; + eval { $self->handle_request($cgi) }; + if ($@) { + my $error = $@; + warn $error; + } +} + +1; + +__DATA__ +<html> + <head> + <title>Hello!</title> + </head> + <body> + <h1>Congratulations!</h1> + + <p>You now have a functional HTTP::Server::Simple::CGI running. + </p> + + <p><i>(If you're seeing this page, it means you haven't subclassed + HTTP::Server::Simple::CGI, which you'll need to do to make it + useful.)</i> + </p> + </body> +</html> |