Here's a skeleton from something I've used successfully for dealing with large numbers of processes by forking a limited number in parallel.

# UNTESTED
# @srvrs is potentially LARGE array of servers to test
# $frk is maximum number of processes to fork at one time.

while ( @srvrs )
{
   SRVR:   
   for (1..$frk)
   {
       $x = shift @srvrs or last SRVR;

       $pid = fork; 
       if ( $pid )
       {       
            push @pids, $pid
       }       
       elsif ( defined $pid )
       {       
            # DO thing with $x you want parallelized  (testing servers
+) here
            exit;   
       }       
       else                                                           
+                                                                
       {
           die "fork failed\n";
       }       
   }

   waitpid($_, 0) for ( @pids );
}
[download]

Take a look at Parallel::ForkManager. It'll do most of this work for you, keeping track of N available process slots.

You are right- it is far easier.


#!/usr/bin/perl -w strict

use strict;
use DBI;
use Parallel::ForkManager;

my $dbh = DBI->connect('DBI:mysql:noc', 'root', '') or die "Couldn't o
+pen database: $DBI::errstr; stopped";
my $fm = new Parallel::ForkManager(10);

while (1) {
my $sth = $dbh->prepare("select assetid,ip,snmpname from assets") or d
+ie "Couldn't prepare statement: $DBI::errstr; stopped";
$sth->execute() or die "Couldnt execute statement: $DBI::errsrt; stopp
+ed";
  my @ret;
  while ( my ($aid, $aip, $asnmp) = $sth->fetchrow_array() ) {
    $fm->start and next;
    ping_remote($aip,$aid,$asnmp);
    $fm->finish;
  }
  $fm->wait_all_children; 
  sleep(5);
  print "repeating\n";
} 

sub ping_remote {
  my $ip = shift;
  my $aid = shift;
  my $snmpname = shift;
  my @ret = undef;
  my @p = split(/(,)/,`ping -c 1 $ip | grep "0% loss"`);
  if ($p[4] eq " 0% loss") {
    my $a=`/etc/poller/snmptraffic.php "$ip" "$snmpname"`;
    my $u=`/etc/poller/snmpuptime.php "$ip" "$snmpname"`;
    my $f=`/etc/poller/snmpfirmware.php "$ip" "$snmpname"`;
    @ret = ($a,$u,$f);
  }
  if (@ret) {
    print "$ip\n";
    my $sth2 = $dbh->prepare("insert into history set assetid='$aid', 
+trafficload='$ret[1]'") or die "Couldn't prepare statement: $DBI::err
+str; stopped";    
    $sth2->execute() or die "Couldnt execute statement: $DBI::errsrt; 
+stopped";
    $sth2 = $dbh->prepare("update assets set firmware='$ret[2]', uptim
+e='$ret[1]', status='u', trafficload='$ret[0]' where assetid='$aid'")
+ or die "Couldn't prepare statement: $DBI::errstr; stopped";    
    $sth2->execute() or die "Couldnt execute statement: $DBI::errsrt; 
+stopped";
  } else {
    print "down - $ip\n";
    my $sth2 = $dbh->prepare("update assets set status='d' where asset
+id='$aid'") or die "Couldn't prepare statement: $DBI::errstr; stopped
+";    
    $sth2->execute() or die "Couldnt execute statement: $DBI::errsrt; 
+stopped";
  }
}
[download]


THANKS!

Having said that, the way this is written it appears to me that you only ever fork one child process at a time, always waiting for that to complete before doing the next. I fail to see how this will get the improvement you are hoping for.

Maybe you should think about moving the waitpid() call to outside the inside while loop and use waitpid(-1,&WNOHANG) to wait for all child processes as documented in the Camel book.

But thinking about it you probably want to limit the number of child process to some fixed number (eg 10 or 20), so the solution becomes a bit more complicated than that.....

I hope I'm not way off the track here as I haven't used fork() much myself either.

Cheers!

PS. I suppose you realise that the array @a which you declare twice and assign to once is never used anywhere? I'm guessing this is left over from some debugging or such?

Cheers!

Yes, the code works otherwise, and @a was an attempt at something that also didnt work, but I'm more concerned about forking the process of pinging the node. I havent thought about moving the waitpid to outside the loop either. I'll give that a shot.