httpd-test-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: httpd-test/perl-framework/Apache-Test/lib/Apache TestRun.pm TestServer.pm
Date Wed, 05 Dec 2001 08:58:04 GMT
stas        01/12/05 00:58:04

  Modified:    perl-framework/Apache-Test/lib/Apache TestRun.pm
                        TestServer.pm
  Log:
  - refactors the polling code into Apache::TestServer::wait_till_is_up()
  - extends -ping=block option to block on -ping as well as on -run (usefull
  when working with -debug)
  
  Revision  Changes    Path
  1.72      +9 -19     httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm
  
  Index: TestRun.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm,v
  retrieving revision 1.71
  retrieving revision 1.72
  diff -u -r1.71 -r1.72
  --- TestRun.pm	2001/12/05 08:17:23	1.71
  +++ TestRun.pm	2001/12/05 08:58:04	1.72
  @@ -14,6 +14,8 @@
   use Getopt::Long qw(GetOptions);
   use Config;
   
  +use constant STARTUP_TIMEOUT => 300; # secs (good for extreme debug cases)
  +
   my @std_run      = qw(start-httpd run-tests stop-httpd);
   my @others       = qw(verbose configure clean help ssl http11);
   my @flag_opts    = (@std_run, @others);
  @@ -416,7 +418,11 @@
           exit 1 unless $server->start;
       }
       elsif ($opts->{'run-tests'}) {
  -        if (!$server->ping) {
  +        my $is_up = $server->ping
  +            || (exists $self->{opts}->{ping}
  +                && $self->{opts}->{ping}  eq 'block'
  +                && $server->wait_till_is_up(STARTUP_TIMEOUT));
  +        unless ($is_up) {
               error "server is not ready yet, try again.";
               exit;
           }
  @@ -635,24 +641,8 @@
           return $exit;
       }
   
  -    my $opt = $self->{opts}->{ping} || '';
  -    if ($opt eq 'block') {
  -        my $wait_secs = 300; # should be enough for extreme debug cases
  -        my $start_time = time;
  -        my $preamble = "\rwaiting for server $name to come up: ";
  -        while (1) {
  -            my $delta = time - $start_time;
  -            print $preamble, sprintf "%02d:%02d", (gmtime $delta)[1,0];
  -            sleep 1;
  -            if ($server->ping) {
  -                print $preamble, "\rserver $name is now up (waited $delta secs)    \n";
  -                last;
  -            }
  -            elsif ($delta > $wait_secs) {
  -                print $preamble, "giving up after $delta secs\n";
  -                last;
  -            }
  -        }
  +    if (exists $self->{opts}->{ping} && $self->{opts}->{ping} eq 'block')
{
  +        $server->wait_till_is_up(STARTUP_TIMEOUT);
       }
       else {
           warning "no server is running on $name";
  
  
  
  1.43      +23 -12    httpd-test/perl-framework/Apache-Test/lib/Apache/TestServer.pm
  
  Index: TestServer.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestServer.pm,v
  retrieving revision 1.42
  retrieving revision 1.43
  diff -u -r1.42 -r1.43
  --- TestServer.pm	2001/11/29 07:30:24	1.42
  +++ TestServer.pm	2001/12/05 08:58:04	1.43
  @@ -426,7 +426,7 @@
       $mpm = "($mpm MPM)" if $mpm;
       print "using $version $mpm\n";
   
  -    my $wait_secs = 60; # XXX: make a constant?
  +    my $timeout = 60; # secs XXX: make a constant?
   
       my $start_time = time;
       my $preamble = "\rwaiting for server to start: ";
  @@ -438,7 +438,7 @@
               print $preamble, "ok (waited $delta secs)\n";
               last;
           }
  -        elsif ($delta > $wait_secs) {
  +        elsif ($delta > $timeout) {
               print $preamble, "giving up after $delta secs\n";
               last;
           }
  @@ -463,6 +463,20 @@
           return 0;
       }
   
  +    $self->wait_till_is_up($timeout) && return 1;
  +
  +    $self->failed_msg("failed to start server!");
  +    return 0;
  +}
  +
  +
  +# wait till the server is up and return 1
  +# if the waiting times out returns 0
  +sub wait_till_is_up {
  +    my($self, $timeout) = @_;
  +    my $config = $self->{config};
  +    my $sleep_interval = 1; # secs
  +
       my $server_up = sub {
           local $SIG{__WARN__} = sub {}; #avoid "cannot connect ..." warnings
           $config->http_raw_get('/index.html');
  @@ -472,24 +486,21 @@
           return 1;
       }
   
  -    $start_time = time;
  -    $preamble = "\rstill waiting for server to warm up: ";
  +    my $start_time = time;
  +    my $preamble = "\rstill waiting for server to warm up: ";
       while (1) {
           my $delta = time - $start_time;
           print $preamble, sprintf "%02d:%02d", (gmtime $delta)[1,0];
  -        sleep 1;
  +        sleep $sleep_interval;
           if ($server_up->()) {
  -            print $preamble, "ok (waited $delta secs)\n";
  +            print "\rthe server is up (waited $delta secs)             \n";
               return 1;
           }
  -        elsif ($delta > $wait_secs) {
  -            print $preamble, "giving up after $delta secs\n";
  -            last;
  +        elsif ($delta > $timeout) {
  +            print "\rthe server is down, giving up after $delta secs\n";
  +            return 0;
           }
       }
  -
  -    $self->failed_msg("failed to start server!");
  -    return 0;
   }
   
   1;
  
  
  

Mime
View raw message