Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:
# hash with the status of the childern
# at startup -> started
# when child dies -> return code
my %h;
$| = 1;
# Trap sig send from child to parent
# when child dies -> then change the status to return value
$SIG{CHLD}= sub {$pid = wait();$h{$pid} = $?;};
# start forking 4 childern
for (my $i=1; $i < 5; $i++) {
print "I'll fork a new child\n";
if( !defined($child_pid = fork() ) ) {
die "Can't fork : $!";
} elsif ($child_pid) {
# child started -> set status
$h{$child_pid} = 'started';
} else {
child_action(3*$i, $i%2);
}
}
# the parent sleeps 1 sec and then print the
# status for all childeren
while (1) {
foreach $key (sort keys %h) {
print "$key->$h{$key} ";
}
print "\n";
sleep 2;
}
# The child just sleep a few sec
# prints to stdout when it stops
sub child_action {
my ($sleeptime,$retcode) = @_;
sleep 1; # always start sleeping 1 sec to allow initialisation
print "I'm the child $$ and will sleep for $sleeptime s and return $retcode\n";
sleep($sleeptime);
print "I'm the child $$ : $retcode, I'm awake\n";
exit $retcode;
}
# output :
#
#$ perl -w test5.pl
#I'll fork a new child
#I'll fork a new child
#I'll fork a new child
#I'll fork a new child
#15259->started 15260->started 15261->started 15262->started
#I'm the child 15260 and will sleep for 6 s and return 0
#I'm the child 15259 and will sleep for 3 s and return 1
#I'm the child 15261 and will sleep for 9 s and return 1
#I'm the child 15262 and will sleep for 12 s and return 0
#15259->started 15260->started 15261->started 15262->started
#I'm the child 15259 : 1, I'm awake
#15259->256 15260->started 15261->started 15262->started
#15259->256 15260->started 15261->started 15262->started
#I'm the child 15260 : 0, I'm awake
#15259->256 15260->0 15261->started 15262->started
#15259->256 15260->0 15261->started 15262->started
#I'm the child 15261 : 1, I'm awake
#15259->256 15260->0 15261->256 15262->started
#15259->256 15260->0 15261->256 15262->started
#I'm the child 15262 : 0, I'm awake
#15259->256 15260->0 15261->256 15262->0
#15259->256 15260->0 15261->256 15262->0
#15259->256 15260->0 15261->256 15262->0
#15259->256 15260->0 15261->256 15262->0
#^C
This code doesn't work (with db-connection)
use DBI;
# hash with the status of the childern
# at startup -> started
# when child dies -> return code
my %h;
$| = 1;
# Trap sig send from child to parent
# when child dies -> then change the status to return value
$SIG{CHLD}= sub {$pid = wait();$h{$pid} = $?;};
# Open connection : this is when it goes wrong
my $dbh = DBI->connect("dbi:Oracle:", "/", "",
{PrintError=>1, RaiseError=>0, ora_session_mode=>2});
# Try without this line, with this line at 1 and at 0, but it doesn't work;
#$dbh->{InactiveDestroy} = 0;
# start forking 4 childern
for (my $i=1; $i < 5; $i++) {
print "I'll fork a new child\n";
if( !defined($child_pid = fork() ) ) {
die "Can't fork : $!";
} elsif ($child_pid) {
# child started -> set status
$h{$child_pid} = 'started';
} else {
child_action(3*$i, $i%2);
}
}
# the parent sleeps 1 sec and then print the
# status for all childeren
while (1) {
foreach $key (sort keys %h) {
print "$key->$h{$key} ";
}
print "\n";
sleep 2;
}
# The child just sleep a few sec
# prints to stdout when it stops
sub child_action {
my ($sleeptime,$retcode) = @_;
sleep 1; # always start sleeping 1 sec to allow initialisation
print "I'm the child $$ and will sleep for $sleeptime s and return $retcode\n";
sleep($sleeptime);
print "I'm the child $$ : $retcode, I'm awake\n";
exit $retcode;
}
# output :
#
#$ perl -w test6.pl
#I'll fork a new child
#I'll fork a new child
#I'll fork a new child
#I'll fork a new child
#15362->started 15363->started 15364->started 15365->started
#I'm the child 15362 and will sleep for 3 s and return 1
#I'm the child 15363 and will sleep for 6 s and return 0
#I'm the child 15364 and will sleep for 9 s and return 1
#I'm the child 15365 and will sleep for 12 s and return 0
#15362->started 15363->started 15364->started 15365->started
#I'm the child 15362 : 1, I'm awake
#15362->started 15363->started 15364->started 15365->started
#15362->started 15363->started 15364->started 15365->started
#I'm the child 15363 : 0, I'm awake
#15362->started 15363->started 15364->started 15365->started
#I'm the child 15364 : 1, I'm awake
#15362->started 15363->started 15364->started 15365->started
#15362->started 15363->started 15364->started 15365->started
#I'm the child 15365 : 0, I'm awake
#15362->started 15363->started 15364->started 15365->started
#15362->started 15363->started 15364->started 15365->started
#15362->started 15363->started 15364->started 15365->started
#15362->started 15363->started 15364->started 15365->started
#^C15362->started 15363->started 15364->started 15365->started
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Is DBI trapping CHLD sigs, is there a workaround?
by htoug (Deacon) on Aug 25, 2001 at 17:36 UTC | |
by Anonymous Monk on Aug 26, 2001 at 00:15 UTC |