[Catalyst-commits] r14135 - in Test-WWW-Mechanize-Catalyst/trunk/t:
. lib
edenc at dev.catalyst.perl.org
edenc at dev.catalyst.perl.org
Sat Oct 15 22:44:56 GMT 2011
Author: edenc
Date: 2011-10-15 22:44:56 +0000 (Sat, 15 Oct 2011)
New Revision: 14135
Modified:
Test-WWW-Mechanize-Catalyst/trunk/t/lib/ExternalCatty.pm
Test-WWW-Mechanize-Catalyst/trunk/t/multi_content_type.t
Log:
scanning for open port after failing to open server on the default test port
Modified: Test-WWW-Mechanize-Catalyst/trunk/t/lib/ExternalCatty.pm
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/t/lib/ExternalCatty.pm 2011-10-15 16:45:59 UTC (rev 14134)
+++ Test-WWW-Mechanize-Catalyst/trunk/t/lib/ExternalCatty.pm 2011-10-15 22:44:56 UTC (rev 14135)
@@ -2,27 +2,45 @@
use strict;
use warnings;
use Catalyst;
+use IO::Socket::INET;
__PACKAGE__->config( name => 'ExternalCatty' );
__PACKAGE__->setup;
__PACKAGE__->setup_engine('HTTP');
+sub MAX_PORT_TRIES() { 5 }
+
# The Cat HTTP server background option is useless here :-(
# Thus we have to provide our own background method.
sub background {
my $self = shift;
my $port = shift;
+ $port = $self->assert_or_find_available_port($port);
my $child = fork;
die "Can't fork Cat HTTP server: $!" unless defined $child;
- return $child if $child;
+ return($child, $port) if $child;
if ( $^O !~ /MSWin32/ ) {
require POSIX;
POSIX::setsid() or die "Can't start a new session: $!";
}
- $self->run($port);
+ return($self->run($port), $port);
}
+sub assert_or_find_available_port {
+ my($self, $port) = @_;
+ for my $i (1..MAX_PORT_TRIES) {
+ IO::Socket::INET->new(
+ LocalAddr => 'localhost',
+ LocalPort => $port,
+ Proto => 'tcp'
+ ) and return $port;
+ $port += int(rand 100) + 1;
+ }
+ die q{Can't find an open port to run external server on after }
+ . MAX_PORT_TRIES . q{tries};
+}
+
1;
Modified: Test-WWW-Mechanize-Catalyst/trunk/t/multi_content_type.t
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/t/multi_content_type.t 2011-10-15 16:45:59 UTC (rev 14134)
+++ Test-WWW-Mechanize-Catalyst/trunk/t/multi_content_type.t 2011-10-15 22:44:56 UTC (rev 14135)
@@ -7,7 +7,6 @@
BEGIN {
$PORT = $ENV{TWMC_TEST_PORT} || 7357;
- $ENV{CATALYST_SERVER} ||= "http://localhost:$PORT";
}
use Test::More tests => 9;
@@ -27,7 +26,9 @@
$SIG{INT} = sub { warn "INT:$$"; exit };
use_ok 'ExternalCatty';
-my $pid = ExternalCatty->background($PORT);
+my $pid;
+($pid, $PORT) = ExternalCatty->background($PORT);
+$ENV{CATALYST_SERVER} ||= "http://localhost:$PORT";
use Test::WWW::Mechanize::Catalyst;
my $m = Test::WWW::Mechanize::Catalyst->new;
More information about the Catalyst-commits
mailing list