lib/Frey/Test.pm

package Frey::Test;

=head1 NAME

Frey::Test - start and stop server child

=head1 SYNPOSYS

  my $url = Frey::Test->start_server;

  Frey::Test->stop_server;

=cut

use warnings;
use strict;

use IO::Handle;
use IO::Socket::INET;

our $kid_pid;
our $kid_out;

sub _fork {
        my ($self,$filename) = @_;
        $ENV{FREY_PORT} = int( 16000 + rand(1000) );
        $filename ||= './bin/continuity-server.pl';
        $kid_pid = open($kid_out, '-|');
        die "Unable to fork!" unless defined($kid_pid);
        if($kid_pid) {
                $kid_out->autoflush;
                warn "## child pid $kid_pid\n";
                return $kid_pid;
        } else {
                if(-e $filename) {
                        do $filename or die "Unable to eval $filename! $@";
                } else {
                        die "I can't find '$filename'!";
                }
                exit;
        }
}

sub start_server {
        my ( $self ) = @_;
        $self->_fork unless $kid_out;
        my $host = '127.0.0.1:' . $ENV{FREY_PORT};
        warn "## waiting for $host to start";
        while ( ! IO::Socket::INET->new( $host ) ) {
                warn ".";
                sleep 1;
        }
        return "http://$host";
}

sub stop_server {
        my ( $self ) = @_;
        kill 9, $kid_pid;
}

1;

1	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;
19	use IO::Socket::INET;
20
21	our $kid_pid;
22	our $kid_out;
23
24	sub _fork {
25	my ($self,$filename) = @_;
26	$ENV{FREY_PORT} = int( 16000 + rand(1000) );
27	$filename \|\|= './bin/continuity-server.pl';
28	$kid_pid = open($kid_out, '-\|');
29	die "Unable to fork!" unless defined($kid_pid);
30	if($kid_pid) {
31	$kid_out->autoflush;
32	warn "## child pid $kid_pid\n";
33	return $kid_pid;
34	} 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	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	}
53	return "http://$host";
54	}
55
56	sub stop_server {
57	my ( $self ) = @_;
58	kill 9, $kid_pid;
59	}
60
61	1;
62