[Bps-public-commit] r11895 - in HTTP-Server-Simple: . t

jesse at bestpractical.com jesse at bestpractical.com
Fri Apr 25 13:59:57 EDT 2008


Author: jesse
Date: Fri Apr 25 13:59:51 2008
New Revision: 11895

Modified:
   HTTP-Server-Simple/   (props changed)
   HTTP-Server-Simple/Changes
   HTTP-Server-Simple/lib/HTTP/Server/Simple.pm
   HTTP-Server-Simple/t/01live.t

Log:
 r30106 at 31b:  jesse | 2008-04-25 13:59:25 -0400
  New test organization for 0.33


Modified: HTTP-Server-Simple/Changes
==============================================================================
--- HTTP-Server-Simple/Changes	(original)
+++ HTTP-Server-Simple/Changes	Fri Apr 25 13:59:51 2008
@@ -1,3 +1,7 @@
+0.33 Fri Apr 25 13:57:30 EDT 2008
+
+* The new support for background processes notifying the parent didn't quite work right for some apps using HSS. It's been reverted for now and the tests TODOED
+
 0.32 Thu Apr 24 09:45:14 EDT 2008
 
 * At least Apache and lighttpd put unencoded strings into PATH_INFO, so so should we.

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 Apr 25 13:59:51 2008
@@ -6,10 +6,9 @@
 use Socket;
 use Carp;
 use URI::Escape;
-use IO::Select;
 
 use vars qw($VERSION $bad_request_doc);
-$VERSION = '0.32';
+$VERSION = '0.33';
 
 
 =head1 NAME
@@ -216,31 +215,15 @@
 
 sub background {
     my $self  = shift;
-
-    # set up a pipe so the child can tell the parent when it's ready
-    # to accept requests
-    my ($readfh, $writefh) = FileHandle::pipe;
-
     my $child = fork;
     die "Can't fork: $!" unless defined($child);
-    if ($child) { # parent
-        my $s = IO::Select->new;
-        $s->add($readfh);
-        my @ready = $s->can_read(5);
-        die("child unresponsive for 5 seconds") if !@ready;
-        my $response = <$readfh>;
-        chomp $response;
-        die("child is confused: answer '$response' != 'OK'")
-            if $response ne "OK";
-        return $child;
-    }    
+    return $child if $child;
 
     if ( $^O !~ /MSWin32/ ) {
         require POSIX;
         POSIX::setsid()
             or die "Can't start a new session: $!";
     }
-    $self->{_parent_handle} = $writefh;
     $self->run();
 }
 
@@ -280,7 +263,6 @@
 	$self->after_setup_listener();
         *{"$pkg\::run"} = $self->_default_run;
     }
-    $self->_maybe_tell_parent();
 
     local $SIG{HUP} = sub { $SERVER_SHOULD_RUN = 0; };
 
@@ -418,15 +400,6 @@
         }
 }
 
-sub _maybe_tell_parent {
-    # inform the parent process that we're ready, if applicable
-    my $self = shift;
-    my $handle = $self->{_parent_handle};
-    return if !$handle;
-    print $handle "OK\n";
-    close $handle;
-    delete $self->{_parent_handle};
-}
 
 
 

Modified: HTTP-Server-Simple/t/01live.t
==============================================================================
--- HTTP-Server-Simple/t/01live.t	(original)
+++ HTTP-Server-Simple/t/01live.t	Fri Apr 25 13:59:51 2008
@@ -28,35 +28,32 @@
 
 my $DEBUG = 1 if @ARGV;
 
-my @classes = (qw(HTTP::Server::Simple SlowServer));
-for my $class (@classes)
-{
-    my $s = $class->new($PORT);
-    is($s->port(),$PORT,"Constructor set port correctly");
-
-    my $pid=$s->background();
+my @classes = (qw(HTTP::Server::Simple));
+for my $class (@classes) {
+    run_server_tests($class);
+}
 
-    like($pid, '/^-?\d+$/', 'pid is numeric');
 
-    my $content=fetch("GET / HTTP/1.1", "");
+TODO: { 
+    local $TODO = "We don't currently wait for 'server is running' responses from the client";
+    run_server_tests('SlowServer');
 
-    like($content, '/Congratulations/', "Returns a page");
-    is(kill(9,$pid),1,'Signaled 1 process successfully');
-    wait or die "couldn't wait for sub-process completion";
 }
 
+
+
 {
     my $s=HTTP::Server::Simple::CGI->new($PORT);
     $s->host("localhost");
     my $pid=$s->background();
     diag("started server on $pid");
     like($pid, '/^-?\d+$/', 'pid is numeric');
-
+    select(undef,undef,undef,0.2); # wait a sec
     my $content=fetch("GET / HTTP/1.1", "");
     like($content, '/Congratulations/', "Returns a page");
 
     eval {
-	like(fetch("GET your mum wet"),  # anything does!
+	like(fetch("GET a bogus request"), 
 	     '/bad request/i',
 	     "knows what a request isn't");
     };
@@ -141,3 +138,19 @@
 
 }
 
+sub run_server_tests {
+    my $class = shift;
+    my $s = $class->new($PORT);
+    is($s->port(),$PORT,"Constructor set port correctly");
+
+    my $pid=$s->background();
+    select(undef,undef,undef,0.2); # wait a sec
+
+    like($pid, '/^-?\d+$/', 'pid is numeric');
+
+    my $content=fetch("GET / HTTP/1.1", "");
+
+    like($content, '/Congratulations/', "Returns a page");
+    is(kill(9,$pid),1,'Signaled 1 process successfully');
+    wait or die "couldn't wait for sub-process completion";
+}



More information about the Bps-public-commit mailing list