httpd-test-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Stas Bekman <s...@stason.org>
Subject [patch] blocking ping
Date Wed, 21 Nov 2001 15:33:24 GMT
I'm still having troubles with a very slow gdb startup with mod_perl, and
I need a way to figure out when the server has been started (which I
don't want to do manually). Therefore I've extended the -ping option to
allow the optional -ping=block (blocking), which will ping the server
until it starts (or the timeout happens, 300 secs in the patch).

Index: Apache-Test/lib/Apache/TestRun.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm,v
retrieving revision 1.68
diff -u -r1.68 TestRun.pm
--- Apache-Test/lib/Apache/TestRun.pm	2001/11/13 21:05:44	1.68
+++ Apache-Test/lib/Apache/TestRun.pm	2001/11/21 15:09:27
@@ -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()
 }




_____________________________________________________________________
Stas Bekman             JAm_pH      --   Just Another mod_perl Hacker
http://stason.org/      mod_perl Guide   http://perl.apache.org/guide
mailto:stas@stason.org  http://ticketmaster.com http://apacheweek.com
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/


Mime
View raw message