Hi Monks,

My objective is to write a sub program to gzip 100s of files and move it to the different directory on a server. This is to enhanse our logrotation script. Sequentially gziping 100s of file is taking a lot of time and I want to increase the speed by spawning 10 new processes to Gzip the files. As a child process dies, I want to create another process so that at any point in time, there are 10 or less processes running on the server. This is inorder to makesure the resources are not run out.

Since this is the first time I'm working with fork() in perl, I thought I'll write a simpler program. Here is a perl program which I found on the net and modified just a lil bit. All this does is to spawn 3 processes to cat 3 files and as each child dies, It prints a message saying "Child Died" and exits after all the 3 children are dead.

However, I'm always finding either 1 or 2 of those children hanging. Please some one take a look at the code and tell me what is going wrong.

Thanks, Jyothi

PS : BELOW IS THE SCRIPT.

#!/usr/bin/perl -w

use strict;

use POSIX qw(:signal_h :errno_h :sys_wait_h);



sub sched{

  my $file = shift || die "Missing parameter for subroutine call\n";
  my $time = shift || die "Missing second parameter on subroutine call
++\n";
  my $chd = shift;
  sleep 5;
  my $cmd = `cat $file`;
  print " Child $chd in sched \n";
  print $cmd;   
}

# main program

my $pid; # process id
my $counter = 0;

my %children; # Hashtable to hold all pids of our children

my @childs; # will hold all pids of our children

$SIG{CHLD} = 

 sub{
    my $pid;
    my $j = -1;
    $pid = waitpid(-1, &WNOHANG);
    if (WIFEXITED($?)) {                       # Remove the child that
+ just died
        if($children{$pid}){;
        $j = $children{$pid};
        delete $children{$pid};         
        delete $childs[$j];
        print "Process $pid exited $j and $#childs\n";    
 
    }
        
    }
         
 };


$SIG{TERM} =
  sub{
        kill -9, @childs;
        exit(0)
  }; # allow to end program by pressinc Ctrl-C or a kill call

#this will hold all of our tasks
my @tasks = (
  {
    file => "msg.1",
    time => 10,
  },
  {
    file => "msg.2",
    time => 2,
  },
  {
    file => "msg.3",
    time => 5,
  },
);

# looping through the array of hashes and forking with each element

my $j =0;

FORLOOP: for my $i ( 0..$#tasks){

     FORK: {
     
       if ($pid = fork){            # first fork
         # we are parent
             push @childs,$pid;
         $children{$pid} = $#childs;
         print "Parent forked child # ===> $#childs,  pid = $pid \n";
         next FORLOOP;              
       }elsif (defined $pid){       # so we are a child
         print "Executing child $j \n";
         sched($tasks[$i]{file},$tasks[$i]{time}, $j);
         print "Done! pid = $pid\n";
         exit(0);  
       }elsif ($! =~/No more process/){
         sleep 5;
         redo FORK;
       }else{
         die "Something is wrong: $!\n";
       }
     }

}
print "started all children   $#childs \n";

while ($#childs > -1 ){;}  #Exit after all children are dead.
[download]