http://qs1969.pair.com?node_id=1081215

djerius has asked for the wisdom of the Perl Monks concerning the following question:

I'm writing data to an SQLite db from multiple child processes managed by Parallel::ProcManager. Unfortunately several odd things are happening.
  1. I'm getting error messages indicating that the database is corrupt; yet it seems not to be.
  2. Even though I've got RaiseError on and PrintError off, the error messages are still output and I can't catch them via an eval. I have to resort to checking execute()'s return value.
Test code is at the end of this post. The order and frequencies of errors are not deterministic, but here are those that are output to the standard error stream: The database is locked errors are expected, as the database is being hammered with 30 processes which do nothing but attempt to update it.

I've run this code on both Linux and Mac OS X boxes with the same errors (I seem to get many more errors on the OS X box).

I've applied (correctly I hope) the advice from the DBI documentation regarding the AutoInactiveDestroy flag.

I've read out on the 'net that the malformed or not a database errors may be because of busy timeouts. That doesn't seem to be the case here, as I've set a busy timeout of 5 seconds, and the vast majority of these errors appear before 5 seconds in the child process have elapsed. My questions are:

  1. Am I missing something in setting up the database connection so that it works correctly across forks?
  2. Is there an SQLite parameter I need to set to get database locking to work? My impression from the DBD::SQLite documentation is that it does this automatically.
  3. Why doesn't RaiseError work? This is the first time I've seen this happen (I usually work with PostgreSQL and Sybase; not much experience with SQLite)
Any help is appreciated.

UPDATE 1:

Directly after posting (of course), I noticed that I hadn't supplied the correct number of parameters to DBI->connect; I'd left out the username and password parameters. After fixing that my problems with catching exeptions is fixed. I've amended the code below to include that fix.

Here's the test code: 

#!/usr/bin/env perl

use strict;
use warnings;

use DBI;
use Parallel::ForkManager;
use Time::HiRes qw[ gettimeofday ];

use Getopt::Long;

my %opt;
GetOptions(
    \%opt,
    qw[
      nproc|p=i
      db=s
      njobs|j=i
      timeout=f
      ] ) or die;

$opt{nproc}   =   30 unless defined $opt{nproc};
$opt{njobs}   = 1000 unless defined $opt{njobs};
$opt{timeout} =    5 unless defined $opt{timeout};

die( "must specify --db\n" )
  unless defined $opt{db};

unlink( $opt{db} );
my $dbh = DBI->connect(
    "dbi:SQLite:dbname=$opt{db}", '', '',
    {
        PrintError          => 0,
        AutoCommit          => 1,
        AutoInactiveDestroy => 1,
        RaiseError          => 1,
    } ) or die( "unable to create db\n" );

$dbh->sqlite_busy_timeout( $opt{timeout} * 1000 );

$dbh->do( "create table test ( a int, b int )" );

my $pm = Parallel::ForkManager->new( $opt{nproc} );

for my $idx ( 1 .. $opt{njobs} ) {

    $pm->start and next;

    my $time_of_day = gettimeofday;

    update_results( $dbh, $idx % 5, $$, $time_of_day );

    $pm->finish;

}

$pm->wait_all_children;

sub update_results {

    my ( $dbh, $a, $b, $time_of_day ) = @_;

    my $sth_update = $dbh->prepare(
        q[
          update test
             set b = ?
           where a = ?
         ]
    );

    my $sth_insert = $dbh->prepare(
        q[
           insert into test
                  (  a, b )
           values ( ?, ?)
         ]
    );

    eval {
        my $rv = $sth_update->execute( $b, $a );

        die( "error in attempt to update: @{[ $dbh->errstr ]}\n" )
          if !defined $rv;

        if ( 0 == $rv ) {

            $rv = $sth_insert->execute( $a, $b );

            die( "error in attempt to insert: @{[ $dbh->errstr ]}\n" )
              if !defined $rv;

            die( "$$: error updating status for a = $a\n" )
              unless $rv;
        }
    };
    my $err = $@;

    if ( $err ) {

        my $elapsed_time = gettimeofday() - $time_of_day;

        # complain if not a busy timeout error message

        if ( $elapsed_time > $opt{timeout} && $err !~ /database is loc
+ked/ ) {

            die "ERROR: time overrun: \[$$] elapsed time: $elapsed_tim
+e: $@"
              if $@;

        }

        die "ERROR: \[$$] elapsed time: $elapsed_time: $@" if $@;

    }


}

[download]

Back to Seekers of Perl Wisdom