Commit | Line | Data |
6bc86362 |
1 | package ExternalCatty; |
2 | use strict; |
3 | use warnings; |
08ff083c |
4 | use Catalyst; |
6435acdc |
5 | use IO::Socket::INET; |
6bc86362 |
6 | |
7 | __PACKAGE__->config( name => 'ExternalCatty' ); |
8 | __PACKAGE__->setup; |
08ff083c |
9 | __PACKAGE__->setup_engine('HTTP'); |
6bc86362 |
10 | |
6435acdc |
11 | sub MAX_PORT_TRIES() { 5 } |
12 | |
6bc86362 |
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; |
6435acdc |
18 | $port = $self->assert_or_find_available_port($port); |
6bc86362 |
19 | my $child = fork; |
20 | die "Can't fork Cat HTTP server: $!" unless defined $child; |
6435acdc |
21 | return($child, $port) if $child; |
6bc86362 |
22 | |
23 | if ( $^O !~ /MSWin32/ ) { |
24 | require POSIX; |
25 | POSIX::setsid() or die "Can't start a new session: $!"; |
26 | } |
27 | |
6435acdc |
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}; |
6bc86362 |
43 | } |
44 | |
45 | 1; |
46 | |