refactored to leave synopsis to the top, and move the rest of the pod to the

[catagits/Catalyst-Runtime.git] / lib / Catalyst / Engine / HTTP.pm

diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm
index 1d715f5..d94e94e 100644 (file)
--- a/lib/Catalyst/Engine/HTTP.pm
+++ b/lib/Catalyst/Engine/HTTP.pm
@@ -7,7 +7,7 @@ use HTTP::Status;
 use NEXT;
 use Socket;
 use IO::Socket::INET ();
-use IO::Select ();
+use IO::Select       ();
 
 # For PAR
 require Catalyst::Engine::HTTP::Restarter;
@@ -37,9 +37,7 @@ This is the Catalyst engine specialized for development and testing.
 
 =head1 METHODS
 
-=over 4
-
-=item $self->finalize_headers($c)
+=head2 $self->finalize_headers($c)
 
 =cut
 
@@ -52,10 +50,15 @@ sub finalize_headers {
     $c->response->headers->date(time);
     $c->response->headers->header(
         Connection => $self->_keep_alive ? 'keep-alive' : 'close' );
-    $self->NEXT::finalize_headers($c);
+        
+    $c->response->header( Status => $c->response->status );
+        
+    # Avoid 'print() on closed filehandle Remote' warnings when using IE
+    print $c->response->headers->as_string("\015\012") if *STDOUT->opened();
+    print "\015\012" if *STDOUT->opened();
 }
 
-=item $self->finalize_read($c)
+=head2 $self->finalize_read($c)
 
 =cut
 
@@ -69,7 +72,7 @@ sub finalize_read {
     return $self->NEXT::finalize_read($c);
 }
 
-=item $self->prepare_read($c)
+=head2 $self->prepare_read($c)
 
 =cut
 
@@ -82,7 +85,7 @@ sub prepare_read {
     return $self->NEXT::prepare_read($c);
 }
 
-=item $self->read_chunk($c, $buffer, $length)
+=head2 $self->read_chunk($c, $buffer, $length)
 
 =cut
 
@@ -108,7 +111,20 @@ sub read_chunk {
     }
 }
 
-=item run
+=head2 $self->write($c, $buffer)
+
+Writes the buffer to the client. Can only be called once for a request.
+
+=cut
+
+sub write {
+       # Avoid 'print() on closed filehandle Remote' warnings when using IE
+       return unless *STDOUT->opened();
+       
+       shift->NEXT::write( @_ );
+}
+
+=head2 run
 
 =cut
 
@@ -118,6 +134,12 @@ sub run {
 
     $options ||= {};
 
+    if ($options->{background}) {
+        my $child = fork;
+        die "Can't fork: $!" unless defined($child);
+        exit if $child;
+    }
+
     my $restart = 0;
     local $SIG{CHLD} = 'IGNORE';
 
@@ -149,9 +171,27 @@ sub run {
 
     print "You can connect to your server at $url\n";
 
+    if ($options->{background}) {
+        open STDIN,  "+</dev/null" or die $!;
+        open STDOUT, ">&STDIN"     or die $!;
+        open STDERR, ">&STDIN"     or die $!;
+        if ( $^O !~ /MSWin32/ ) {
+             require POSIX;
+             POSIX::setsid()
+                 or die "Can't start a new session: $!";
+        }
+    }
+
+    if (my $pidfile = $options->{pidfile}) {
+        if (! open PIDFILE, "> $pidfile") {
+            warn("Cannot open: $pidfile: $!");
+        }
+        print PIDFILE "$$\n";
+        close PIDFILE;
+    }
+
     $self->_keep_alive( $options->{keepalive} || 0 );
 
-    my $parent = $$;
     my $pid    = undef;
     while ( accept( Remote, $daemon ) )
     {    # TODO: get while ( my $remote = $daemon->accept ) to work
@@ -180,8 +220,10 @@ sub run {
             my $sockdata = $self->_socket_data( \*Remote );
             my $ipaddr   = _inet_addr( $sockdata->{peeraddr} );
             my $ready    = 0;
-            while ( my ( $ip, $mask ) = each %$allowed and not $ready ) {
+            foreach my $ip ( keys %$allowed ) {
+                my $mask = $allowed->{$ip};
                 $ready = ( $ipaddr & _inet_addr($mask) ) == _inet_addr($ip);
+                last if $ready;
             }
             if ($ready) {
                 $restart = 1;
@@ -199,6 +241,13 @@ sub run {
     if ($restart) {
         $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; 
+        
         exec $^X . ' "' . $0 . '" ' . join( ' ', @{ $options->{argv} } );
     }
 
@@ -254,7 +303,7 @@ sub _handler {
                 $name = 'HTTP_' . $name
                   unless $name =~ m/\A(?:CONTENT_(?:LENGTH|TYPE)|COOKIE)\z/;
                 if ( exists $ENV{$name} ) {
-                    $ENV{$name} .= "; $value";
+                    $ENV{$name} .= ", $value";
                 }
                 else {
                     $ENV{$name} = $value;
@@ -304,16 +353,24 @@ sub _parse_request_line {
 sub _socket_data {
     my ( $self, $handle ) = @_;
 
-    my $remote_sockaddr = getpeername($handle);
-    my ( undef, $iaddr ) = sockaddr_in($remote_sockaddr);
-    my $local_sockaddr = getsockname($handle);
+    my $remote_sockaddr       = getpeername($handle);
+    my ( undef, $iaddr )      = $remote_sockaddr 
+        ? sockaddr_in($remote_sockaddr) 
+        : (undef, undef);
+        
+    my $local_sockaddr        = getsockname($handle);
     my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr);
 
+    # This mess is necessary to keep IE from crashing the server
     my $data = {
-        peername => gethostbyaddr( $iaddr, AF_INET ) || "localhost",
-        peeraddr => inet_ntoa($iaddr) || "127.0.0.1",
-        localname => gethostbyaddr( $localiaddr, AF_INET ) || "localhost",
-        localaddr => inet_ntoa($localiaddr) || "127.0.0.1",
+        peername  => $iaddr 
+            ? ( gethostbyaddr( $iaddr, AF_INET ) || 'localhost' )
+            : 'localhost',
+        peeraddr  => $iaddr 
+            ? ( inet_ntoa($iaddr) || '127.0.0.1' )
+            : '127.0.0.1',
+        localname => gethostbyaddr( $localiaddr, AF_INET ) || 'localhost',
+        localaddr => inet_ntoa($localiaddr) || '127.0.0.1',
     };
 
     return $data;
@@ -336,8 +393,6 @@ sub _get_line {
 
 sub _inet_addr { unpack "N*", inet_aton( $_[0] ) }
 
-=back
-
 =head1 SEE ALSO
 
 L<Catalyst>, L<Catalyst::Engine>.