lib/Frey/Test.pm

package Frey::Test;

use IO::Handle;

our $kid_pid;

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

sub get_server {
        my ( $self, $kid_out ) = @_;
        my $server = <$kid_out>;
        chomp $server;
        if($server =~ /http:\/\/[^:]+:(\d+)/) {
                $server = "http://localhost:$1/";
                warn "## server $server";
        } else {
                die "can't start server";
        }
        return $server;
}

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

1;

1	package Frey::Test;
2
3	use IO::Handle;
4
5	our $kid_pid;
6
7	sub start_server {
8	my ($self,$filename) = @_;
9	$filename \|\|= './bin/server.pl';
10	$kid_pid = open(my $kid_out, '-\|');
11	die "Unable to fork!" unless defined($kid_pid);
12	if($kid_pid) {
13	$kid_out->autoflush;
14	return $kid_out;
15	} else {
16	if(-e $filename) {
17	$ENV{FREY_PORT} = int( 16000 + rand(1000) );
18	do $filename or die "Unable to eval $filename! $@";
19	} else {
20	die "I can't find '$filename'!";
21	}
22	exit;
23	}
24	}
25
26	sub get_server {
27	my ( $self, $kid_out ) = @_;
28	my $server = <$kid_out>;
29	chomp $server;
30	if($server =~ /http:\/\/[^:]+:(\d+)/) {
31	$server = "http://localhost:$1/";
32	warn "## server $server";
33	} else {
34	die "can't start server";
35	}
36	return $server;
37	}
38
39	sub stop_server {
40	my ( $self ) = @_;
41	kill 9, $kid_pid;
42	}
43
44	1;
45