From: Andy Grundman Date: Thu, 27 Oct 2005 16:23:54 +0000 (+0000) Subject: Updated CGI and FastCGI tests to not delete the tmp files if the server is still... X-Git-Tag: 5.7099_04~1095 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=e2a248924a4f84d01ee7e6ba2bbfd715d1187947 Updated CGI and FastCGI tests to not delete the tmp files if the server is still running --- diff --git a/t/optional/apache-cgi.pl b/t/optional/apache-cgi.pl index 7864b39..a6cf881 100755 --- a/t/optional/apache-cgi.pl +++ b/t/optional/apache-cgi.pl @@ -16,6 +16,7 @@ use Apache::TestRun (); use File::Path; use File::Copy::Recursive; use FindBin; +use IO::Socket; # clean up rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp"; @@ -34,5 +35,25 @@ $ENV{CATALYST_SERVER} = 'http://localhost:8529/cgi'; Apache::TestRun->new->run(@ARGV); -# clean up -rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp"; +# clean up if the server has shut down +# this allows the test files to stay around if the user ran -start-httpd +if ( ! check_port( 'localhost', 8529 ) ) { + rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp"; +} + +sub check_port { + my ( $host, $port ) = @_; + + my $remote = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port + ); + if ($remote) { + close $remote; + return 1; + } + else { + return 0; + } +} diff --git a/t/optional/apache-fastcgi.pl b/t/optional/apache-fastcgi.pl index 68f095c..ec7e77e 100755 --- a/t/optional/apache-fastcgi.pl +++ b/t/optional/apache-fastcgi.pl @@ -16,6 +16,7 @@ use Apache::TestRun (); use File::Path; use File::Copy::Recursive; use FindBin; +use IO::Socket; # clean up rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp"; @@ -34,5 +35,25 @@ $ENV{CATALYST_SERVER} = 'http://localhost:8529/fastcgi'; Apache::TestRun->new->run(@ARGV); -# clean up -rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp"; +# clean up if the server has shut down +# this allows the test files to stay around if the user ran -start-httpd +if ( ! check_port( 'localhost', 8529 ) ) { + rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp"; +} + +sub check_port { + my ( $host, $port ) = @_; + + my $remote = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $port + ); + if ($remote) { + close $remote; + return 1; + } + else { + return 0; + } +}