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

I have a script which takes many servers and processes scp files to each. I don't want to have to wait for each server to finish, so I've tried using Parallel::Forkmanager. However it acts exactly the same as in a loop which waits on each server to complete. Here is the code I've implemented. Can someone tell me what I'm missing to get this to fork correctly


foreach my $server (@servers) {
  my $pid = $fork_manager->start;
  if ($pid) {
    eval {
       local $SIG{ALRM} = sub { die "alarm\n" };
       alarm $timeout;
       my $rc = system("scp -p $file $user\@$server:$rpath/$fname");
    };
  }
  else {
    print "$$: child process started, with a key of $server ($pid)\n";
  }
  $fork_manager->finish;
}

$fork_manager->wait_all_children();

[download]

Replies are listed 'Best First'.
Re: Parallel::Forkmanager question
by 1nickt (Canon) on Apr 06, 2017 at 00:31 UTC

    Hi jamesgerard1964,

    Did I miss something in your question?

    it acts exactly the same as in a loop which waits on each server to complete

    That's pretty well the point of wait_all_children().

    If you want to continue the parent without waiting for the children, remove that line.

    Hope this helps!


    The way forward always starts with a minimal test.
[reply]
[d/l]
Re: Parallel::Forkmanager question
by Anonymous Monk on Apr 06, 2017 at 01:39 UTC

    Hello jamesgerard1964,

    Give the following a try. Please excuse me for filling in the missing pieces. Thus, adjust accordingly to suit your task.

    use strict;
use warnings;

use Parallel::ForkManager;

my @servers = ('a'..'z');
my $timeout = 10;
my $user    = "foo";
my $file    = "/tmp/hello.txt";
my $rpath   = "/tmp";
my $fname   = "hello.txt";

my $fork_manager = Parallel::ForkManager->new(8);

$fork_manager->set_waitpid_blocking_sleep(0);

foreach my $server (@servers) {
  my $pid = $fork_manager->start;
  if ($pid) {
    # parent
    print "$$: child process started, with a key of $server ($pid)\n";
  }
  else {
    # child
    eval {
       local $SIG{ALRM} = sub { alarm 0; die "alarm\n" };
       alarm $timeout;
       my $rc = system("scp -p $file $user\@$server:$rpath/$fname");
    };
    alarm 0;
    $fork_manager->finish;
  }
}

$fork_manager->wait_all_children();

    [download]

    A non-zero $pid values is meant for the parent process. Therefore, a $pid value when 0 is the child process itself.

[reply]
[d/l]

      Hello again jamesgerard1964,

      I wanted to try another way using MCE::Loop. It might look something like this.

      use strict;
use warnings;

use MCE::Loop chunk_size => 1, max_workers => 8;

my @servers = ('a'..'z');
my $timeout = 10;
my $user    = "foo";
my $file    = "/tmp/hello.txt";
my $rpath   = "/tmp";
my $fname   = "hello.txt";

mce_loop {
  my $server = $_;
  MCE->say("child process running, with a key of $server ($$)");
  eval {
     local $SIG{ALRM} = sub { alarm 0; die "alarm\n" };
     alarm $timeout;
     my $rc = system("scp -p $file $user\@$server:$rpath/$fname");
  };
  alarm 0;
} @servers;

      [download]

      Well, that's another way.

[reply]
[d/l]

        Hello again, jamesgerard1964,

        Fortunately, the MCE::Shared module is not exclusive to MCE workers. The following is a demonstration using Parallel::ForkManager and MCE::Shared. Workers store the status into a shared hash.

        use strict;
use warnings;

use Parallel::ForkManager;
use MCE::Shared;

my @servers = ('a'..'z');
my $timeout = 10;
my $user    = "foo";
my $file    = "/tmp/hello.txt";
my $rpath   = "/tmp";
my $fname   = "hello.txt";

tie my %result, 'MCE::Shared';

my $fork_manager = Parallel::ForkManager->new(8);

$fork_manager->set_waitpid_blocking_sleep(0);

