1 |
dpavlin |
103 |
package Frey::Test; |
2 |
|
|
|
3 |
dpavlin |
216 |
=head1 NAME |
4 |
|
|
|
5 |
|
|
Frey::Test - start and stop server child |
6 |
|
|
|
7 |
|
|
=head1 SYNPOSYS |
8 |
|
|
|
9 |
|
|
my $url = Frey::Test->start_server; |
10 |
|
|
|
11 |
|
|
Frey::Test->stop_server; |
12 |
|
|
|
13 |
|
|
=cut |
14 |
|
|
|
15 |
|
|
use warnings; |
16 |
|
|
use strict; |
17 |
|
|
|
18 |
dpavlin |
103 |
use IO::Handle; |
19 |
dpavlin |
216 |
use IO::Socket::INET; |
20 |
dpavlin |
103 |
|
21 |
|
|
our $kid_pid; |
22 |
dpavlin |
216 |
our $kid_out; |
23 |
dpavlin |
103 |
|
24 |
dpavlin |
216 |
sub _fork { |
25 |
dpavlin |
103 |
my ($self,$filename) = @_; |
26 |
dpavlin |
216 |
$ENV{FREY_PORT} = int( 16000 + rand(1000) ); |
27 |
dpavlin |
307 |
$filename ||= './bin/continuity-server.pl'; |
28 |
dpavlin |
216 |
$kid_pid = open($kid_out, '-|'); |
29 |
dpavlin |
103 |
die "Unable to fork!" unless defined($kid_pid); |
30 |
|
|
if($kid_pid) { |
31 |
|
|
$kid_out->autoflush; |
32 |
dpavlin |
216 |
warn "## child pid $kid_pid\n"; |
33 |
|
|
return $kid_pid; |
34 |
dpavlin |
103 |
} else { |
35 |
|
|
if(-e $filename) { |
36 |
|
|
do $filename or die "Unable to eval $filename! $@"; |
37 |
|
|
} else { |
38 |
|
|
die "I can't find '$filename'!"; |
39 |
|
|
} |
40 |
|
|
exit; |
41 |
|
|
} |
42 |
|
|
} |
43 |
|
|
|
44 |
dpavlin |
216 |
sub start_server { |
45 |
|
|
my ( $self ) = @_; |
46 |
|
|
$self->_fork unless $kid_out; |
47 |
|
|
my $host = '127.0.0.1:' . $ENV{FREY_PORT}; |
48 |
|
|
warn "## waiting for $host to start"; |
49 |
|
|
while ( ! IO::Socket::INET->new( $host ) ) { |
50 |
|
|
warn "."; |
51 |
|
|
sleep 1; |
52 |
dpavlin |
103 |
} |
53 |
dpavlin |
216 |
return "http://$host"; |
54 |
dpavlin |
103 |
} |
55 |
|
|
|
56 |
|
|
sub stop_server { |
57 |
|
|
my ( $self ) = @_; |
58 |
|
|
kill 9, $kid_pid; |
59 |
|
|
} |
60 |
|
|
|
61 |
|
|
1; |
62 |
|
|
|