DBIx::AutoReconnect - restart DBI calls after reconnecting on failure

DBIx-AutoReconnect documentation Contained in the DBIx-AutoReconnect distribution.

Index

Code Index:

NAME

Top

DBIx::AutoReconnect - restart DBI calls after reconnecting on failure

DESCRIPTION

Top

The module wraps DBI->connect call with DBIx::AutoReconnect->connect call so that any operation with DB connection handle that fails due to connection break ( server shutdown, tcp reset etc etc), is automatically reconnected.

The module is useful when a little more robustness is desired for a cheap price; the proper DB failure resistance should of course be inherent to the program logic.

SYNOPSIS

Top

     use DBIx::AutoReconnect;

     my $dbh = DBIx::AutoReconnect-> connect(
           "dbi:Pg:dbname=template1",
	   "postgres",
	   "password",
	   {
	   	PrintError => 0,
		ReconnectTimeout => 5,
		ReconnectFailure => sub { warn "oops!" },
	   },
     );

USAGE

Top

DBIx::AutoReconnect contains a single method get_handle that returns underlying DBI handle, returned from DBI->connect().

The module-specific knobs that can be directly assigned to the object handle, are described below

ReconnectFailure &SUB

Called when DBI->connect call fails.

ReconnectTimeout $SECONDS

Seconds to sleep after reconnection attempt fails.

Default: 60

ReconnectMaxTries $INTEGER

Max number of tries before giving up. The connections are tried indefinitely if undef.

Default: 5

NOTES

Top

Transactions are not restarted if connection breaks, moreover, begin_work, rollback, and commit die when called, to protect from unintentional use. To use transactions, operate with the original DBI handle returned by get_handle. AutoCommit is allowed though.

RaiseError is mostly useless with this module, because the DBI errors that may raise the exception, are all wrapped in eval by the connection detector code. The only place where it is useful, is when ReconnectMaxTries tries are exhausted, and depending on RaiseError, the code dies or returns undef from the <connect> call.

SEE ALSO

Top

DBI, DBIx::Abstract.

COPYRIGHT

Top

Copyright (c) 2005 catpipe Systems ApS. All rights reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

AUTHOR

Top

Dmitry Karasik <dk@catpipe.net>

DBIx-AutoReconnect documentation Contained in the DBIx-AutoReconnect distribution. 
# $Id: AutoReconnect.pm,v 1.3 2005/07/08 08:30:09 dk Exp $

package DBIx::AutoReconnect;

use DBI;
use strict;
use vars qw(%instances %defaults $VERSION);

$VERSION = '0.01';

%defaults = (
	ReconnectTimeout  => 60,
	ReconnectMaxTries => 5,
	ReconnectFailure  => undef,
);

sub connect
{
	my ( $class, $dsn, $user, $pass, $opt, @extras) = @_;

	$opt = {} unless $opt;
	my $profile = {
		conninfo   => [ $dsn, $user, $pass, $opt, @extras ],
		dbh	   => undef,
		do_connect => 1,
	};

	# XXX DBI doesn't say its defaults out, so hack
	$opt->{PrintError} = 1 unless defined $opt->{PrintError};

	for ( keys %defaults) {
		if ( exists $opt->{$_}) {
			$profile->{$_} = $opt->{$_};
			delete $opt->{$_};
		} else {
			$profile->{$_} = $defaults{$_};
		};
	}

	my $self = {};
	tie %{$self}, 'DBIx::AutoReconnect::TieHash', $profile;

	bless $self, $class;
	$instances{"$self"} = $profile;
	
	return $self-> __dbh_connect ? $self : undef;
}

sub __dbh_connect
{
	my $self = $instances{"$_[0]"};

	return $self-> {dbh} unless $self->{do_connect};

	my $tries = 0;
	my $downtime = 0;
	RETRY: while ( 1) {
		{
			local $self->{conninfo}->[3]-> {RaiseError} = 0; 
			if ( $self-> {dbh} = DBI-> connect( @{$self->{conninfo}})) {
				warn "DBIx::AutoReconnect: successfully reconnected after $tries tries and $downtime sec downtime\n"
					if $tries > 0 and $self->{conninfo}->[3]-> {PrintError};
				last RETRY;
			}
		}
		$self-> {ReconnectFailure}->() if $self-> {ReconnectFailure};
		$tries++;
		if ( defined ($self-> {ReconnectMaxTries}) and $self-> {ReconnectMaxTries} <= $tries) {
			if ( $self->{conninfo}->[3]-> {RaiseError}) {
				die $DBI::errstr;
			} else {
				return undef;
			}
		}
		if ( $self-> {ReconnectTimeout} > 0) {
			warn "DBIx::AutoReconnect: sleeping for $self->{ReconnectTimeout} seconds\n"
				if $self-> {conninfo}->[3]->{PrintError};
			sleep $self-> {ReconnectTimeout};
			$downtime += $self-> {ReconnectTimeout};
		}
	}

	return $self-> {dbh};
}

sub begin_work { 
	die "DBI::begin_work() is not to be used together with DBIx::AutoReconnect" 
}
sub rollback { 
	die "DBI::rollback() is not to be used together with DBIx::AutoReconnect" 
}
sub commit { 
	die "DBI::commit() is not to be used together with DBIx::AutoReconnect" 
}

sub get_handle { $instances{"$_[0]"}->{dbh} }

sub disconnect
{	
	my $self = $instances{"$_[0]"};

	$self-> {dbh}-> disconnect;
	$self-> {do_connect} = 0;
	$self-> {dbh} = undef;
}

sub AUTOLOAD
{
	use vars qw($AUTOLOAD);

	my $method = $AUTOLOAD;
	$method =~ s/^.*:([^:]+)$/$1/;

	my $obj = shift;
	my $self = $instances{"$obj"};

	my ( $ret, @ret);

	my $wa = wantarray;

	while ( 1) {
		unless ( $self->{dbh}) {
			$self-> {conninfo}->[3]-> {RaiseError} ?
				croak( "DBIx::AutoReconnect: not connected" ) :
				return;
		}

		eval {
			local $self->{dbh}->{RaiseError} = 1;
			if ( $wa) {
				@ret = $self-> {dbh}-> $method(@_);
			} else {
				$ret = $self-> {dbh}-> $method(@_);
			}
		};
		last unless $@;

		if ( $self->{dbh}->ping) {
			die $@;
		} else {
			$obj-> __dbh_connect;
		}
	}

	return $wa ? @ret : $ret;
}

sub DESTROY
{
	my $self = $instances{"$_[0]"};
	$self-> {do_connect} = 0;

	delete $instances{"$_[0]"};
}


package DBIx::AutoReconnect::TieHash;

sub TIEHASH
{
	my ( $class, $profile) = @_;
	bless $profile, $class;
}

sub FETCH
{
	my ( $self, $key) = @_;
	if ( exists $DBIx::AutoReconnect::defaults{$key}) {
		return $self-> {$key};
	} else {
		return $self-> {dbh}->{$key};
	}
}

sub STORE
{
	my ( $self, $key, $val) = @_;
	if ( exists $DBIx::AutoReconnect::defaults{$key}) {
		$self-> {$key} = $val;
	} else {
		$self-> {conninfo}->[3]->{$key} = $val;
		$self-> {dbh}->{$key} = $val;
	}
}

1;

__DATA__