1 |
package Frey::Test; |
package Frey::Test; |
2 |
|
|
3 |
|
=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 |
use IO::Handle; |
use IO::Handle; |
19 |
|
use IO::Socket::INET; |
20 |
|
|
21 |
our $kid_pid; |
our $kid_pid; |
22 |
|
our $kid_out; |
23 |
|
|
24 |
sub start_server { |
sub _fork { |
25 |
my ($self,$filename) = @_; |
my ($self,$filename) = @_; |
26 |
|
$ENV{FREY_PORT} = int( 16000 + rand(1000) ); |
27 |
$filename ||= './bin/server.pl'; |
$filename ||= './bin/server.pl'; |
28 |
$kid_pid = open(my $kid_out, '-|'); |
$kid_pid = open($kid_out, '-|'); |
29 |
die "Unable to fork!" unless defined($kid_pid); |
die "Unable to fork!" unless defined($kid_pid); |
30 |
if($kid_pid) { |
if($kid_pid) { |
31 |
$kid_out->autoflush; |
$kid_out->autoflush; |
32 |
return $kid_out; |
warn "## child pid $kid_pid\n"; |
33 |
|
return $kid_pid; |
34 |
} else { |
} else { |
35 |
if(-e $filename) { |
if(-e $filename) { |
|
$ENV{FREY_PORT} = int( 16000 + rand(1000) ); |
|
36 |
do $filename or die "Unable to eval $filename! $@"; |
do $filename or die "Unable to eval $filename! $@"; |
37 |
} else { |
} else { |
38 |
die "I can't find '$filename'!"; |
die "I can't find '$filename'!"; |
41 |
} |
} |
42 |
} |
} |
43 |
|
|
44 |
sub get_server { |
sub start_server { |
45 |
my ( $self, $kid_out ) = @_; |
my ( $self ) = @_; |
46 |
my $server = <$kid_out>; |
$self->_fork unless $kid_out; |
47 |
chomp $server; |
my $host = '127.0.0.1:' . $ENV{FREY_PORT}; |
48 |
if($server =~ /http:\/\/[^:]+:(\d+)/) { |
warn "## waiting for $host to start"; |
49 |
$server = "http://localhost:$1/"; |
while ( ! IO::Socket::INET->new( $host ) ) { |
50 |
warn "## server $server"; |
warn "."; |
51 |
} else { |
sleep 1; |
|
die "can't start server"; |
|
52 |
} |
} |
53 |
return $server; |
return "http://$host"; |
54 |
} |
} |
55 |
|
|
56 |
sub stop_server { |
sub stop_server { |