--- multiping-original.pl	Tue Jun  3 15:01:00 2003
+++ multiping-new.pl	Tue Jun  3 14:53:16 2003
@@ -1,5 +1,5 @@
-#!/usr/bin/perl
-
+#!/usr/bin/perl -wT
+use strict;
 
 BEGIN
 {
@@ -42,40 +42,37 @@
 sub QUEUE_EPOCH     ()  { 0 }
 sub QUEUE_SESSION   ()  { 1 }
 
-sub MAX_CONNECTIONS ()  { 5 }
+sub MAX_CONNECTIONS ()  { 254 }
 sub TIMEOUT         ()  { 2 }
 
 
+my $verbose = 1;
+my $debug = 0;
+
 my @hosts = 
 (
     '192.168.0.1',
     '192.168.0.100',
-    'www.perlmonks.org'
+    'www.perlmonks.org',
 );
 
+my @responses;
 
 #   Initialise variables utilised by the time-slice execution loop mechanism
 
-my @timeout = ();
-my %ping = ();
+my %queue;
+my %ping;
 
 
-#   This solitary goto provides an efficient means of entering the execution
-#   loop and populating the session table using the existing mechanism for
-#   initiating new sessions within the loop.
-
 my ( $length, $sequence, $socket );
 
-goto START;
-
+$sequence = 0;
 
-#   The main loop for execution centers around the list of scheduled events
-#   within the execution queue - As long as the execution queue is populated,
-#   this loop will continue execution.
+# Loop if we have pings in progress, or if we still have hosts left to be pung.
 
-while ( scalar @timeout )
+MAIN_LOOP:
+while ( %queue or @hosts)
 {
-    START:
 
     #   If there are hosts still pending connection tests, check to see if any new
     #   pings for testing server connectivity should be started.
@@ -105,10 +102,11 @@
             #   to being used for the packet sequence, this value is also used as the
             #   unique name for the ping session.
 
+		SEQUENCE_LOOP:
             while ( 1 )
             {
                 $sequence = ( $sequence + 1 ) & 0xFFFF;
-                last unless exists $ping{ $sequence };
+			last SEQUENCE_LOOP unless exists $ping{ $sequence };
             }
 
             #   Build the message packet without a checksum
@@ -150,8 +148,9 @@
             #   of hosts of which test connectivity.
 
             my $address = shift @hosts;
+		  next MAIN_LOOP unless defined($address);
             my $netaddr = inet_aton( $address );
-            next unless defined $netaddr;
+		  next MAIN_LOOP unless defined($netaddr);
 
             my $sockaddr = pack_sockaddr_in( ICMP_PORT, $netaddr );
             send( $socket, $msg, ICMP_FLAGS, $sockaddr ) or
@@ -163,7 +162,7 @@
             #   a queue where a basic queue with all events are added in a time sequential
             #   fashion would suffice.
 
-            push @timeout, [ time + TIMEOUT, $sequence ];
+		  $queue{$sequence} = time + TIMEOUT;
 
             #   Create a new ping session entry in the session hash - This session entry
             #   contains the host name being pinged and the time since epoch at which the
@@ -177,11 +176,13 @@
     #   remote host - This has the added effect of performing a sleep type function
     #   until the next delay event is due, minimising wasted cycles.
 
-    my $timeout = $queue[0]->[QUEUE_EPOCH] - time;
-    $timeout = MINIMUM_TIMEOUT if $timeout < MINIMUM_TIMEOUT;
+      my $timeout = MINIMUM_TIMEOUT;
 
     vec( my $read_in = '', fileno( $socket ), 1 ) = 1;
-    select( my $read_out = $read_in, undef, undef, $timeout );
+      
+      # Make sure we collect *all* responses that have arrived before we 
+      # process timeouts
+      while(select( my $read_out = $read_in, undef, undef, $timeout ) > 0) {
     if ( vec( $read_out, fileno( $socket ), 1 ) )
     {
         my $now = time;
@@ -207,41 +208,42 @@
                 #   timeout event in the event queue.
 
                 my ( $address, $time ) = @{ delete $ping{ $reply_sequence } };
-                @timeout = grep
-                {
-                    $_->[QUEUE_SESSION] ne $reply_sequence
-                }
-                @timeout;
+			    delete($queue{$reply_sequence});
 
                 #   The ping attempt was successful and should now be actioned - Remember
                 #   however, that this execution is taking place within a time-slice sharing
                 #   environment and as such care should be taken to avoid any long or blocking
                 #   processes.
 
-                print STDOUT sprintf( "Reply time for %s - %.3f seconds\n", $address, $now - $time );
+			    print STDOUT sprintf( "Reply time for %s - %.3f seconds\n", $address, $now - $time )
+			      if($verbose >= 1);
+			    push(@responses, $address);
+			}
             }
         }
     }
+      print "Leaving select loop\n"
+	if($debug);
 
     #   The following test removes any sessions which have passed their expiry
     #   timeout and thus should be treated as failed connection checks.
 
     my $now = time;
-    while ( scalar @timeout and $queue[0]->[QUEUE_EPOCH] < $now )
-    {
-        my $item = shift @timeout;
-        my ( $address ) = @{ delete $ping{ $item->[QUEUE_SESSION] } };
-
-        #   The ping attempt did not return any echo reply and as such considered to
-        #   have failed.
+      while(my ($sequence, $timeout) = each(%queue)) {
+	  if($timeout < $now) {
+	      delete($queue{$sequence});
+	      my $address = $ping{$sequence}->[0];
+	      delete($ping{$sequence});
 
-        print STDOUT sprintf( "No reply for %s\n", $address );
+	      print STDOUT sprintf( "No reply for %s\n", $address )
+		if($verbose >= 2);
+	  }
     }
 }
 
 
-exit 0;
-
-
-
+for(@responses) {
+    print sprintf("PONG: %s\n", $_);
+}
 
+exit 0;