Commit | Line | Data |
90be5988 |
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 | |