r57306 - in /trunk/libhttp-server-simple-perl: debian/changelog debian/patches/0002-Pipe-version-parent-waits-for-the-child-to-say-OK.patch debian/patches/0002-Signal-version-child-sends-SIGUSR1-to-the-parent-wh.patch lib/HTTP/Server/Simple.pm

[jawnsy-guest at users.alioth.debian.org]

Author: jawnsy-guest
Date: Sun May  2 03:20:02 2010
New Revision: 57306

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=57306
Log:
Refresh patch, remove old Signal patch (no longer applies)

Removed:
    trunk/libhttp-server-simple-perl/debian/patches/0002-Signal-version-child-sends-SIGUSR1-to-the-parent-wh.patch
Modified:
    trunk/libhttp-server-simple-perl/debian/changelog
    trunk/libhttp-server-simple-perl/debian/patches/0002-Pipe-version-parent-waits-for-the-child-to-say-OK.patch
    trunk/libhttp-server-simple-perl/lib/HTTP/Server/Simple.pm

Modified: trunk/libhttp-server-simple-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-server-simple-perl/debian/changelog?rev=57306&op=diff
==============================================================================
--- trunk/libhttp-server-simple-perl/debian/changelog (original)
+++ trunk/libhttp-server-simple-perl/debian/changelog Sun May  2 03:20:02 2010
@@ -1,6 +1,7 @@
 libhttp-server-simple-perl (0.43-1) UNRELEASED; urgency=low
 
   * New upstream release
+  * Refresh patch, remove old Signal patch (no longer applies)
 
  -- Jonathan Yu <jawnsy at cpan.org>  Sat, 01 May 2010 23:51:37 -0400
 

Modified: trunk/libhttp-server-simple-perl/debian/patches/0002-Pipe-version-parent-waits-for-the-child-to-say-OK.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-server-simple-perl/debian/patches/0002-Pipe-version-parent-waits-for-the-child-to-say-OK.patch?rev=57306&op=diff
==============================================================================
--- trunk/libhttp-server-simple-perl/debian/patches/0002-Pipe-version-parent-waits-for-the-child-to-say-OK.patch (original)
+++ trunk/libhttp-server-simple-perl/debian/patches/0002-Pipe-version-parent-waits-for-the-child-to-say-OK.patch Sun May  2 03:20:02 2010
@@ -3,15 +3,15 @@
 
 --- a/lib/HTTP/Server/Simple.pm
 +++ b/lib/HTTP/Server/Simple.pm
-@@ -5,6 +5,7 @@ package HTTP::Server::Simple;
+@@ -5,6 +5,7 @@
  use FileHandle;
  use Socket;
  use Carp;
 +use IO::Select;
  
  use vars qw($VERSION $bad_request_doc);
- $VERSION = '0.42';
-@@ -205,9 +206,30 @@ started process.  Any arguments will be
+ $VERSION = '0.43';
+@@ -205,9 +206,30 @@
  
  sub background {
      my $self  = shift;
@@ -43,7 +43,7 @@
  
      srand(); # after a fork, we need to reset the random seed
               # or we'll get the same numbers in both branches
-@@ -216,6 +238,8 @@ sub background {
+@@ -216,6 +238,8 @@
          POSIX::setsid()
              or croak "Can't start a new session: $!";
      }
@@ -52,7 +52,7 @@
      $self->run(@_); # should never return
      exit;           # just to be sure
  }
-@@ -265,6 +289,7 @@ sub run {
+@@ -265,6 +289,7 @@
  	$self->after_setup_listener();
          *{"$pkg\::run"} = $self->_default_run;
      }
@@ -60,7 +60,7 @@
  
      local $SIG{HUP} = sub { $SERVER_SHOULD_RUN = 0; };
  
-@@ -402,6 +427,16 @@ sub _process_request {
+@@ -403,6 +428,16 @@
      }
  }
  

Modified: trunk/libhttp-server-simple-perl/lib/HTTP/Server/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-server-simple-perl/lib/HTTP/Server/Simple.pm?rev=57306&op=diff
==============================================================================
--- trunk/libhttp-server-simple-perl/lib/HTTP/Server/Simple.pm (original)
+++ trunk/libhttp-server-simple-perl/lib/HTTP/Server/Simple.pm Sun May  2 03:20:02 2010
@@ -5,6 +5,7 @@
 use FileHandle;
 use Socket;
 use Carp;
+use IO::Select;
 
 use vars qw($VERSION $bad_request_doc);
 $VERSION = '0.43';
@@ -205,9 +206,30 @@
 
 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;
     croak "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;
+    }
 
     srand(); # after a fork, we need to reset the random seed
              # or we'll get the same numbers in both branches
@@ -216,6 +238,8 @@
         POSIX::setsid()
             or croak "Can't start a new session: $!";
     }
+
+    $self->{_parent_handle} = $writefh;
     $self->run(@_); # should never return
     exit;           # just to be sure
 }
@@ -265,6 +289,7 @@
 	$self->after_setup_listener();
         *{"$pkg\::run"} = $self->_default_run;
     }
+    $self->_maybe_tell_parent();
 
     local $SIG{HUP} = sub { $SERVER_SHOULD_RUN = 0; };
 
@@ -401,6 +426,16 @@
 
         $self->handler;
     }
+}
+
+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};
 }
 
 =head2 stdio_handle [FILEHANDLE]