view release on metacpan or  search on metacpan

Roles/AutoReconnect.pm  view on Meta::CPAN

			warn "DBIx::AutoReconnect: sleeping for $attr->{ReconnectTimeout} seconds\n"
				if $conninfo-> [3]->{PrintError};
			sleep $attr-> {ReconnectTimeout};
			$downtime += $attr-> {ReconnectTimeout};
		}
	}

	return $ret;
}

sub dbi_method
{
	my ( $self, $conninfo, $method, @parameters) = @_;

	return $self-> super( $method, @parameters) 
		if $method eq 'connect' or not $self->dbh->{AutoCommit};

	my ( $wantarray, @ret) = ( wantarray);
	my ( $super, $private) = $self-> get_super;
	return unless $super;

	my $tries = 0;
	while ( 1) {
		if ( 
			defined ($self->{attr}-> {ReconnectMaxTries}) and 
			$self->{attr}-> {ReconnectMaxTries} <= $tries
		) {
			if ( $conninfo-> [3]-> {RaiseError}) {
				die "DBIx::Roles::AutoReconnect: Tried to call '$method' $self->{attr}->{ReconnectMaxTries} time(s), giving up\n";
			} else {
				warn "DBIx::Roles::AutoReconnect: Tried to call '$method' $self->{attr}->{ReconnectMaxTries} time(s), giving up\n" if
					not exists ($conninfo->[3]->{PrintError}) # DBI defaults
					or $conninfo->[3]->{PrintError};
				return;
			}
		}
		$tries++;

		unless ( $self-> dbh) {
			$conninfo-> [3]-> {RaiseError} ?
				croak( "DBIx::Roles::AutoReconnect: not connected" ) :
				return;
		}
		# repeatedly call the roles below until they succeed
		{
			local $self-> object-> {RaiseError} = 1;
			my $context = $self-> context;
			eval {
				if ( $wantarray) {
					@ret = $super-> ($self, $private, $method, @parameters);
				} else {
					$ret[0] = $super-> ($self, $private, $method, @parameters);
				}
			};
			return wantarray ? @ret : $ret[0]
				unless $@;
			# restore context if calls are restarted	
			$self-> context( $context);	
		}
		if ( $self-> dbh-> ping) {
			# DB is alive, most probably that was not a DBI-related error 
			if ( $conninfo-> [3]-> {RaiseError}) {
				die $@;
			} else {
				warn $@ if 
					not (exists $conninfo->[3]->{PrintError}) # DBI defaults
					or $conninfo->[3]->{PrintError};
				return;
			}
		} else {
			# without disconnect 
			$self-> dbh( $self-> connect( @$conninfo));
		}
	}
}

sub STORE
{
	my ( $self, $conninfo, $key, $val) = @_;
	if ( $key eq 'ReconnectTimeout' or $key eq 'ReconnectMaxTries') {
		die "Fatal: '$key' must be a positive integer"
			unless $val =~ /^\d+$/;
	} elsif ( $key eq 'ReconnectFailure') {
		die "Fatal: '$key' must be either 'undef' or a CODE reference"
			if not defined($val) or not ref($val) or ref($val) ne 'CODE';
	} elsif ( not exists $self->{defaults}->{$key}) {
		# update $attr for eventual reconnects
		$conninfo->[3]->{$key} = $val;
	}

	
	return $self-> super( $key, $val);
}

1;

__DATA__

=pod

=head1 NAME

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

=head1 DESCRIPTION

The role wraps all calls to DBI methods 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 role 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.

=head1 SYNOPSIS

     use DBIx::Roles qw(AutoReconnect);

     my $dbh = DBI-> connect(
           "dbi:Pg:dbname=template1",
	   "postgres",
	   "password",