t/lib/PortFinder.pm

   1 # intentionally not changing package to jam the routine herein straight
   2 # into the use-ing package. Yes, this is totally a hack.
   3 #
   4 # Code is almost verbatim (bar _check_port -> $_check_port because I'm
   5 # polluting people's namespaces already) from Test::TCP 1.07 by
   6 # Tokuhiro Matsuno E<lt>tokuhirom@gmail.comE<gt> which is perl licensed.
   7
   8 use IO::Socket::INET;
   9 use strictures 1;
  10
  11 my $_check_port = sub {
  12     my ($port) = @_;
  13
  14     my $remote = IO::Socket::INET->new(
  15         Proto    => 'tcp',
  16         PeerAddr => '127.0.0.1',
  17         PeerPort => $port,
  18     );
  19     if ($remote) {
  20         close $remote;
  21         return 1;
  22     }
  23     else {
  24         return 0;
  25     }
  26 };
  27
  28 sub empty_port {
  29     my $port = do {
  30         if (@_) {
  31             my $p = $_[0];
  32             $p = 19000 unless $p =~ /^[0-9]+$/ && $p < 19000;
  33             $p;
  34         } else {
  35             10000 + int(rand()*1000);
  36         }
  37     };
  38
  39     while ( $port++ < 20000 ) {
  40         next if $_check_port->($port);
  41         my $sock = IO::Socket::INET->new(
  42             Listen    => 5,
  43             LocalAddr => '127.0.0.1',
  44             LocalPort => $port,
  45             Proto     => 'tcp',
  46             (($^O eq 'MSWin32') ? () : (ReuseAddr => 1)),
  47         );
  48         return $port if $sock;
  49     }
  50     die "empty port not found";
  51 }
  52