#!/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]