[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