[gentoo-commits] gentoo-x86 commit in dev-perl/HTTP-Server-Simple/files: 0.34-debian.patch

[Torsten Veller (tove)]

tove        08/08/26 08:04:44

  Added:                0.34-debian.patch
  Log:
  Version bump (#235674). Added debian patch for CPAN#28122
  (Portage version: 2.2_rc8/cvs/Linux 2.6.26-tuxonice i686)

Revision  Changes    Path
1.1                  dev-perl/HTTP-Server-Simple/files/0.34-debian.patch

file : http://sources.gentoo.org/viewcvs.py/gentoo-x86/dev-perl/HTTP-Server-Simple/files/0.34-debian.patch?rev=1.1&view=markup
plain: http://sources.gentoo.org/viewcvs.py/gentoo-x86/dev-perl/HTTP-Server-Simple/files/0.34-debian.patch?rev=1.1&content-type=text/plain

Index: 0.34-debian.patch
===================================================================
http://rt.cpan.org/Public/Bug/Display.html?id=28122
patches from libhttp-server-simple-perl_0.34-1.diff.gz

--- libhttp-server-simple-perl.orig/t/01live.t
+++ libhttp-server-simple-perl/t/01live.t
@@ -34,11 +34,7 @@
 }
 
 
-TODO: { 
-    local $TODO = "We don't currently wait for 'server is running' responses from the client";
-    run_server_tests('SlowServer');
-
-}
+run_server_tests('SlowServer');
 
 
 
--- libhttp-server-simple-perl.orig/lib/HTTP/Server/Simple.pm
+++ libhttp-server-simple-perl/lib/HTTP/Server/Simple.pm
@@ -6,6 +6,7 @@
 use Socket;
 use Carp;
 use URI::Escape;
+use IO::Select;
 
 use vars qw($VERSION $bad_request_doc);
 $VERSION = '0.34';
@@ -215,15 +216,36 @@
 
 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);
-    return $child if $child;
+    if ($child) { # parent
+        my $s = IO::Select->new;
+        $s->add($readfh);
+	my $now = time; my $left = 0;
+	my @ready;
+	while(not @ready and $left < 5) {
+		@ready = $s->can_read($left);
+		$left = time - $now;
+	}
+        die("child unresponsive for 5 seconds") if(not @ready);
+        my $response = <$readfh>;
+        chomp $response;
+        die("child is confused: answer '$response' != 'OK'")
+            if $response ne "OK";
+        return $child;
+    }
 
     if ( $^O !~ /MSWin32/ ) {
         require POSIX;
         POSIX::setsid()
             or die "Can't start a new session: $!";
     }
+    $self->{_parent_handle} = $writefh;
     $self->run();
 }
 
@@ -270,6 +292,7 @@
 	$self->after_setup_listener();
         *{"$pkg\::run"} = $self->_default_run;
     }
+    $self->_maybe_tell_parent();
 
     local $SIG{HUP} = sub { $SERVER_SHOULD_RUN = 0; };
 
@@ -407,6 +430,15 @@
         }
 }
 
+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};
+}