[Rt-commit] r3770 - in HTTP-Server-Simple: . lib/HTTP/Server
lib/HTTP/Server/Simple lib/HTTP/Server/Simple/CGI
jesse at bestpractical.com
jesse at bestpractical.com
Fri Sep 2 10:41:39 EDT 2005
Author: jesse
Date: Fri Sep 2 10:41:38 2005
New Revision: 3770
Added:
HTTP-Server-Simple/lib/HTTP/Server/Simple/CGI/
HTTP-Server-Simple/lib/HTTP/Server/Simple/CGI/Environment.pm
Modified:
HTTP-Server-Simple/ (props changed)
HTTP-Server-Simple/Changes
HTTP-Server-Simple/lib/HTTP/Server/Simple.pm
HTTP-Server-Simple/lib/HTTP/Server/Simple/CGI.pm
Log:
r15100 at hualien: jesse | 2005-09-02 07:53:37 -0400
Split out CGI environment support.
Modified: HTTP-Server-Simple/Changes
==============================================================================
--- HTTP-Server-Simple/Changes (original)
+++ HTTP-Server-Simple/Changes Fri Sep 2 10:41:38 2005
@@ -1,3 +1,6 @@
+
+ Split out HTTP::Server::Simple::CGI::Environment to support non-CGI.pm CGIs
+
0.13 Tue Aug 9 21:25:20 EDT 2005
Signal handlers should be 'localed', so as not to mess with others'
Modified: HTTP-Server-Simple/lib/HTTP/Server/Simple.pm
==============================================================================
--- HTTP-Server-Simple/lib/HTTP/Server/Simple.pm (original)
+++ HTTP-Server-Simple/lib/HTTP/Server/Simple.pm Fri Sep 2 10:41:38 2005
@@ -87,9 +87,6 @@
my $class = ref($proto) || $proto;
if ( $class eq __PACKAGE__ ) {
- warn "HTTP::Server::Simple is an abstract base class\n";
- warn "Direct use of this module is deprecated\n";
- warn "Upgrading this object to an HTTP::Server::Simple::CGI object\n";
require HTTP::Server::Simple::CGI;
return HTTP::Server::Simple::CGI->new(@_[1..$#_]);
}
Modified: HTTP-Server-Simple/lib/HTTP/Server/Simple/CGI.pm
==============================================================================
--- HTTP-Server-Simple/lib/HTTP/Server/Simple/CGI.pm (original)
+++ HTTP-Server-Simple/lib/HTTP/Server/Simple/CGI.pm Fri Sep 2 10:41:38 2005
@@ -1,7 +1,7 @@
package HTTP::Server::Simple::CGI;
-use base qw(HTTP::Server::Simple);
+use base qw(HTTP::Server::Simple HTTP::Server::Simple::CGI::Environment);
use strict;
use warnings;
@@ -9,8 +9,6 @@
our $VERSION = $HTTP::Server::Simple::VERSION;
-my %clean_env=%ENV;
-
=head1 NAME
HTTP::Server::Simple::CGI - CGI.pm-style version of HTTP::Server::Simple
@@ -30,10 +28,8 @@
=cut
sub accept_hook {
- %ENV= ( %clean_env,
- SERVER_SOFTWARE => "HTTP::Server::Simple/$VERSION",
- GATEWAY_INTERFACE => 'CGI/1.1'
- );
+ my $self = shift;
+ $self->setup_environment(@_);
}
=head2 post_setup_hook
@@ -43,10 +39,8 @@
=cut
sub post_setup_hook {
-
- $ENV{SERVER_URL} ||=
- ("http://".$ENV{SERVER_NAME}.":".$ENV{SERVER_PORT}."/");
- CGI::initialize_globals();
+ my $self = shift;
+ $self->setup_server_url;
}
=head2 setup
@@ -58,62 +52,11 @@
=cut
-our %env_mapping =
- ( protocol => "SERVER_PROTOCOL",
- localport => "SERVER_PORT",
- localname => "SERVER_NAME",
- path => "PATH_INFO",
- request_uri => "REQUEST_URI",
- method => "REQUEST_METHOD",
- peeraddr => "REMOTE_ADDR",
- peername => "REMOTE_HOST",
- query_string => "QUERY_STRING",
- );
-
sub setup {
- no warnings 'uninitialized';
my $self = shift;
-
- # XXX TODO: rather than clone functionality from the base class,
- # we should call super
- #
- while ( my ($item, $value) = splice @_, 0, 2 ) {
- if ( $self->can($item) ) {
- $self->$item($value);
- }
- if ( my $k = $env_mapping{$item} ) {
- $ENV{$k} = $value;
- }
- }
-
+ $self->setup_environment_from_metadata(@_);
}
-=head2 headers
-
-This method sets up the process environment in CGI style based on
-the HTTP input headers.
-
-=cut
-
-sub headers {
- my $self = shift;
- my $headers = shift;
-
-
- while ( my ($tag, $value) = splice @$headers, 0, 2 ) {
- $tag = uc($tag);
- $tag =~ s/^COOKIES$/COOKIE/;
- $tag =~ s/-/_/g;
- $tag = "HTTP_" . $tag
- unless $tag =~ m/^(?:CONTENT_(?:LENGTH|TYPE)|COOKIE)$/;
-
- if ( exists $ENV{$tag} ) {
- $ENV{$tag} .= "; $value";
- } else {
- $ENV{$tag} = $value;
- }
- }
-}
=head2 handle_request CGI
Added: HTTP-Server-Simple/lib/HTTP/Server/Simple/CGI/Environment.pm
==============================================================================
--- (empty file)
+++ HTTP-Server-Simple/lib/HTTP/Server/Simple/CGI/Environment.pm Fri Sep 2 10:41:38 2005
@@ -0,0 +1,108 @@
+
+package HTTP::Server::Simple::CGI::Environment;
+
+use strict;
+use warnings;
+
+our $VERSION = $HTTP::Server::Simple::VERSION;
+
+my %clean_env=%ENV;
+
+=head1 NAME
+
+HTTP::Server::Simple::CGI::Environment - a HTTP::Server::Simple mixin to provide the CGI protocol
+
+=head1 DESCRIPTION
+
+This mixin abstracts the CGI protocol out from HTTP::Server::Simple::CGI so that
+it's easier to provide your own CGI handlers with HTTP::Server::Simple which
+B<don't> use CGI.pm
+
+=head2 setup_environment
+
+C<setup_environemnt> is usually called in the superclass's accept_hook
+
+This routine in this sub-class clears the environment to the
+start-up state.
+
+=cut
+
+sub setup_environment {
+ %ENV= ( %clean_env,
+ SERVER_SOFTWARE => "HTTP::Server::Simple/$VERSION",
+ GATEWAY_INTERFACE => 'CGI/1.1'
+ );
+}
+
+=head2 setup_server_url
+
+Sets up the SERVER_URL environment variable
+
+=cut
+
+sub setup_server_url {
+ $ENV{SERVER_URL} ||= ("http://".$ENV{SERVER_NAME}.":".$ENV{SERVER_PORT}."/");
+}
+
+=head2 setup_environment_from_metadata
+
+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
+
+our %ENV_MAPPING =
+ ( protocol => "SERVER_PROTOCOL",
+ localport => "SERVER_PORT",
+ localname => "SERVER_NAME",
+ path => "PATH_INFO",
+ request_uri => "REQUEST_URI",
+ method => "REQUEST_METHOD",
+ peeraddr => "REMOTE_ADDR",
+ peername => "REMOTE_HOST",
+ query_string => "QUERY_STRING",
+ );
+
+sub setup_environment_from_metadata {
+ no warnings 'uninitialized';
+ my $self = shift;
+
+ # XXX TODO: rather than clone functionality from the base class,
+ # we should call super
+ #
+ while ( my ($item, $value) = splice @_, 0, 2 ) {
+ if ( my $k = $ENV_MAPPING{$item} ) {
+ $ENV{$k} = $value;
+ }
+ }
+
+}
+
+=head2 header
+
+C<header> turns a single HTTP headers into CGI environment variables.
+
+=cut
+
+sub header {
+ my $self = shift;
+ my $tag = shift;
+ my $value = shift;
+
+ $tag = uc($tag);
+ $tag =~ s/^COOKIES$/COOKIE/;
+ $tag =~ s/-/_/g;
+ $tag = "HTTP_" . $tag
+ unless $tag =~ m/^(?:CONTENT_(?:LENGTH|TYPE)|COOKIE)$/;
+
+ if ( exists $ENV{$tag} ) {
+ $ENV{$tag} .= "; $value";
+ } else {
+ $ENV{$tag} = $value;
+ }
+}
+
+
+1;
More information about the Rt-commit
mailing list