Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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/ 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:

  1. You have a $dbh.
  2. fork
  3. Parent goes about its business.
  4. Child creates a new $child_dbh with $dbh->clone().
  5. Child sets $dbh->{InactiveDestroy} = 1. This tells DBI that the parent's connection should not be closed when $dbh is destroyed.
  6. Child destroys parent's $dbh (don't use it on accident!)
  7. Child goes about its business (using $child_dbh as it likes).

Earlier nodes that touch on this subject:

In reply to DBI, fork, and clone. by kyle

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (2)
As of 2024-06-17 21:08 GMT
Find Nodes?
    Voting Booth?

    No recent polls found

    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.