foreach my $server (@servers) {
  my $pid = $fork_manager->start;
  if ($pid) {
    # parent
    print "$$: child process started, with a key of $server ($pid)\n";
  }
  else {
    # child
    eval {
       local $SIG{ALRM} = sub { alarm 0; die "alarm\n" };
       alarm $timeout;
       $result{$server} = system("scp -p $file $user\@$server:$rpath/$
+fname");
    };
    alarm 0;
    $fork_manager->finish;
  }
}

$fork_manager->wait_all_children;

for my $server ( sort keys %result ) {
  my ($status, $signum);

  $status = $result{$server};
  $signum = $status & 127;    # extract signal number
  $status = $status >> 8;     # becomes exit status

  print "$server: exit_status $status, signal_num $signum\n";
}

        [download]
[reply]
[d/l]

        Hello again jamesgerard1964,

        One might find useful the exit_status from each system call. The MCE::Shared module is helpful in that regard.

        On purpose, am making a slight change to using MCE::Loop. The comma is needed after the sub { ... } block before @servers. Basically, am calling three methods: ->init to configure MCE options, ->run to run the code block, and finally ->finish to shutdown and reap workers. Afterwards, like to see the system status captured into the shared hash.

        use strict;
use warnings;

use MCE::Loop;
use MCE::Shared;

my @servers = ('a'..'z');
my $timeout = 10;
my $user    = "foo";
my $file    = "/tmp/hello.txt";
my $rpath   = "/tmp";
my $fname   = "hello.txt";

tie my %result, 'MCE::Shared';

MCE::Loop->init(
   chunk_size  => 1,
   max_workers => 8,
);

MCE::Loop->run( sub {
  my $server = $_;
  MCE->say("child process running, with a key of $server ($$)");
  eval {
     local $SIG{ALRM} = sub { alarm 0; die "alarm\n" };
     alarm $timeout;
     $result{$server} = system("scp -p $file $user\@$server:$rpath/$fn
+ame");
  };
  alarm 0;
}, @servers );

MCE::Loop->finish;

for my $server ( sort keys %result ) {
  my ($status, $signum);

  $status = $result{$server};
  $signum = $status & 127;    # extract signal number
  $status = $status >> 8;     # becomes exit status

  print "$server: exit_status $status, signal_num $signum\n";
}

        [download]

        Thank you for reaching out to Perlmonks.

[reply]
[d/l]
Re: Parallel::Forkmanager question
by stevieb (Canon) on Apr 06, 2017 at 00:21 UTC

    What platform are you on, and what are you expecting/getting in $rc?

    How are you confirming that the procs aren't fed out properly and finishing in an order that you don't expect?

    How many forks are you starting with your init call? Please show the code that shows how you're initializing Parallel::ForkManager.

    In other words, what output are you expecting, and what output are you receiving that doesn't align with expectations?

[reply]
[d/l]
[select]

      platform is Linux Red Hat. I am currently testing with 9 servers in the list. When I run the script without Parallel::Forkmanager what is happening is that the script will loop thru and process each server using the system call to scp a file. The script will wait for that system call to finish and then continue to the next server. It seems like that is exactly whats happening with the fork. It's processing 1 server at a time, unless I'm not seeing this correctly. The reason I had the wait for all children is that I want to make sure all the servers have been processed before continuing on. I am adding time stamps to the print statements to show what is happening. Here is the code and the output. 


      
my $concurrent_fork_limit = 9;
my $fork_manager = Parallel::ForkManager->new($concurrent_fork_limit);

foreach my $server (@servers) {

  my $pid = $fork_manager->start;

  if ($pid) {
    my ($dstamp, $hstamp) = &next_time();
    print "$dstamp $hstamp $$: child process started, with a key of $s
+erver ($pid)\n";
    print "\nWorking On Server ->  $server\n";
    print "Sending File      ->  $file\n";

    my $timeout = 20;
    eval {
       local $SIG{ALRM} = sub { die "alarm\n" };
       alarm $timeout;
       my $rc = system("scp -p $file $user\@$fqdn:$rpath/$fname");
       print "\nReturn Code For Server -> $server  File -> $file  = $r
+c\n\n\n";
       alarm 0;
    };
    if( $@ ) {
      $nogood{$server}++;
    }
  }
  $fork_manager->finish;
}

$fork_manager->wait_all_children();
my ($fstamp, $dstamp, $hstamp) = &next_time();
print "\n\n\n$dstamp $hstamp All Children Finished, Continuing\n\n";

      [download]


      04/06/2017 08:56:23 127266: child process started, with a key of server01 (127269)
      Working On Server -> server01.domain.com
      Sending File -> mkdir.pl
      Return Code For Server -> server01.domain.com File -> mkdir.pl = 0


      04/06/2017 08:56:25 127266: child process started, with a key of server02 (127273)
      Working On Server -> server02.domain.com
      Sending File -> mkdir.pl
      Return Code For Server -> server02.domain.com File -> mkdir.pl = 0


      04/06/2017 08:56:26 127266: child process started, with a key of server03 (127278)
      Working On Server -> server03.domain.com
      Sending File -> mkdir.pl
      Return Code For Server -> server03.domain.com File -> mkdir.pl = 0


      04/06/2017 08:56:28 127266: child process started, with a key of server04 (127282)
      Working On Server -> server04.domain.com
      Sending File -> mkdir.pl
      Return Code For Server -> server04.domain.com File -> mkdir.pl = 0


      04/06/2017 08:56:29 127266: child process started, with a key of server05 (127286)
      Working On Server -> server05.domain.com
      Sending File -> mkdir.pl
      Return Code For Server -> server05.domain.com File -> mkdir.pl = 0


      04/06/2017 08:56:31 127266: child process started, with a key of server06 (127290)
      Working On Server -> server06.domain.com
      Sending File -> mkdir.pl
      Return Code For Server -> server06.domain.com File -> mkdir.pl = 0


      04/06/2017 08:56:32 127266: child process started, with a key of server07 (127294)
      Working On Server -> server07.domain.com
      Sending File -> mkdir.pl
      Return Code For Server -> server07.domain.com File -> mkdir.pl = 0


      04/06/2017 08:56:34 127266: child process started, with a key of server08 (127298)
      Working On Server -> server08.domain.com
      Sending File -> mkdir.pl
      Return Code For Server -> server08.domain.com File -> mkdir.pl = 0


      04/06/2017 08:56:35 127266: child process started, with a key of server09 (127303)
      Working On Server -> server09.domain.com
      Sending File -> mkdir.pl
      Return Code For Server -> server09.domain.com File -> mkdir.pl = 0


      04/06/2017 08:56:35 All Children Finished, Continuing

[reply]
[d/l]

        As your output shows, the same process is handling all the tasks. That's because the parent is forking a child but then continuing the work itself.

        You are missing the statement that causes the parent to skip out of the loop. See the doc for Parallel::ForkManager, which states (emphasis added):

        • Next, use $pm->start to do the fork. $pm returns 0 for the child process, and child pid for the parent process (see also "fork()" in perlfunc(1p)). The "and next" skips the internal loop in the parent process.

        The following example shows the difference: 

        use strict; use warnings; use feature 'say';
use Parallel::ForkManager;
use Time::HiRes qw/ time /;

$|++;

my $forker = Parallel::ForkManager->new(4);
say "v.1";
for ( 0 .. 9 ) {
    my $pid = $forker->start;
    if ( $pid ) {
        say "1 $$ $_ start: " . time;
        sleep 1;
    }
    $forker->finish;
}

my $forker2 = Parallel::ForkManager->new(4);
say "v.2";
for ( 0 .. 9 ) {
    my $pid = $forker->start and next;
    say "2 $$ $_ start: " . time;
    sleep 1;
    $forker->finish;
}

__END__

        [download]
        Output: 
        $ perl 1187274.pl

v.1
1 19015 0 start: 1491486225.44169
1 19015 1 start: 1491486226.44244
1 19015 2 start: 1491486227.44318
1 19015 3 start: 1491486228.44402
1 19015 4 start: 1491486229.44495
1 19015 5 start: 1491486230.44586
1 19015 6 start: 1491486231.447
1 19015 7 start: 1491486232.44791
1 19015 8 start: 1491486233.44877
1 19015 9 start: 1491486234.4497
v.2
2 19026 0 start: 1491486235.45079
2 19027 1 start: 1491486235.45113
2 19028 2 start: 1491486235.45138
2 19029 3 start: 1491486235.4517
2 19030 4 start: 1491486237.45457
2 19031 5 start: 1491486237.45492
2 19032 6 start: 1491486237.45516
2 19033 7 start: 1491486237.45543
2 19035 9 start: 1491486239.45953
2 19034 8 start: 1491486239.45992

        [download]

        Hope this helps!


        The way forward always starts with a minimal test.
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom