/[Frey]/trunk/lib/Frey/Test.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Frey/Test.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 103 by dpavlin, Fri Jul 11 23:08:25 2008 UTC revision 216 by dpavlin, Fri Oct 31 22:39:48 2008 UTC
# Line 1  Line 1 
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'!";
# Line 23  sub start_server { Line 41  sub start_server {
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 {
Legend:
Removed from v.103  
changed lines
  Added in v.216
  ViewVC Help
Powered by ViewVC 1.1.26