view release on metacpan or  search on metacpan

lib/DBIx/TryAgain.pm  view on Meta::CPAN

=head1 SYNOPSIS

 my $dbh = DBIx::TryAgain->connect(...) or die $DBI::errstr;

OR

 my $dbh = DBI->connect(... dbi params.. { RootClass => "DBIx::TryAgain" } ) or die $DBI::errstr;

 $dbh->try_again_algorithm('fibonacci');
 $dbh->try_again_max_retries(5);
 $dbh->try_again_on_messages([ qr/database is locked/i ]);
 $dbh->try_again_on_prepare(1);

=head1 DESCRIPTION

This is a subclass of DBI which simply tries to execute a query
again whenever the error string matches a given set of patterns.

By default the only pattern is qr[database is locked], which is
what is returned by SQLite when the database is locked.

There is a delay between retries.  Setting try_again_algorithm
to 'constant', 'linear', 'fibonacci', or 'exponential' causes
the corresponding algorithm to be used.  The first five
values for these algorithsm are :

    constant    : 1,1,1,1,1
    linear      : 1,2,3,4,5
    fibonacci   : 1,1,2,3,5
    exponential : 1,2,4,8,16

lib/DBIx/TryAgain/db.pm  view on Meta::CPAN

package DBIx::TryAgain::db;
use strict;
use warnings;

our @ISA = 'DBI::db';

our %defaults = (
    private_dbix_try_again_algorithm => 'fibonacci', # or exponential or linear or constant
    private_dbix_try_again_max_retries => 5,
    private_dbix_try_again_on_messages => [ qr/database is locked/i ],
);

sub try_again_algorithm {
    my $self = shift;
    my $attr = 'private_dbix_try_again_algorithm';
    return $self->{$attr} || $defaults{$attr} unless @_;
    $self->{$attr} = shift;
}

sub try_again_max_retries {

t/lock.t  view on Meta::CPAN

unlink $dbfile;

my $dbh = DBIx::TryAgain->connect("dbi:SQLite:dbname=$dbfile","","", { PrintError => 0 } )
    or die "connect error ".$DBI::errstr;

is $dbh->try_again_max_retries, 5, "got default max retries";
$dbh->try_again_max_retries(3);
is $dbh->try_again_max_retries, 3, "set max retries to 3";

is $dbh->try_again_algorithm, 'fibonacci', "got default algorithm";
is_deeply $dbh->try_again_on_messages, [ qr/database is locked/i ], 'got default try_again_on_messages';

$dbh->do("create table foo (a int);");

my $locker = DBIx::TryAgain->connect("dbi:SQLite:dbname=$dbfile","","", { PrintError => 0 } );
ok $locker, "connected" or diag $DBI::errstr;

ok $locker->do("PRAGMA locking_mode = EXCLUSIVE"), 'lock' or diag $locker->errstr;
ok $locker->do("BEGIN EXCLUSIVE"), 'begin transaction' or diag $locker->errstr;
ok $locker->do("COMMIT"), 'commit' or diag $locker->errstr;

$dbh->sqlite_busy_timeout(1);

# Now ready to try again :
ok !$dbh->do("insert into foo (a) values (10)"), "do failed";
like ($DBI::errstr, qr/locked/i, "got locked message");

# Some versions fail when preparing, some versions
# fail when executing.
my $sth = $dbh->prepare("select * from foo");

if ($sth) {
    ok $sth, "Prepare succeeded.";
    ok !$sth->execute, "Execute failed";
    like ($sth->errstr, qr/locked/i, "got locked message");

    is $sth->{private_dbix_try_again_tries}, 3, "Tried 3 times";
    is_deeply $sth->{private_dbix_try_again_slept}, [1,1,2], "slept with fibonacci delay";

} else {
    diag "Prepare failed, not retrying prepare in this test.";
}

unlink $dbfile;
done_testing();