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>