1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
use strict;
use warnings;
use File::Basename ();
use List::Util qw(first);
use LWP::UserAgent ();
use Test::TCP ();
use Test::More;
BEGIN {
use_ok('Server::Starter');
};
sub findprog {
my $prog = shift;
first { -x $_ } map { "$_/$prog" } (
File::Basename::dirname($^X),
split /:/, $ENV{PATH},
);
}
my $start_server = findprog('start_server');
my $plackup = findprog('plackup');
sub doit {
my $pkg = shift;
my $port = Test::TCP::empty_port();
my $server_pid = fork();
die "fork failed:$!"
unless defined $server_pid;
if ($server_pid == 0) {
# child == server
exec(
$start_server,
"--port=$port",
'--',
$plackup,
'--server',
$pkg,
't/00base-hello.psgi',
);
die "failed to launch server using start_server:$!";
}
sleep 1;
my $ua = LWP::UserAgent->new;
my $response = $ua->get("http://127.0.0.1:$port/");
ok($response->is_success, "request successfull");
is($response->content, 'hello', 'content is hello');
kill 'TERM', $server_pid;
while (wait == -1) {}
}
if ($start_server) {
doit('Starlet');
} else {
warn "could not find `start_server' next to $^X nor from \$PATH, skipping tests";
}
done_testing;
|