local-lib5/lib/perl5/HTTP/Server/Simple/CGI.pm

   1
   2 package HTTP::Server::Simple::CGI;
   3
   4 use base qw(HTTP::Server::Simple HTTP::Server::Simple::CGI::Environment);
   5 use strict;
   6 use warnings;
   7
   8 use CGI ();
   9
  10 use vars qw($VERSION $default_doc);
  11 $VERSION = $HTTP::Server::Simple::VERSION;
  12
  13 =head1 NAME
  14
  15 HTTP::Server::Simple::CGI - CGI.pm-style version of HTTP::Server::Simple
  16
  17 =head1 DESCRIPTION
  18
  19 HTTP::Server::Simple was already simple, but some smart-ass pointed
  20 out that there is no CGI in HTTP, and so this module was born to
  21 isolate the CGI.pm-related parts of this handler.
  22
  23
  24 =head2 accept_hook
  25
  26 The accept_hook in this sub-class clears the environment to the
  27 start-up state.
  28
  29 =cut
  30
  31 sub accept_hook {
  32     my $self = shift;
  33     $self->setup_environment(@_);
  34 }
  35
  36 =head2 post_setup_hook
  37
  38 Initializes the global L<CGI> object, as well as other environment
  39 settings.
  40
  41 =cut
  42
  43 sub post_setup_hook {
  44     my $self = shift;
  45     $self->setup_server_url;
  46     CGI::initialize_globals();
  47 }
  48
  49 =head2 setup
  50
  51 This method sets up CGI environment variables based on various
  52 meta-headers, like the protocol, remote host name, request path, etc.
  53
  54 See the docs in L<HTTP::Server::Simple> for more detail.
  55
  56 =cut
  57
  58 sub setup {
  59     my $self = shift;
  60     $self->setup_environment_from_metadata(@_);
  61 }
  62
  63 =head2 handle_request CGI
  64
  65 This routine is called whenever your server gets a request it can
  66 handle.
  67
  68 It's called with a CGI object that's been pre-initialized.
  69 You want to override this method in your subclass
  70
  71
  72 =cut
  73
  74 $default_doc = ( join "", <DATA> );
  75
  76 sub handle_request {
  77     my ( $self, $cgi ) = @_;
  78
  79     print "HTTP/1.0 200 OK\r\n";    # probably OK by now
  80     print "Content-Type: text/html\r\nContent-Length: ", length($default_doc),
  81         "\r\n\r\n", $default_doc;
  82 }
  83
  84 =head2 handler
  85
  86 Handler implemented as part of HTTP::Server::Simple API
  87
  88 =cut
  89
  90 sub handler {
  91     my $self = shift;
  92     my $cgi  = new CGI();
  93     eval { $self->handle_request($cgi) };
  94     if ($@) {
  95         my $error = $@;
  96         warn $error;
  97     }
  98 }
  99
 100 1;
 101
 102 __DATA__
 103 <html>
 104   <head>
 105     <title>Hello!</title>
 106   </head>
 107   <body>
 108     <h1>Congratulations!</h1>
 109
 110     <p>You now have a functional HTTP::Server::Simple::CGI running.
 111       </p>
 112
 113     <p><i>(If you're seeing this page, it means you haven't subclassed
 114       HTTP::Server::Simple::CGI, which you'll need to do to make it
 115       useful.)</i>
 116       </p>
 117   </body>
 118 </html>