1#@!#!123s

32759 1#@!#!123s
: / proc / self / root / usr / share / perl5 / vendor_perl / HTTP / Server / Simple /
Filename : CGI.pm
back
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>