[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