t/author/http-server.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 1;
   5
   6 use File::Path;
   7 use FindBin;
   8 use IPC::Open3;
   9 use IO::Socket;
  10
  11 use Catalyst::Devel 1.0;
  12 use File::Copy::Recursive;
  13
  14 # Run a single test by providing it as the first arg
  15 my $single_test = shift;
  16
  17 my $tmpdir = "$FindBin::Bin/../../t/tmp";
  18
  19 # clean up
  20 rmtree $tmpdir if -d $tmpdir;
  21
  22 # create a TestApp and copy the test libs into it
  23 mkdir $tmpdir;
  24 chdir $tmpdir;
  25 system( $^X, "-I$FindBin::Bin/../../lib", "$FindBin::Bin/../../script/catalyst.pl", 'TestApp' );
  26 chdir "$FindBin::Bin/..";
  27 File::Copy::Recursive::dircopy( '../t/lib', '../t/tmp/TestApp/lib' ) or die;
  28
  29 # remove TestApp's tests
  30 rmtree '../t/tmp/TestApp/t' or die;
  31
  32 # spawn the standalone HTTP server
  33 my $port = 30000 + int rand(1 + 10000);
  34 my @cmd = ($^X, "-I$FindBin::Bin/../../lib",
  35   "$FindBin::Bin/../../t/tmp/TestApp/script/testapp_server.pl", '--port', $port );
  36 my $pid = open3( undef, my $server, undef, @cmd)
  37     or die "Unable to spawn standalone HTTP server: $!";
  38
  39 # wait for it to start
  40 print "Waiting for server to start...\n";
  41 my $timeout = 30;
  42 my $count = 0;
  43 while ( check_port( 'localhost', $port ) != 1 ) {
  44     sleep 1;
  45     die("Server did not start within $timeout seconds: " . join(' ', @cmd))
  46         if $count++ > $timeout;
  47 }
  48
  49 # run the testsuite against the HTTP server
  50 $ENV{CATALYST_SERVER} = "http://localhost:$port";
  51
  52 my $return;
  53 if ( $single_test ) {
  54     $return = system( "$^X -I../lib/ $single_test" );
  55 }
  56 else {
  57     $return = prove( ['../lib/'], [glob('../t/aggregate/live_*.t')] );
  58 }
  59
  60 # shut it down
  61 kill 'INT', $pid;
  62 close $server;
  63
  64 # clean up
  65 rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp";
  66
  67 is( $return, 0, 'live tests' );
  68
  69 sub check_port {
  70     my ( $host, $port ) = @_;
  71
  72     my $remote = IO::Socket::INET->new(
  73         Proto    => "tcp",
  74         PeerAddr => $host,
  75         PeerPort => $port
  76     );
  77     if ($remote) {
  78         close $remote;
  79         return 1;
  80     }
  81     else {
  82         return 0;
  83     }
  84 }
  85
  86 sub prove {
  87     my ($inc, $tests) = @_;
  88     if (!(my $pid = fork)) {
  89         unshift @INC, @{ $inc };
  90
  91         require TAP::Harness;
  92         my $harness = TAP::Harness->new;
  93         my $aggregator = $harness->runtests(@{ $tests });
  94
  95         exit $aggregator->has_errors ? 1 : 0;
  96     } else {
  97         waitpid $pid, 0;
  98         return $?;
  99     }
 100 }