Sun Jul 22 20:14:06 EDT 2007  Mark Stosberg <mark@summersault.com>
  * improve restarting code to make it easier to be used and overr-ridden by extensions
Sun Jul 22 19:36:27 EDT 2007  Mark Stosberg <mark@summersault.com>
  * Refactor SIGHUP handling so we always re-exec after a request cycle, not in the
  middle of one.
      This approach combines elements from restart code in Catalyst,
      HTTP::Server::Simple and HTTP::Server::Brick.
diff -rN -u old-catalyst_vs_cgiapp/lib/HTTP/Server/Simple.pm new-catalyst_vs_cgiapp/lib/HTTP/Server/Simple.pm
--- old-catalyst_vs_cgiapp/lib/HTTP/Server/Simple.pm	2007-07-22 20:17:32.000000000 -0400
+++ new-catalyst_vs_cgiapp/lib/HTTP/Server/Simple.pm	2007-07-22 20:17:32.000000000 -0400
@@ -58,13 +58,12 @@
 
 =item HUP
 
-When you C<kill -HUP> the server, it does its best to rexec
-itself.  Please note that in order to provide restart-on-SIGHUP,
-HTTP::Server::Simple sets a SIGHUP handler during initialisation. If
-your request handling code forks you need to make sure you reset this
-or unexpected things will happen if somebody sends a HUP to all running
-processes spawned by your app (e.g. by "kill -HUP <script>")
-
+When you C<kill -HUP> the server, it lets the current request finish being
+processed, then uses the C<restart> method to re-exec itself. Please note that
+in order to provide restart-on-SIGHUP, HTTP::Server::Simple sets a SIGHUP
+handler during initialisation. If your request handling code forks you need to
+make sure you reset this or unexpected things will happen if somebody sends a
+HUP to all running processes spawned by your app (e.g. by "kill -HUP <script>")
 
 =item PIPE
 
@@ -182,34 +181,14 @@
 
 my $server_class_id = 0;
 
+use vars '$SERVER_SHOULD_RUN';
+$SERVER_SHOULD_RUN = 1;
+
 sub run {
     my $self   = shift;
     my $server = $self->net_server;
 
-    # Handle SIGHUP
-
     local $SIG{CHLD} = 'IGNORE';    # reap child processes
-    local $SIG{HUP} = sub {
-
-        # XXX TODO: Autrijus says this code was incorrect when he wrote
-        # it and we should move to the sample code from perldoc perlipc
-        close HTTPDaemon;
-
-        # and then, on systems implementing fork(), we make sure
-        # we are running with a new pid, so another -HUP will still
-        # work on the new process.
-        require Config;
-        if ( $Config::Config{d_fork} and my $pid = fork() ) {
-
-            # finally, allow ^C on the parent process to terminate
-            # the children.
-            waitpid( $pid, 0 );
-            exit;
-        }
-
-        # do the exec. if $0 is not executable, try running it with $^X.
-        exec {$0}( ( ( -x $0 ) ? () : ($^X) ), $0, @ARGV );
-    } if exists $SIG{'HUP'};
 
     # $pkg is generated anew for each invocation to "run"
     # Just so we can use different net_server() implementations
@@ -230,6 +209,8 @@
         *{"$pkg\::run"} = $self->_default_run;
     }
 
+    local $SIG{HUP} = sub { $SERVER_SHOULD_RUN = 0; };
+
     $pkg->run( port => $self->port );
 }
 
@@ -252,7 +233,7 @@
 
         $self->print_banner;
 
-        while (1) {
+        while ($SERVER_SHOULD_RUN) {
             local $SIG{PIPE} = 'IGNORE';    # If we don't ignore SIGPIPE, a
                  # client closing the connection before we
                  # finish sending will cause the server to exit
@@ -270,9 +251,38 @@
                 close $remote;
             }
         }
+
+        # Got here? Time to restart, due to SIGHUP
+        $self->restart;
     };
 }
 
+=head2 restart
+
+Restarts the server. Usually called by a HUP signal, not directly.
+
+=cut
+
+sub restart {
+    my $self = shift;
+
+    close HTTPDaemon;
+
+    $SIG{CHLD} = 'DEFAULT';
+    wait;
+
+    ### if the standalone server was invoked with perl -I .. we will loose
+    ### those include dirs upon re-exec. So add them to PERL5LIB, so they
+    ### are available again for the exec'ed process --kane
+    use Config;
+    $ENV{PERL5LIB} .= join $Config{path_sep}, @INC;
+
+    # Server simple
+    # do the exec. if $0 is not executable, try running it with $^X.
+    exec {$0}( ( ( -x $0 ) ? () : ($^X) ), $0, @ARGV );
+}
+
+
 sub _process_request {
     my $self = shift;
 

