view release on metacpan or  search on metacpan

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

Default to 5.

=item *

TxnRetries - How many times the wrapper would try to restart transaction if it was
failed because of database connection problems. Default to 4.

=back

=cut

sub connect {
    my ($this, $dsn, $user, $pass, $attrs) = @_;

    my $self_attrs = $this->get_self_attrs($attrs);
    $attrs->{RaiseError} = 1;
    my $self = $this->SUPER::connect($dsn, $user, $pass, $attrs);
    my $driver = $self->{Driver}{Name};
    DBIx::RetryOverDisconnects::Exception->new("Sorry, driver '$driver' is not yet supported\n")->throw
        unless DBIx::RetryOverDisconnects::db->can('is_disconnect_'.lc($driver));
    $self_attrs->{AutoCommit} = $self->{AutoCommit};
    $self->{PRIV()} = $self_attrs;

    return $self;
}

sub get_self_attrs {
    my ($this, $attrs) = @_;
    return {
        retries     => exists $attrs->{ReconnectRetries} ? (delete $attrs->{ReconnectRetries}) : 5,
        interval    => (delete $attrs->{ReconnectInterval}) || 1,
        timeout     => (delete $attrs->{ReconnectTimeout}) || 5,
        txn_retries => (delete $attrs->{TxnRetries}) || 4,
    };
}


package DBIx::RetryOverDisconnects::db;
use base 'DBI::db';
use strict;

use constant PRIV => DBIx::RetryOverDisconnects::PRIV();

sub clone {
    my $self = shift;
    local $^W = 0;
    my $data =  $self->{PRIV()};
    $data->{is_cloning} = 1;
    my $new_self = $self->SUPER::clone(@_) or return;
    delete $data->{is_cloning};
    $new_self->{PRIV()} = {%$data};
    return $new_self;
}

=head1 Database handle object methods

=head2 set_callback

    $dbh->set_callback(afterReconnect => $code_ref);

Set callbacks for some events. Currently only afterReconnect is supported.
It is called after every successful reconnect to database.

=cut

sub set_callback {
    my ($self, %callbacks) = @_;
    my $old = $self->{PRIV()}->{callback} || {};
    $self->{PRIV()}->{callback} = {%$old, %callbacks};
    return;
}

sub exc_conn_trans {
    my $self = shift;
    my $msg = 'Connection to database lost while in transaction';
    $DBIx::RetryOverDisconnects::errstr = $msg;
    $DBIx::RetryOverDisconnects::err    = 3;
    DBIx::RetryOverDisconnects::Exception->new($msg);
}

sub exc_conn_trans_fatal {
    my $self = shift;
    my $msg = 'Connection to database lost while in transaction (retries exceeded)';
    $DBIx::RetryOverDisconnects::errstr = $msg;
    $DBIx::RetryOverDisconnects::err    = 4;
    DBIx::RetryOverDisconnects::Exception->new($msg);
}

=head2 is_fatal_trans_disconnect

Returns 'true' if last failed operation was txn_do and TxnRetries limit
was reached.

=cut

sub is_fatal_trans_disconnect {$DBIx::RetryOverDisconnects::err == 4}

=head2 is_trans_disconnect

Return 'true' if last failed operation was a transaction and it could be restarted.
The database handle was successfuly reconnected again.

=cut

sub is_trans_disconnect       {$DBIx::RetryOverDisconnects::err == 3}

=head2 is_fatal_disconnect

Return 'true' if reconnect retries limit has been reached. In this case the
database handle is not connected.

=cut

sub is_fatal_disconnect       {$DBIx::RetryOverDisconnects::err == 2}

=head2 is_sql_error

Return 'true' if query failed because of some other reason, not related to
database connection problems. See $DBI::errstr for details.

=cut

sub is_sql_error              {$DBIx::RetryOverDisconnects::err == 1}

sub exc_conn_fatal {
    my $self = shift;
    my $msg = 'Connection to database lost (retries exceeded)';
    $DBIx::RetryOverDisconnects::errstr = $msg;
    $DBIx::RetryOverDisconnects::err    = 2;