#!/usr/bin/perl
use strict;
use Parallel::ForkManager;
use IPC::ShareLite;
use Storable qw( freeze thaw );
my $fork_manager = new Parallel::ForkManager(5);
my $share = new IPC::ShareLite( -key => 1971,
-create => 'yes',
-destroy => 'yes' ) or die $!;
my $hash = {'PARENT' => $$};
$share->store( freeze( $hash ) );
foreach my $child ( 1 .. 10 ) {
my $pid = $fork_manager->start($child) and next;
$share->destroy( 0 );
my $hash = thaw( $share->fetch );
while (1) {
if ($share->lock()) {
last;
}
else {
print "$$ cant lock share\n";
sleep 1;
}
};
for my $id (1 .. 10) {
my $key = $child . '-' . $id;
$$hash{$key} = qq{|Kid $child pushed $id};
}
$share->store( freeze( $hash ) );
$share->unlock;
$fork_manager->finish($child);
}
print "Waiting for Children...\n";
$fork_manager->wait_all_children;
my %final_parent_hash = %{ thaw( $share->fetch ) };
foreach my $key ( sort{( (split /-/,$a)[0] <=> (split /-/,$b)[0] )
||
( (split /-/,$a)[1] <=> (split /-/,$b)[1] )
} keys %final_parent_hash ) {
print "$key = $final_parent_hash{$key}\n";
}
exit;
Waiting for Children... PARENT = 3661 1-1 = |Kid 1 pushed 1 1-2 = |Kid 1 pushed 2 1-3 = |Kid 1 pushed 3 1-4 = |Kid 1 pushed 4 1-5 = |Kid 1 pushed 5 1-6 = |Kid 1 pushed 6 1-7 = |Kid 1 pushed 7 1-8 = |Kid 1 pushed 8 1-9 = |Kid 1 pushed 9 1-10 = |Kid 1 pushed 10 3-1 = |Kid 3 pushed 1 3-2 = |Kid 3 pushed 2 3-3 = |Kid 3 pushed 3 3-4 = |Kid 3 pushed 4 3-5 = |Kid 3 pushed 5 3-6 = |Kid 3 pushed 6 3-7 = |Kid 3 pushed 7 3-8 = |Kid 3 pushed 8 3-9 = |Kid 3 pushed 9 3-10 = |Kid 3 pushed 10 5-1 = |Kid 5 pushed 1 5-2 = |Kid 5 pushed 2 5-3 = |Kid 5 pushed 3 5-4 = |Kid 5 pushed 4 5-5 = |Kid 5 pushed 5 5-6 = |Kid 5 pushed 6 5-7 = |Kid 5 pushed 7 5-8 = |Kid 5 pushed 8 5-9 = |Kid 5 pushed 9 5-10 = |Kid 5 pushed 10 6-1 = |Kid 6 pushed 1 6-2 = |Kid 6 pushed 2 6-3 = |Kid 6 pushed 3 6-4 = |Kid 6 pushed 4 6-5 = |Kid 6 pushed 5 6-6 = |Kid 6 pushed 6 6-7 = |Kid 6 pushed 7 6-8 = |Kid 6 pushed 8 6-9 = |Kid 6 pushed 9 6-10 = |Kid 6 pushed 10 8-1 = |Kid 8 pushed 1 8-2 = |Kid 8 pushed 2 8-3 = |Kid 8 pushed 3 8-4 = |Kid 8 pushed 4 8-5 = |Kid 8 pushed 5 8-6 = |Kid 8 pushed 6 8-7 = |Kid 8 pushed 7 8-8 = |Kid 8 pushed 8 8-9 = |Kid 8 pushed 9 8-10 = |Kid 8 pushed 10 10-1 = |Kid 10 pushed 1 10-2 = |Kid 10 pushed 2 10-3 = |Kid 10 pushed 3 10-4 = |Kid 10 pushed 4 10-5 = |Kid 10 pushed 5 10-6 = |Kid 10 pushed 6 10-7 = |Kid 10 pushed 7 10-8 = |Kid 10 pushed 8 10-9 = |Kid 10 pushed 9 10-10 = |Kid 10 pushed 10where is the output of the second child.
Waiting for Children... PARENT = 19736 1-1 = |Kid 1 pushed 1 1-2 = |Kid 1 pushed 2 1-3 = |Kid 1 pushed 3 1-4 = |Kid 1 pushed 4 1-5 = |Kid 1 pushed 5 1-6 = |Kid 1 pushed 6 1-7 = |Kid 1 pushed 7 1-8 = |Kid 1 pushed 8 1-9 = |Kid 1 pushed 9 1-10 = |Kid 1 pushed 10 2-1 = |Kid 2 pushed 1 2-2 = |Kid 2 pushed 2 2-3 = |Kid 2 pushed 3 2-4 = |Kid 2 pushed 4 2-5 = |Kid 2 pushed 5 2-6 = |Kid 2 pushed 6 2-7 = |Kid 2 pushed 7 2-8 = |Kid 2 pushed 8 2-9 = |Kid 2 pushed 9 2-10 = |Kid 2 pushed 10 3-1 = |Kid 3 pushed 1 3-2 = |Kid 3 pushed 2 3-3 = |Kid 3 pushed 3 3-4 = |Kid 3 pushed 4 3-5 = |Kid 3 pushed 5 3-6 = |Kid 3 pushed 6 3-7 = |Kid 3 pushed 7 3-8 = |Kid 3 pushed 8 3-9 = |Kid 3 pushed 9 3-10 = |Kid 3 pushed 10 4-1 = |Kid 4 pushed 1 4-2 = |Kid 4 pushed 2 4-3 = |Kid 4 pushed 3 4-4 = |Kid 4 pushed 4 4-5 = |Kid 4 pushed 5 4-6 = |Kid 4 pushed 6 4-7 = |Kid 4 pushed 7 4-8 = |Kid 4 pushed 8 4-9 = |Kid 4 pushed 9 4-10 = |Kid 4 pushed 10 5-1 = |Kid 5 pushed 1 5-2 = |Kid 5 pushed 2 5-3 = |Kid 5 pushed 3 5-4 = |Kid 5 pushed 4 5-5 = |Kid 5 pushed 5 5-6 = |Kid 5 pushed 6 5-7 = |Kid 5 pushed 7 5-8 = |Kid 5 pushed 8 5-9 = |Kid 5 pushed 9 5-10 = |Kid 5 pushed 10 6-1 = |Kid 6 pushed 1 6-2 = |Kid 6 pushed 2 6-3 = |Kid 6 pushed 3 6-4 = |Kid 6 pushed 4 6-5 = |Kid 6 pushed 5 6-6 = |Kid 6 pushed 6 6-7 = |Kid 6 pushed 7 6-8 = |Kid 6 pushed 8 6-9 = |Kid 6 pushed 9 6-10 = |Kid 6 pushed 10 7-1 = |Kid 7 pushed 1 7-2 = |Kid 7 pushed 2 7-3 = |Kid 7 pushed 3 7-4 = |Kid 7 pushed 4 7-5 = |Kid 7 pushed 5 7-6 = |Kid 7 pushed 6 7-7 = |Kid 7 pushed 7 7-8 = |Kid 7 pushed 8 7-9 = |Kid 7 pushed 9 7-10 = |Kid 7 pushed 10 8-1 = |Kid 8 pushed 1 8-2 = |Kid 8 pushed 2 8-3 = |Kid 8 pushed 3 8-4 = |Kid 8 pushed 4 8-5 = |Kid 8 pushed 5 8-6 = |Kid 8 pushed 6 8-7 = |Kid 8 pushed 7 8-8 = |Kid 8 pushed 8 8-9 = |Kid 8 pushed 9 8-10 = |Kid 8 pushed 10 9-1 = |Kid 9 pushed 1 9-2 = |Kid 9 pushed 2 9-3 = |Kid 9 pushed 3 9-4 = |Kid 9 pushed 4 9-5 = |Kid 9 pushed 5 9-6 = |Kid 9 pushed 6 9-7 = |Kid 9 pushed 7 9-8 = |Kid 9 pushed 8 9-9 = |Kid 9 pushed 9 9-10 = |Kid 9 pushed 10 10-1 = |Kid 10 pushed 1 10-2 = |Kid 10 pushed 2 10-3 = |Kid 10 pushed 3 10-4 = |Kid 10 pushed 4 10-5 = |Kid 10 pushed 5 10-6 = |Kid 10 pushed 6 10-7 = |Kid 10 pushed 7 10-8 = |Kid 10 pushed 8 10-9 = |Kid 10 pushed 9 10-10 = |Kid 10 pushed 10
#!/usr/bin/perl
use strict;
use Parallel::ForkManager;
use IPC::ShareLite;
use Storable qw( freeze thaw );
my $fork_manager = new Parallel::ForkManager(5);
my $share = new IPC::ShareLite( -key => $$,
-create => 'yes',
-destroy => 'yes' ) or die $!;
my $hash = {'PARENT' => $$};
$share->store( freeze( $hash ) );
foreach my $child ( 1 .. 10 ) {
my $pid = $fork_manager->start($child) and next;
$share->destroy( 0 );
my $hash = thaw( $share->fetch );
for my $id (1 .. 100) {
my $key = $child . '-' . $id;
$$hash{$key} = qq{|Kid $child pushed $id};
}
while (1) {
if ($share->lock()) {
last;
}
else {
print "$$ cant lock share\n";
sleep 1;
}
};
$share->store( freeze( $hash ) );
$share->unlock;
$fork_manager->finish($child);
}
print "Waiting for Children...\n";
$fork_manager->wait_all_children;
my %final_parent_hash = %{ thaw( $share->fetch ) };
#foreach my $key ( sort{( (split /-/,$a)[0] <=> (split /-/,$b)[0] )
# ||
# ( (split /-/,$a)[1] <=> (split /-/,$b)[1] )
# } keys %final_parent_hash ) {
# print "$key = $final_parent_hash{$key}\n";
#}
foreach my $child ( 1 .. 10 ) {
for my $id (1 .. 50) {
my $key = $child . '-' . $id;
if (! exists $final_parent_hash{$key} ) {
print "Missing data for Kid $child , data $id\n";
}
}
}
exit;
As an afterthought, when I first tested your original script, I tried to redirect the output to a text file with " script > textfile". I did lose some lines that way on repeated attempts, due to the script exiting before all output was printed. Maybe there is some sort of timing problem, between the ParallelForkManager, the IPC, and the main script. Have you tried putting delays in there, to let one part of the script catch-up with the other part? In my experience with other scripts, where one person sees an error, and another dosn't, it often involves timing differences related to the "speeds" of the different machines. I've even seem cases where scripts will fail when the machine is under high load, but run OK otherwise. Usually, slowing the scripts down, helps. Maybe the IPC through shared memory is "too fast" for the big modules to handle in perfect synchronization?
use strict;
use Parallel::ForkManager;
use IPC::ShareLite;
use Storable qw( freeze thaw );
my $fork_manager = new Parallel::ForkManager(5);
my $share = new IPC::ShareLite( -key => 1971,
-create => 'yes',
-destroy => 'yes' ) or die $!;
my $hash = {'PARENT' => $$};
$share->store( freeze( $hash ) );
foreach my $child ( 1 .. 10 ) {
my $pid = $fork_manager->start($child) and next;
$share->destroy( 0 );
my $hash = thaw( $share->fetch );
while (1) {
if ($share->lock()) {
last;
}
else {
print "$$ cant lock share\n";
sleep 1;
}
};
for my $id (1 .. 20) {
my $key = $child . '-' . $id;
$$hash{$key} = qq{|Kid $child pushed $id};
}
$share->store( freeze( $hash ) );
$share->unlock;
$fork_manager->finish($child);
}
print "Waiting for Children...\n";
$fork_manager->wait_all_children;
my %final_parent_hash;
my $sleep_ctr = 10;
while ($sleep_ctr) {
%final_parent_hash = %{ thaw( $share->fetch ) };
print scalar (keys %final_parent_hash) . "\n";
if ((keys %final_parent_hash) == 201) {
last;
}
sleep 1;
$sleep_ctr--;
}
foreach my $child ( 1 .. 10 ) {
for my $id (1 .. 20) {
my $key = $child . '-' . $id;
if (! exists $final_parent_hash{$key} ) {
print "Missing data for Kid $child , data $id\n";
}
else {
print "$key = $final_parent_hash{$key}\n";
}
}
}
Here is the modified code with wait using IPC::Shareable - works like a charm :)
use strict;
use Parallel::ForkManager;
use IPC::Shareable;
my $glue = $$;
my %options = (
create => 1,
exclusive => 0,
mode => 0644,
destroy => 1,
);
my %final_parent_hash;
my $parent_share = tie %final_parent_hash, 'IPC::Shareable', $glue, { %options } or die "parent : tie failed\n";
my $fork_manager = new Parallel::ForkManager(5);
foreach my $child ( 1 .. 10 ) {
my $pid = $fork_manager->start($child) and next;
my %options = (
create => 0,
exclusive => 0,
mode => 0644,
destroy => 0,
);
my %child_hash;
my $child_share = tie %child_hash, 'IPC::Shareable', $glue, { %options } or die "client: tie failed\n";
for my $id (1 .. 20) {
my $key = $child . '-' . $id;
$child_share->shlock;
$final_parent_hash{$key} = qq{|Kid $child pushed $id};
$child_share->shunlock;
}
$fork_manager->finish($child);
}
print "Waiting for Children...\n";
$fork_manager->wait_all_children;
my $sleep_ctr = 10;
while ($sleep_ctr) {
if ((keys %final_parent_hash) == 200) {
last;
}
sleep 1;
$sleep_ctr--;
}
foreach my $child ( 1 .. 10 ) {
for my $id (1 .. 20) {
my $key = $child . '-' . $id;
if (! exists $final_parent_hash{$key} ) {
print "Missing data for Kid $child , data $id\n";
}
else {
print "$key = $final_parent_hash{$key}\n";
}
}
}
IPC::Shareable->clean_up_all;
I think IPC::ShareLite is the culpritIt's important in your testing to do an "ipcs" before and after you run your script; and remove any segments you created. You can remove them with ipcrm.
The problem of "leftover" shared memory segments is probably one of the reasons people shy away from using shared memory. It certainly makes me leary of them.
perlmonks.org content © perlmonks.org and andThenThereWasPERL, zentara
prlmnks.org © 2006 edmund von der burg (eccles & toad)
v 0.03