t/lib/ExternalCatty.pm

   1 package ExternalCatty;
   2 use strict;
   3 use warnings;
   4 use Catalyst;
   5 use IO::Socket::INET;
   6
   7 __PACKAGE__->config( name => 'ExternalCatty' );
   8 __PACKAGE__->setup;
   9 __PACKAGE__->setup_engine('HTTP');
  10
  11 sub MAX_PORT_TRIES() { 5 }
  12
  13 # The Cat HTTP server background option is useless here :-(
  14 # Thus we have to provide our own background method.
  15 sub background {
  16     my $self  = shift;
  17     my $port  = shift;
  18     $port = $self->assert_or_find_available_port($port);
  19     my $child = fork;
  20     die "Can't fork Cat HTTP server: $!" unless defined $child;
  21     return($child, $port) if $child;
  22
  23     if ( $^O !~ /MSWin32/ ) {
  24         require POSIX;
  25         POSIX::setsid() or die "Can't start a new session: $!";
  26     }
  27
  28     return($self->run($port), $port);
  29 }
  30
  31 sub assert_or_find_available_port {
  32     my($self, $port) = @_;
  33     for my $i (1..MAX_PORT_TRIES) {
  34         IO::Socket::INET->new(
  35             LocalAddr => 'localhost',
  36             LocalPort => $port,
  37             Proto     => 'tcp'
  38         ) and return $port;
  39         $port += int(rand 100) + 1;
  40     }
  41     die q{Can't find an open port to run external server on after }
  42         . MAX_PORT_TRIES . q{tries};
  43 }
  44
  45 1;
  46