2 # ABSTRACT: A runner for test HTTP servers
7 my $server = Server->new('app.psgi');
11 Throws up an HTTP server on a random port, suitable for testing. Server logs will be printed to
12 C<STDERR> as test notes.
21 use Util
qw(recv_env);
25 $server = Server-
>new($path);
26 $server = Server-
>new(\
&app
);
27 $server = Server-
>new(\
&app
, type
=> 'Starman');
29 Construct
and L
</start
> a new test HTTP server
.
35 my $app = shift or die 'PSGI app required';
38 $args{type
} ||= 'HTTP::Server::PSGI';
40 my $self = bless {app
=> $app, %args}, $class;
46 Get the app that was passed to L
</new
>.
50 Get a filehandle
for reading the server
's STDOUT.
54 Get the process identifier of the server.
58 Get the port number the server is listening on.
62 Get the URL for the server.
66 Get the type of server that was passed to L</new>.
70 sub app { shift->{app} }
71 sub in { shift->{in} }
72 sub pid { shift->{pid} }
73 sub port { shift->{port} }
74 sub url { 'http
://localhost
:' . shift->port }
75 sub type { shift->{type} }
88 # do not start on top of an already-started server
89 return $self if $self->{pid};
91 my $type = $self->type;
93 my $pid = open(my $pipe, '-|');
94 defined $pid or die "fork failed: $!";
100 die 'Could
not start test server
' if !$port;
105 $self->{port} = $port;
108 tie *STDERR, 'Server
::RedirectToTestHarness
';
112 for my $try (1..10) {
113 my $port_num = $ENV{PERL_HTTP_ANYUA_TEST_PORT} || int(rand(32768)) + 32768;
114 print STDERR sprintf('Try
%02d - Attempting to start a server on port
%d for testing
...', $try, $port_num);
116 local $SIG{ALRM} = sub { print "$port_num\n" };
120 my $runner = Plack::Runner->new;
121 $runner->parse_options('-s
', $type, '-p
', $port_num);
122 $runner->run($self->app);
129 print STDERR "Giving up...";
140 Stop the server. Called implicitly by C<DESTROY>.
147 if (my $pid = $self->pid) {
150 $? = 0; # don't let child
exit status affect parent
152 %$self = (app
=> $self->app);
163 $env = $server->read_env;
165 Read a L
<PSGI
> environment from the server
, sent by L
<Util
/send_env
>.
171 return recv_env
($self->in or die 'Not connected');
176 package Server
::RedirectToTestHarness
;
180 sub TIEHANDLE
{ bless {} }
181 sub PRINT
{ shift; Test
::More
::note
('Server: ', @_) }
182 sub PRINTF
{ shift; Test
::More
::note
('Server: ', sprintf(@_)) }