| Subject: | HTTP::Server::Simple::CGI : Use user provided CGI class |
I recently uploaded a module
<http://search.cpan.org/perldoc/HTTP::Server::Simple::CGI::Simple> to
CPAN which uses CGI::Simple rather than CGI.pm to provide a $cgi object
to handle_request.
brian d foy commented that it might be better to add support to
HTTP::Server::Simple::CGI for the name of the CGI class to be specified
at run time. I agree with him and, in hindsight, I should have known
better than to upload such a stupidly named module to CPAN ;-)
To do this without altering the interface to programs that do not care
about using a different CGI module, I added the following methods to
HTTP::Server::Simple::CGI:
set_cgi_class / get_cgi_class
set_cgi_init / get_cgi_init
In addition, I removed the hard coded use CGI; from the module and
modified post_setup_hook so that a CGI.pm object is initialized if no
initialization sub is provided and in handler, the $cgi object is
instantiated using the user supplied class name rather than the hard
coded CGI.pm. If there is no user supplied class name, CGI.pm is used.
This seems to work on my machines (ArchLinux and Windows XP both with
latest versions of Perl).
I think it would be nice if this support could be added to
HTTP::Server::Simple::CGI. Alternatively, a module called
HTTP::Server::Simple::CGI::Any could be provided (which I can package if
you want).
Thank you. HTTP::Server::Simple is a very hand module.
| Subject: | CGI-use-user-supplied.pm |
package HTTP::Server::Simple::CGI;
use base qw(HTTP::Server::Simple HTTP::Server::Simple::CGI::Environment);
use strict;
use warnings;
use vars qw($VERSION $default_doc);
$VERSION = $HTTP::Server::Simple::VERSION;
=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->get_cgi_init ) {
$init->();
}
else {
require CGI;
CGI::initialize_globals();
}
}
=head2 set_cgi_class
Sets the class to use for creating the C<$cgi> object passed to
C<handle_request> and optionally provide initialization code.
e.g.
$server->set_cgi_class(CGI => sub {
require CGI;
CGI::initialize_globals();
});
or, if you want to use L<CGI::Simple>,
$server->set_cgi_class('CGI::Simple' => sub {
require CGI::Simple;
});
=cut
sub set_cgi_class {
my $self = shift;
my ($class, $init) = @_;
$self->{cgi_class} = $class;
$self->{cgi_init} = $init if defined $init;
return;
}
=head2 set_cgi_init
=cut
sub set_cgi_init {
my $self = shift;
my ($init) = @_;
$self->{cgi_init} = $init;
return;
}
=head2 get_cgi_class
=cut
sub get_cgi_class {
my $self = shift;
return $self->{cgi_class};
}
=head2 get_cgi_init
=cut
sub get_cgi_init {
my $self = shift;
return $self->{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;
if ( my $cgi_class = $self->get_cgi_class ) {
$cgi = $cgi_class->new;
}
else {
require CGI;
$cgi = CGI->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>