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] adding the startup polling functionality
Date Thu, 22 Nov 2001 16:23:13 GMT
I've figured out that I have to run many times t/TEST -run
until it successfully pings the server under t/TEST -d, so I want the
polling functionality for -run too. Since now we have 3 places where the
polling happens (start/ping/run), this patch:

- refactors the polling code into Apache::TestServer::wait_till_is_up()
- adds -poll option which will block until the server starts for -ping and
  -run opts. (which takes over the -ping=block which I've added this
  morning).

issues:
- any reason for not making -poll turned on by default for -run?

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.69
diff -u -r1.69 TestRun.pm
--- Apache-Test/lib/Apache/TestRun.pm	2001/11/22 03:11:38	1.69
+++ Apache-Test/lib/Apache/TestRun.pm	2001/11/22 15:59:10
@@ -14,11 +14,13 @@
 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 @others       = qw(verbose configure clean help ping poll ssl http11);
 my @flag_opts    = (@std_run, @others);
 my @string_opts  = qw(order);
-my @ostring_opts = qw(proxy ping);
+my @ostring_opts = qw(proxy);
 my @debug_opts   = qw(debug);
 my @num_opts     = qw(times);
 my @list_opts    = qw(preamble postamble breakpoint);
@@ -39,7 +41,8 @@
    '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[=block]'    => 'test if server is running or port in use',
+   'ping'            => 'test if server is running or port in use',
+   'poll'            => 'poll the server until it starts',
    '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",
@@ -202,6 +205,12 @@
         $opts{debug} = 1;
     }

+    # -poll should be used only with -run-tests or -ping
+    if ( $opts{poll} && !($opts{'run-tests'} || $opts{ping}) ) {
+        error "-poll is valid only with either -run-tests or -ping";
+        exit;
+    }
+
     # breakpoint automatically turns the debug mode on
     if (@{ $opts{breakpoint} }) {
         $opts{debug} ||= 1;
@@ -416,7 +425,9 @@
         exit 1 unless $server->start;
     }
     elsif ($opts->{'run-tests'}) {
-        if (!$server->ping) {
+        my $is_up = $server->ping ||
+            ($self->{opts}->{poll} && $server->wait_till_is_up(STARTUP_TIMEOUT));
+        unless ($is_up) {
             error "server is not ready yet, try again.";
             exit;
         }
@@ -634,24 +645,8 @@
         return 1;
     }

-    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 ($self->{opts}->{poll}) {
+        $server->wait_till_is_up(STARTUP_TIMEOUT);
     }
     else {
         warning "no server is running on $name";
Index: Apache-Test/lib/Apache/TestServer.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestServer.pm,v
retrieving revision 1.41
diff -u -r1.41 TestServer.pm
--- Apache-Test/lib/Apache/TestServer.pm	2001/11/22 03:13:04	1.41
+++ Apache-Test/lib/Apache/TestServer.pm	2001/11/22 15:59:10
@@ -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";
-            last;
+            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;

_____________________________________________________________________
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