Some time ago, I wanted to fork a script that had an open DBI connection and a running statement and let the child use the connection the parent had (or an identical connection). This turned out to have more pitfalls than I expected. Everything that is necessary to do this is documented, but I haven't seen one code sample that brings it all together, so I'm documenting here the method I used in the form of a Test::More script.
I'm using DBI 1.53, Perl 5.8.8, and PostgreSQL.
#!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; use DBI; my @connect_parameters = ( 'DBI:Pg:dbname=template1', 'user', 'pass', { ShowErrorStatement => 1, AutoCommit => 1, RaiseError => 1, PrintError => 0, } ); # An earlier version leaked socket connections # and would eventually fail (or cause "Too many # open files" errors elsewhere). I loop a while # here to detect that bug. foreach my $iteration ( 1 .. 2_000 ) { warn "iteration $iteration\n"; my $dbh = DBI->connect( @connect_parameters ); isa_ok( $dbh, 'DBI::db' ); my $one; ($one) = $dbh->selectrow_array( 'SELECT 1' ); is( $one, 1, 'can select 1' ); # this is fetched later my $sth = $dbh->prepare( 'SELECT 1' ); $sth->execute; ok( ! $dbh->{InactiveDestroy}, 'dbh InactiveDestroy is off before fork' ); my $pid = fork(); if ( ! defined $pid ) { die "Can't fork: $!\n"; } if ( $pid ) { # parent isa_ok( $dbh, 'DBI::db' ); ($one) = $dbh->selectrow_array( 'SELECT 1' ); is( $one, 1, 'parent can select 1 before child exits' ); is( wait(), $pid, 'waited for child' ); ($one) = $dbh->selectrow_array( 'SELECT 1' ); is( $one, 1, 'parent can select 1 after child exits' ); } else { # child my $child_dbh = $dbh->clone(); isa_ok( $dbh, 'DBI::db' ); isa_ok( $child_dbh, 'DBI::db' ); ok( ! $dbh->{InactiveDestroy}, 'dbh InactiveDestroy is off in child after fork' ); ok( ! $child_dbh->{InactiveDestroy}, 'child_dbh InactiveDestroy is off in child after fork' ); $dbh->{InactiveDestroy} = 1; ok( $dbh->{InactiveDestroy}, 'dbh InactiveDestroy is on in child after fork' ); ok( ! $child_dbh->{InactiveDestroy}, 'child_dbh InactiveDestroy is off in child after fork' ); undef $dbh; ok( ! $dbh, 'death to dbh in child' ); ($one) = $child_dbh->selectrow_array( 'SELECT 1' ); is( $one, 1, 'child can select 1' ); exit; } ($one) = $sth->fetchrow_array; is( $one, 1, 'select running before fork still works' ); }
The clone call produces one warning that doesn't seem to have any consequence:
Can't set DBI::db=HASH(0x8424abc)->{User}: unrecognised attribute name or invalid value at /usr/lib/perl5/DBI.pm line 675.
In production code, I handle this with a $SIG{__WARN__} handler like so:
# Save existing handler. my $saved_warn_handler = $SIG{__WARN__}; # Suppress warnings. $SIG{__WARN__} = sub {}; my $child_dbh = $dbh->clone(); # Restore saved handler. $SIG{__WARN__} = $saved_warn_handler;
In summary, the general procedure here is as follows:
Earlier nodes that touch on this subject:
In reply to DBI, fork, and clone. by kyle
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |