File Coverage

blib/lib/DBIx/AutoReconnect.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

# $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__