File Coverage

blib/lib/HTTP/Server/Simple/CGI.pm

Criterion	Covered	Total	%
statement	12	39	30.7
branch	0	8	0.0
condition	0	6	0.0
subroutine	4	11	36.3
pod	7	7	100.0
total	23	71	32.3

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 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.

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.

e.g.

    $server->cgi_class('CGI');

    $server->cgi_init(sub {
        require CGI;
        CGI::initialize_globals();
    });

or, if you want to use L,

    $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 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 "",  );

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__