Commit | Line | Data |
040850b3 |
1 | #!perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
040850b3 |
6 | use File::Path; |
7 | use FindBin; |
896c9ed2 |
8 | use IO::Socket; |
f0ee1a76 |
9 | use Test::More; |
10 | eval "use File::Copy::Recursive"; |
11 | |
f0ee1a76 |
12 | plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP}; |
ac93c094 |
13 | plan skip_all => 'File::Copy::Recursive required' if $@; |
4678828c |
14 | plan tests => 28; |
040850b3 |
15 | |
16 | # clean up |
17 | rmtree "$FindBin::Bin/../../t/var" if -d "$FindBin::Bin/../../t/var"; |
18 | |
19 | # create a TestApp and copy the test libs into it |
20 | mkdir "$FindBin::Bin/../../t/var"; |
21 | chdir "$FindBin::Bin/../../t/var"; |
22 | system "$FindBin::Bin/../../script/catalyst.pl TestApp"; |
23 | chdir "$FindBin::Bin/../.."; |
24 | File::Copy::Recursive::dircopy( 't/live/lib', 't/var/TestApp/lib' ); |
25 | |
26 | # spawn the standalone HTTP server |
896c9ed2 |
27 | my $port = 30000 + int rand(1 + 10000); |
28 | my $pid = open my $server, |
29 | "$FindBin::Bin/../../t/var/TestApp/script/testapp_server.pl -port $port 2>&1 |" |
040850b3 |
30 | or die "Unable to spawn standalone HTTP server: $!"; |
896c9ed2 |
31 | |
040850b3 |
32 | # wait for it to start |
896c9ed2 |
33 | print "Waiting for server to start...\n"; |
34 | while ( check_port( 'localhost', $port ) != 1 ) { |
35 | sleep 1; |
36 | } |
040850b3 |
37 | |
38 | # run the testsuite against the HTTP server |
896c9ed2 |
39 | $ENV{CATALYST_SERVER} = "http://localhost:$port"; |
4678828c |
40 | my $output = `prove -r -Ilib/ t/live/`; |
41 | |
42 | foreach my $line ( split /\n/, $output ) { |
43 | if ( $line !~ /skipped|wallclock/ ) { |
44 | like( $line, qr/ok$/, 'test ok' ); |
45 | } |
46 | } |
040850b3 |
47 | |
48 | # shut it down |
49 | kill 2, $pid; |
896c9ed2 |
50 | close $server; |
040850b3 |
51 | |
52 | # clean up |
53 | rmtree "$FindBin::Bin/../../t/var" if -d "$FindBin::Bin/../../t/var"; |
896c9ed2 |
54 | |
55 | sub check_port { |
56 | my ( $host, $port ) = @_; |
57 | |
58 | my $remote = IO::Socket::INET->new( |
59 | Proto => "tcp", |
60 | PeerAddr => $host, |
61 | PeerPort => $port |
62 | ); |
63 | if ($remote) { |
64 | close $remote; |
65 | return 1; |
66 | } |
67 | else { |
68 | return 0; |
69 | } |
70 | } |