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
Date Thu, 22 Nov 2001 03:11:38 GMT
stas        01/11/21 19:11:38

  Modified:    perl-framework/Apache-Test/lib/Apache TestRun.pm
  Log:
  - extend -ping to optionally do -ping=block, which will block until the
  server starts and report the wait time as it waits.
  
  Revision  Changes    Path
  1.69      +28 -6     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.68
  retrieving revision 1.69
  diff -u -r1.68 -r1.69
  --- TestRun.pm	2001/11/13 21:05:44	1.68
  +++ TestRun.pm	2001/11/22 03:11:38	1.69
  @@ -15,16 +15,16 @@
   use Config;
   
   my @std_run      = qw(start-httpd run-tests stop-httpd);
  -my @others       = qw(verbose configure clean help ping ssl http11);
  +my @others       = qw(verbose configure clean help ssl http11);
   my @flag_opts    = (@std_run, @others);
   my @string_opts  = qw(order);
  -my @ostring_opts = qw(proxy);
  +my @ostring_opts = qw(proxy ping);
   my @debug_opts   = qw(debug);
   my @num_opts     = qw(times);
   my @list_opts    = qw(preamble postamble breakpoint);
   my @hash_opts    = qw(header);
   my @help_opts    = qw(clean help ping);
  -my @exit_opts    = (@help_opts,@debug_opts);
  +my @exit_opts    = (@help_opts, @debug_opts);
   my @request_opts = qw(get post head);
   
   my %usage = (
  @@ -39,7 +39,7 @@
      'help'            => 'display this message',
      'preamble'        => 'config to add at the beginning of httpd.conf',
      'postamble'       => 'config to add at the end of httpd.conf',
  -   'ping'            => 'test if server is running or port in use',
  +   'ping[=block]'    => 'test if server is running or port in use',
      'debug[=name]'    => 'start server under debugger name (e.g. gdb, ddd, ...)',
      'breakpoint=bp'   => 'set breakpoints (multiply bp can be set)',
      'header'          => "add headers to (".join('|', @request_opts).") request",
  @@ -367,7 +367,7 @@
       my $self = shift;
   
       for (@exit_opts) {
  -        next unless $self->{opts}->{$_};
  +        next unless exists $self->{opts}->{$_};
           my $method = "opt_$_";
           exit if $self->$method();
       }
  @@ -634,7 +634,29 @@
           return 1;
       }
   
  -    warning "no server is running on $name";
  +    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;
  +            }
  +        }
  +    }
  +    else {
  +        warning "no server is running on $name";
  +    }
  +
       return 1; #means call exit()
   }
   
  
  
  

Mime
View raw message