c has asked for the wisdom of the Perl Monks concerning the following question:

A while back I first started working with using fork in a script. After a number of PM posts, I had some working code. The problem now, I guess is that it works too well. I'm curious to know how to set an upper limit on the number of forked child processes. In some instances, my script would be able to break out over 2000 that could tax my server quite a bit. I'd like to be able to have the script have no more than 50 processes at a time.

I'm currently working with the following code base:

for my $i(@nodes) {
  if ($fork) {
    if ($pid = fork) {
      next;
    } elsif (defined($pid)) {
      &do_something;
      exit;
    } else {
      warn "Problem found in forking\n";
    }
  } else {
    &do_something;
  }
}

while (wait() != -1) {
  return 1 if ($?);
}

[download]

I'm not really sure at all how to achieve want I want in this case. Every solution that I have tried to come up with ends up only forking the first 50 processes and then ends up skipping the remaining in my list as my for loop just continues on its way. Can someone offer a suggestion on how I can accomplish this?

thanks -c

Replies are listed 'Best First'.
Re: Limiting the number of forks
by larryk (Friar) on Oct 02, 2002 at 12:21 UTC
    There is a module that already provides this functionality: Parallel::ForkManager 
    use Parallel::ForkManager;

$pm = new Parallel::ForkManager($MAX_PROCESSES);

foreach $data (@all_data) {
  # Forks and returns the pid for the child:
  my $pid = $pm->start and next;

  ... do some work with $data in the child process ...

  $pm->finish; # Terminates the child process
}

    [download]
    The code above is an excerpt from the man page of P::FM.

    Hope this helps, 

       larryk                                          
perl -le "s,,reverse killer,e,y,rifle,lycra,,print"
[reply]
[d/l]
Re: Limiting the number of forks
by bronto (Priest) on Oct 02, 2002 at 12:26 UTC

    If you want to do it "by hand" you could use a counter, incrementing it at each succeeding fork and decrementing it when you catch SIGCHLD.

    Ciao!
    --bronto

    # Another Perl edition of a song:
# The End, by The Beatles
END {
  $you->take($love) eq $you->make($love) ;
}

[reply]
[d/l]
[select]
Re: Limiting the number of forks
by Abigail-II (Bishop) on Oct 02, 2002 at 13:39 UTC
    You could use the following subroutine. Call it with three arguments, the number of forks you want, the maximum number of childs you can have around simultaneously, and a code reference of code a child needs to perform: 
    sub mfork ($$&) {
    my ($count, $max, $code) = @_;
 
    foreach my $c (1 .. $count) {
        wait unless $c <= $max;
        die "Fork failed: $!\n" unless defined (my $pid = fork);
        exit $code -> ($c) unless $pid;
    }

    1 until -1 == wait;
}

    [download]

    Abigail

[reply]
[d/l]
      Hi Abigail-II,

      Sorry to barge in to the middle of a discussion with a new question, but this code piqued my interest on your answer:

      exit $code -> ($c) unless $pid;

      In your discussion, you mentioned that $code should be a coderef. However, unless I'm mistaken (which is entirely possible) the above will not lead to the expected result in that case. I would rather expect something like:

      exit &$code unless $pid;

      I can make sense of your code if $code is in fact an object which implements $c methods (probably through autoloading).

      Could you throw some light on the darkness of my confusion?

      CU
      Robartes-

[reply]
[d/l]
[select]
        You didn't try, did you? 
        use strict;
use warnings 'all';

sub mfork ($$&) {
    my ($count, $max, $code) = @_;

    foreach my $c (1 .. $count) {
        wait unless $c <= $max;
        die "Fork failed: $!\n" unless defined (my $pid = fork);
        exit $code -> ($c) unless $pid;
    }

    1 until -1 == wait;
}


mfork 10, 3, sub {
    print "$$: " . localtime () . ": Starting\n";
    select undef, undef, undef, 2 + rand 2;
    print "$$: " . localtime () . ": Exiting\n";
};
__END__
972: Wed Oct  2 16:06:32 2002: Starting
973: Wed Oct  2 16:06:32 2002: Starting
974: Wed Oct  2 16:06:32 2002: Starting
973: Wed Oct  2 16:06:34 2002: Exiting
975: Wed Oct  2 16:06:34 2002: Starting
972: Wed Oct  2 16:06:35 2002: Exiting
976: Wed Oct  2 16:06:35 2002: Starting
974: Wed Oct  2 16:06:35 2002: Exiting
977: Wed Oct  2 16:06:35 2002: Starting
975: Wed Oct  2 16:06:38 2002: Exiting
978: Wed Oct  2 16:06:38 2002: Starting
977: Wed Oct  2 16:06:39 2002: Exiting
979: Wed Oct  2 16:06:39 2002: Starting
976: Wed Oct  2 16:06:39 2002: Exiting
980: Wed Oct  2 16:06:39 2002: Starting
978: Wed Oct  2 16:06:41 2002: Exiting
981: Wed Oct  2 16:06:41 2002: Starting
979: Wed Oct  2 16:06:41 2002: Exiting
980: Wed Oct  2 16:06:42 2002: Exiting
981: Wed Oct  2 16:06:45 2002: Exiting

        [download]

        Please consult the perlref manual page for syntax details dealing with references.

        Abigail

[reply]
[d/l]

Back to Seekers of Perl Wisdom