DBI and multiple forks

[Jamin Roth]

I'm having some trouble getting DBI and multiple forks to function.  I have
goten it to work if I only spawn one child using static variables.  But
using arrays of children hasn't worked.  I got some code similar from:
http://gsu.linux.org.tr/oreilly/perl/cookbook/ch17_13.htm.  Here is my
current attempt:

#!/usr/bin/perl -w
# preforker - server who forks first
use IO::Socket;
use Symbol;
use POSIX;
    use DBI;
    use DBD::mysql;
    use DBD::mysql;

    $db         = 'pathtracker';
    $host       = '192.168.50.215';
    $port       = "3306";
    $user       = "******";
    $password   = "******";
    $dsn        = "DBI:mysql:database=$db;host=$host;port=$port";

    $dbh = DBI->connect($dsn,$user,$password);

@Funcs = ("SELECT COUNT(*) AS TripCount FROM Trips",
          "SELECT COUNT(*) AS SegmentCount FROM Trips_Segments",
          "SELECT COUNT(*) AS ZoneCount FROM Zones",
          "SELECT COUNT(*) AS StatCount FROM Stats");

# global variables
$PREFORK                = 5;        # number of children to maintain
%children               = ();       # keys are current child process IDs
$children               = 0;        # current number of children
$FuncCount              = 0;

sub REAPER {                        # takes care of dead children
    $SIG{CHLD} = \&REAPER;
    my $pid = wait;
    $children --;
    delete $children{$pid};
}

sub HUNTSMAN {                      # signal handler for SIGINT
    local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
    kill 'INT' => keys %children;
    exit;                           # clean up with dignity
}

# Fork off our children.
for (1 .. $PREFORK) {
    make_new_child();
}

# Install signal handlers.
$SIG{CHLD} = \&REAPER;
$SIG{INT}  = \&HUNTSMAN;

# And maintain the population.
while (1) {
    sleep;                          # wait for a signal (i.e., child's
death)
    print <KID>;
    if($FuncCount < scalar(@Funcs)-1) {
      for ($i = $children; $i < $PREFORK; $i++) {
          make_new_child();           # top up the child pool
      }
    }elsif($children==0) {
      print "Called all children!\n";
      exit(0);
    }
}

sub make_new_child {
    my $pid;
    my $sigset;

    $pid = open(KID, "-|");
    $|=1;
    if ($pid) {
        # Parent records the child's birth and returns.
        $children{$pid} = 1;
        $children++;
        $FuncCount++;
        return;
    } else {
        # Child can *not* return from this subroutine.
        $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before

        my $sth = $dbh->prepare($Funcs[$FuncCount]);
        $sth->execute();
        my $row = $sth->fetchrow_arrayref;
        print $$row[0];

        # tidy up gracefully and finish

        # this exit is VERY important, otherwise the child will become
        # a producer of more and more children, forking yourself into
        # process death.
        exit;
    }
}


$dbh->disconnect;

Here are the error messages I get:

Name "main::MAX_CLIENTS_PER_CHILD" used only once: possible typo at
./multifork3.pl line 34.
Use of uninitialized value at
/usr/local/lib/perl5/site_perl/5.005/i386-freebsd/DBD/mysql.pm line 200.
Use of uninitialized value at ./multifork3.pl line 104.
DBD::mysql::st execute failed: Query was empty at ./multifork3.pl line 104.
DBD::mysql::st fetchrow_arrayref failed: fetch() without execute() at
./multifork3.pl line 105.
Use of uninitialized value at ./multifork3.pl line 106.

Then sits there and waits for 0 children which should happen after the
queries are complete, but I have to ctl-C.

If I don't try to check to make sure that the children are done
--> }elsif($children==0) {
Then it exits correctly.

I also don't know if the child is returning the values back to the parent.
I thought the:
$pid = open(KID, "-|");
Would allow communication back to the parent.

If anyone has a perl script that will run parallel queries like I'm trying
to do please let me know.

Thank you,

Jamin Roth
Systems/Network Administrator
Sorensen Associates Inc
Phone: (503) 665-0123 ext 234
Fax: (503) 666-5113
http://www.sorensen-associates.com/