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