Fw: [cpan #5135] fork disrupts the database connection 2.9002 and 2.9003

------=_NextPart_000_0181_01C3E988.FD2A7CB0
Content-Type: text/plain;
charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

Distribution names: DBD-MySQL-2.9002 and DBD-mysql-2.9003
Perl versions: 5.8.0 and 5.8.1
Operating systems:

Linux cartman.network1.net 2.4.22-1.2115.nptl #1 Wed Oct 29 15:20:17 EST =
2003 i586
i586 i386 GNU/Linux

FreeBSD skipper.network1.net 4.8-RC FreeBSD 4.8-RC #0: Wed Mar 5 =
16:45:13 EST 2003
root@skipper.network1.net:/usr/obj/usr/src/sys/FNGi i386

After an initial select, and then a fork, the database connection still =
exists, but
is unusable. That is as specific as I can be...

Here is some example code that does not work under the above mentioned =
dbd versions,
but does work on dbd-mysql-2.1026:

#!/usr/bin/perl


my $db_host=3D'localhost';
my $db=3D'fngimon';
my $db_user=3D'';
my $db_pass=3D'';

use strict;
use DBI;
use POSIX ":sys_wait_h";

my $dbh=3D&db_connect($db_host,$db,$db_user,$db_pass);

while (1) {

my $sqlquery=3D"select id from interfaces order by rand() limit =
0, 5";
my $obj=3D&db_query($dbh,$sqlquery);
my $ntuples=3D$obj->rows();
my $debug=3D1;

while (my $ref =3D $obj->fetchrow_hashref()) {


my $interfaces_id=3D$ref->{'id'};
print "interfaces_id:$interfaces_id " if =
($debug);

&safefork;
}

print
"----------------------------------------------------------- -------------=
-----------------------------------------
\n";
}


############################################################ ##
# This subroutine forks the recv() so the script doesnt hang!#
############################################################ ##
sub safefork {

my $pid_;
my $return;
my %SIG;

$SIG{CHLD} =3D \&REAPER;
# do something that forks...
FORK: {
if ($pid_ =3D fork) {

# parent here
# child process pid is available in $pid_
return ($pid_);

} elsif (defined $pid_) { # $pid_ is zero here if =
defined

# child here
# Child code goes here!
# parent process pid is available with getppid

exit;

} elsif ($! =3D~ /No more process/) {

# EAGAIN, supposedly recoverable fork error
#sleep 5;
#redo FORK;
# Just exit:
exit;

} else {

# weird fork error
print ("Can't fork: $!\n");
exit;

}

}
} # end safefork sub-routine
############################################################ ############
# This subroutine is REAPER that prevents Zombies with his shiny scythe#
# This is necessary on sysv due to the way it handles signals #
############################################################ ############
sub REAPER {
my $child;
my %Kid_Status;
my %SIG;

# If a second child dies while in the signal handler caused by =
the
# first death, we won't get another signal. So must loop here =
else
# we will leave the unreaped child as a zombie. And the next =
time
# two children die we get another zombie. And so on.
while (($child =3D waitpid(-1,WNOHANG)) > 0) {
$Kid_Status{$child} =3D $?;
}
$SIG{CHLD} =3D \&REAPER; # still loathe sysV
} # end REAPER sub-routine
sub db_connect {

my ($db_host,$db,$db_user,$db_pass) =3D @_;
my ($dbh);
my ($note_connect)=3D0;

while (!$dbh) {

$dbh =3D DBI->connect("DBI:mysql:$db:$db_host", =
"$db_user", "$db_pass",
{PrintError =3D> 0});

if (!$dbh) {
$note_connect=3D1;
sleep 2;
}
}

if ($note_connect==1) {
$note_connect=3D0;
}

return ($dbh);

}
sub db_query {
my ($dbh,$sqlquery) =3D @_;
my ($obj) =3D $dbh->prepare("$sqlquery");
if (!$obj) {
exit;
}
if (!$obj->execute) {
exit;
}

return ($obj);

} # end db_query sub-routine;



Thank you,

Darren
First Network Group
Vice President Product Development
1-800-578-6381 x182
http://www.network1.net

------=_NextPart_000_0181_01C3E988.FD2A7CB0--