#!/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 locked/ ) { die "ERROR: time overrun: \[$$] elapsed time: $elapsed_time: $@" if $@; } die "ERROR: \[$$] elapsed time: $elapsed_time: $@" if $@; } }