[Rt-commit] r2502 - in HTTP-Server-Simple: . lib/HTTP/Server

autrijus at bestpractical.com autrijus at bestpractical.com
Wed Mar 23 22:44:50 EST 2005


Author: autrijus
Date: Wed Mar 23 22:44:50 2005
New Revision: 2502

Modified:
   HTTP-Server-Simple/Changes
   HTTP-Server-Simple/lib/HTTP/Server/Simple.pm
Log:
- New public subclass-overridable method ->net_server() that can
  optionally take a Net::Server subclass name and use it to replace
  the default ->run() method.

Modified: HTTP-Server-Simple/Changes
==============================================================================
--- HTTP-Server-Simple/Changes	(original)
+++ HTTP-Server-Simple/Changes	Wed Mar 23 22:44:50 2005
@@ -1,3 +1,7 @@
+- New public subclass-overridable method ->net_server() that can
+  optionally take a Net::Server subclass name and use it to replace
+  the default ->run() method.
+
 0.04 Tue Mar 22 23:34:36 CST 2005
 - Changed ->headers calling conventions. This may break backwards compat,
   but is cleaner and safer.

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	Wed Mar 23 22:44:50 2005
@@ -159,84 +159,129 @@
 
 =cut
 
+my $server_class_id = 0;
 sub run {
-    my $self = shift;
-
-    $self->setup_listener;
-
-    $self->print_banner;
-
-    while (1) {
-
-        for ( ; accept( Remote, HTTPDaemon ) ; close Remote ) {
-
-            $self->stdio_handle(\*Remote);
+    my $self    = shift;
+    my $server  = $self->net_server;
 
-	    $self->accept_hook if $self->can("accept_hook");
-
-            *STDIN  = $self->stdio_handle();
-            *STDOUT = $self->stdio_handle();
-    
-            # Default to unencoded, raw data out.
-            # if you're sending utf8 and latin1 data mixed, you may need to override this
-            binmode STDIN, ':raw';
-            binmode STDOUT, ':raw';
-
-
-            my $remote_sockaddr = getpeername(STDIN);
-            my ( undef, $iaddr ) = sockaddr_in($remote_sockaddr);
-            my $peername = gethostbyaddr( $iaddr, AF_INET ) || "localhost";
+    # $pkg is generated anew for each invocation to "run"
+    # Just so we can use different net_server() implementations
+    # in different runs.
+    my $pkg     = join '::', ref($self), "NetServer".$server_class_id++;
+
+    no strict 'refs';
+    *{"$pkg\::process_request"} = $self->_process_request;
+
+    if ($server) {
+        require join('/', split /::/, $server).'.pm';
+        *{"$pkg\::ISA"} = [$server];
+        $self->print_banner;
+    }
+    else {
+        $self->setup_listener;
+        *{"$pkg\::run"} = $self->_default_run;
+    }
 
-            my $peeraddr = inet_ntoa($iaddr) || "127.0.0.1";
+    $pkg->run(port => $self->port);
+}
 
-            my $local_sockaddr = getsockname(STDIN);
-            my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr);
-            my $localname = gethostbyaddr( $localiaddr, AF_INET )
-              || "localhost";
-            my $localaddr = inet_ntoa($localiaddr) || "127.0.0.1";
+=head2 net_server
 
-            my ( $method, $request_uri, $proto ) =
-		$self->parse_request
-		    or do {$self->bad_request; next};
+User-overridable method. If you set it to a C<Net::Server> subclass,
+that subclass is used for the C<run> method.  Otherwise, a minimal 
+implementation is used as default.
 
-	    $proto ||= "HTTP/0.9";
+=cut
 
-            my ( $file, $query_string ) =
-              ( $request_uri =~ /([^?]*)(?:\?(.*))?/ );    # split at ?
+sub net_server { undef }
 
-            $self->bad_request, next
-		if ( $method !~ /^(GET|POST|HEAD)$/ );
+sub _default_run {
+    my $self = shift;
 
-            $self->setup(
-                method       => $method,
-                protocol     => $proto,
-                query_string => ( $query_string || '' ),
-                request_uri  => $request_uri,
-                path         => $file,
-                localname    => $localname,
-                localport    => $self->port,
-                peername     => $peername,
-                peeraddr     => $peeraddr,
-            );
+    # Default "run" closure method for a stub, minimal Net::Server instance.
+    sub {
+        my $pkg = shift;
+
+        $self->print_banner;
+
+        while (1) {
+            for ( ; accept( Remote, HTTPDaemon ) ; close Remote ) {
+                $self->stdio_handle(\*Remote);
+                $self->accept_hook if $self->can("accept_hook");
+
+                *STDIN  = $self->stdio_handle();
+                *STDOUT = $self->stdio_handle();
+                $pkg->process_request;
+            }
+        }    
+    }
+}
 
-	    # HTTP/0.9 didn't have any headers (I think)
-	    if ( $proto =~ m{HTTP/(\d(\.\d)?)$} and $1 >= 1 ) {
+sub _process_request {
+    my $self = shift;
 
-		my $headers = $self->parse_headers
-		    or do{$self->bad_request; next};
+    # Create a callback closure that is invoked for each incoming request;
+    # the $self above is bound into the closure.
+    sub {
+        $self->stdio_handle(*STDIN);
+
+        # Default to unencoded, raw data out.
+        # if you're sending utf8 and latin1 data mixed, you may need to override this
+        binmode STDIN, ':raw';
+        binmode STDOUT, ':raw';
+
+        my $remote_sockaddr = getpeername(STDIN);
+        my ( undef, $iaddr ) = sockaddr_in($remote_sockaddr);
+        my $peername = gethostbyaddr( $iaddr, AF_INET ) || "localhost";
+
+        my $peeraddr = inet_ntoa($iaddr) || "127.0.0.1";
+
+        my $local_sockaddr = getsockname(STDIN);
+        my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr);
+        my $localname = gethostbyaddr( $localiaddr, AF_INET )
+            || "localhost";
+        my $localaddr = inet_ntoa($localiaddr) || "127.0.0.1";
+
+        my ( $method, $request_uri, $proto ) =
+            $self->parse_request
+                or do {$self->bad_request; return};
+
+        $proto ||= "HTTP/0.9";
+
+        my ( $file, $query_string ) =
+            ( $request_uri =~ /([^?]*)(?:\?(.*))?/ );    # split at ?
+
+        if ( $method !~ /^(?:GET|POST|HEAD)$/ ) {
+            $self->bad_request;
+            return;
+        }
 
-		$self->headers( $headers) ;
+        $self->setup(
+            method       => $method,
+            protocol     => $proto,
+            query_string => ( $query_string || '' ),
+            request_uri  => $request_uri,
+            path         => $file,
+            localname    => $localname,
+            localport    => $self->port,
+            peername     => $peername,
+            peeraddr     => $peeraddr,
+        );
 
-	    }
+        # HTTP/0.9 didn't have any headers (I think)
+        if ( $proto =~ m{HTTP/(\d(\.\d)?)$} and $1 >= 1 ) {
 
-	    $self->post_setup_hook if $self->can("post_setup_hook");
+            my $headers = $self->parse_headers
+                or do{$self->bad_request; return};
 
-            $self->handler;
+            $self->headers( $headers) ;
 
         }
 
-    }
+        $self->post_setup_hook if $self->can("post_setup_hook");
 
+        $self->handler;
+    }
 }
 
 


More information about the Rt-commit mailing list