DBIx::HA - High Availability package for DBI

 use DBIx::HA;

 $connect_attributes = {
         syb_flush_finish => 1,
         AutoCommit => 1,
         ChopBlanks => 1,
         PrintError => 0,
         RaiseError => 0,
         RootClass  => 'DBIx::HA'
         };

 $DATABASE::conf{'test'} = {
    max_retries => 2,
    db_stack => [
        [ 'dbi:Sybase:server=prod1;database=test', 'user1', 'password1', $connect_attributes ],
        [ 'dbi:Sybase:server=prod2;database=test', 'user2', 'password2', $connect_attributes ],
        [ 'dbi:Sybase:server=prod3;database=test', 'user3', 'password3', $connect_attributes ],
        ],
    connectoninit   => 0,
    pingtimeout     => -1,
    failoverlevel   => 'application',
    connecttimeout  => 1,
    executetimeout  => 8,
    callback_function => \&MyCallbackFunction,
	failtest_function   => \&DBIx::HA::FTF_SybaseASE,
    };

 DBIx::HA->initialize();
 $dbh = DBIx::HA->connect('test');

 $sth = $dbh->prepare($statement);
 $rv = $sth->execute;

# High Availability package for DBI
#
# Copyright (c) 2003-2006 Henri Asseily <henri@asseily.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

{
package DBIx::HA;

use 5.006000;

use constant DBIx_HA_DEBUG => $ENV{DBIX_HA_DEBUG} || 0;
use Data::Dumper;
use DBI 1.49 ();
use Sys::SigAction qw( set_sig_handler );
use Exporter ();
use strict;
use vars qw ( @ISA $prefix );
@ISA = qw ( DBI );

our $loaded_Apache = 0;
our $loaded_Apache_DBI = 0;
our $logdir;

BEGIN {
	$DBIx::HA::VERSION = 1.10;

	# Sample Fail Test Functions for different Database Servers
	# They are used in the configuration 
	# Input is ($ErrorID, $ErrorString)
	# Output is boolean: If true, then we'll consider the error a critical condition, ok to failover
	# If false, then DBIx::HA will not act on it and pass it straight through to the client
	sub FTF_SybaseASE { $_[0] > 10 ? 0 : 1 }; # Fail Test Function for Sybase ASE
}

our $prefix = "[$$] DBIx::HA:           "; 

sub initialize {
	if ($Apache::VERSION) {
		$loaded_Apache = 1;
	}
	if ($Apache::DBI::VERSION) {
		$loaded_Apache_DBI = 1;
	}
	if ($loaded_Apache_DBI) {
		$Apache::DBI::DEBUG = DBIx_HA_DEBUG;	# If we're debugging here, we should also debug Apache::DBI
	}
	if (DBIx_HA_DEBUG > 1) {
		warn "$prefix in initialize:\n";
		warn Dumper %DATABASE::conf;
	}
	my $dbname;
	foreach $dbname (keys %DATABASE::conf) {
		# set default failover to process (i.e. each process is independent from others
		# choices are : process, application
		if (! $DATABASE::conf{$dbname}->{'failoverlevel'}) {
			$DATABASE::conf{$dbname}->{'failoverlevel'} = 'process';
		}
		# add default timeouts for connection and execution
		if (! $DATABASE::conf{$dbname}->{'connecttimeout'}) {
			$DATABASE::conf{$dbname}->{'connecttimeout'} = 30;
		}
		if (! $DATABASE::conf{$dbname}->{'executetimeout'}) {
			$DATABASE::conf{$dbname}->{'executetimeout'} = 30;
		}
		# add default failover rule based on DBI error
		# default is to not request failover, whatever the error
		# do not ever set the default to always request failover, as any SQL error would trigger failover!
		if (! $DATABASE::conf{$dbname}->{'failtest_function'}) {
			$DATABASE::conf{$dbname}->{'failtest_function'} = sub { 0 };
		}
		$DATABASE::conf{$dbname}->{'end_of_stack'} = 0;	# error condition reaching end of stack
		for my $conn_aref (@{$DATABASE::conf{$dbname}->{'db_stack'}}) {
            my $dsn = $conn_aref->[0];
			# create an easy reverse-lookup table for finding the db server name from the dsn
			$DBIx::HA::finddbserver{$dsn}  = $dbname;
			# add timeout when within Apache::DBI
			# default to no ping (-1)
			if ($loaded_Apache_DBI) {
				if ($Apache::DBI::VERSION < 0.89) {
					die "$prefix Requirement unmet. Apache::DBI must be at version 0.89 or above";
				}
				# create a cached lookup table for finding the Apache::DBI cache key index from the dsn
				$DBIx::HA::ApacheDBIidx{$dsn}  = _getApacheDBIidx(@$conn_aref);
				Apache::DBI->setPingTimeOut($dsn, $DATABASE::conf{$dbname}->{'pingtimeout'} || -1);
			}
		};
		# set the active database to be the first in the stack
		_writesharedfile($dbname, 0) unless ($DATABASE::conf{$dbname}->{'active_db'});

		# hook up the child initialization routine
		if(Apache->can('push_handlers') && ($Apache::ServerStarting == 1)) {
			Apache->push_handlers(PerlChildInitHandler => \&_init_child);
		}
		# do not force a connection here
		# as we may be in the parent process. Connect in _init_child instead.
	};
}

sub _init_child {
	# Set up debugging PID for children
	$DBIx::HA::prefix = "[$$] DBIx::HA:           "; 
	$DBIx::HA::st::prefix = "[$$] DBIx::HA:st:        "; 
	$DBIx::HA::db::prefix = "[$$] DBIx::HA:db:        "; 
	if (DBIx_HA_DEBUG > 1) {
		warn "$prefix in init_child:\n";
	}
	my $dbname;
	foreach $dbname (keys %DATABASE::conf) {
		# under application failover, maybe we already have an active db.
		# set the active database to be the first in the stack unless we got it earlier.
		_readsharedfile($dbname);
		_writesharedfile($dbname, 0) unless ($DATABASE::conf{$dbname}->{'active_db'});

		# allow for connect on initialization
		if ($DATABASE::conf{$dbname}->{'connectoninit'} && $loaded_Apache_DBI) {
			warn "$prefix Connecting to $dbname on init_child\n" if (DBIx_HA_DEBUG);
			DBIx::HA->connect($dbname);
		}
	};
}


sub _readsharedfile {
	# reads from file-based shared memory to get active database under Apache
	my $dbname = shift;
	if ($DATABASE::conf{$dbname}->{'failoverlevel'} eq 'application') {
		# do this only if we're doing application failover and not process failover
		if ($loaded_Apache && (-f "$logdir/DBIxHA_activedb_$dbname")) {
			open IN, "$logdir/DBIxHA_activedb_$dbname";
			my $dbidx = <IN>;
			chomp $dbidx;
			close IN;
			if ($dbidx == -1) {	# we're told that we're at the end of the stack. No db server is available.
				$DATABASE::conf{$dbname}->{'end_of_stack'} = 1;
				return 0;
			}
			$DATABASE::conf{$dbname}->{'end_of_stack'} = 0;
			if (($dbidx =~ /^\d+$/o) && $DATABASE::conf{$dbname}->{'db_stack'}->[$dbidx]) {
				$DATABASE::conf{$dbname}->{'active_db'} = $DATABASE::conf{$dbname}->{'db_stack'}->[$dbidx];
				$DBIx::HA::activeserver{$dbname}  = $dbidx;
				unless ($Apache::ServerStarting == 1) {
					my $r = Apache->request;
					$r->notes("activedb_$dbname", $dbidx) if (ref $r);
				}
			} else {
				warn "$prefix in _readsharedfile: $dbname shared file has erroneous content, overwriting.\n";
				_writesharedfile($dbname, $DBIx::HA::activeserver{$dbname});
				return 0;
			}
		}
	}
	return 1;
}

sub _writesharedfile {
	my $dbname = shift;
	my $dbidx = shift;
	# updates the active handle
	# and writes to file-based shared memory for active database under Apache
	warn "$prefix in _writesharedfile: activating index $dbidx for database $dbname\n" if (DBIx_HA_DEBUG);
	$DATABASE::conf{$dbname}->{'active_db'} = $DATABASE::conf{$dbname}->{'db_stack'}->[$dbidx];
	$DBIx::HA::activeserver{$dbname}  = $dbidx;

	if ($DATABASE::conf{$dbname}->{'failoverlevel'} eq 'application') {
	# do this only if we're doing application failover and not process failover
		if ($loaded_Apache) {
			unless ($Apache::ServerStarting == 1) {
				my $r = Apache->request;
				$r->notes("activedb_$dbname", $dbidx) if (ref $r);
			}
			$logdir = Apache::server_root_relative(undef,'logs');
			open IN, ">/$logdir/DBIxHA_activedb_$dbname" || return 0;
			print IN $DBIx::HA::activeserver{$dbname};
			close IN;
			if ($Apache::ServerStarting == 1) {
				chmod 0666, "$logdir/DBIxHA_activedb_$dbname";
			}
		}
	}
	return 1;
}

sub _getdbname {
	# returns the db server name when given the dsn string
	my $dsn = shift;
	warn "$prefix in _getdbname: $DBIx::HA::finddbserver{$dsn} \n" if (DBIx_HA_DEBUG > 2);
	return $DBIx::HA::finddbserver{$dsn};
}

sub _isactivedb {
	# returns true if the db server in use is the one that should be active
	my $dsn = shift;
	my $dbname = _getdbname ($dsn);
	_readsharedfile($dbname);
	if ($DATABASE::conf{$dbname}->{'end_of_stack'}) {
		# we're not in the active db, because there is no active database, the end of stack is reached.
		return 0;
	}
	if ($dsn eq $DATABASE::conf{$dbname}->{'active_db'}->[0]) {
		warn "$prefix in _isactivedb: ".$dsn." is the active one \n" if (DBIx_HA_DEBUG > 2);
		return 1;
	}
	warn "$prefix in _isactivedb: ".$dsn." is NOT active \n" if (DBIx_HA_DEBUG > 2);
	$DATABASE::retries{$DATABASE::conf{$dbname}->{'active_db'}->[0]} = 0;	# reset the active db's retries for this process
	return 0;
}

sub _getnextdb {
	# returns the proper db server arrayref to use if the current one is dead
	my $dsn = shift;
	my $dbname = _getdbname ($dsn);
	if (_isactivedb ($dsn)) {
		# do this only if we are the first to look for a good db server
		# otherwise just return the active db server
		my $foundmatch = 0;
		my $idxnextdb = 0;
		my $stackcount = scalar(@{$DATABASE::conf{$dbname}->{'db_stack'}});
		foreach (@{$DATABASE::conf{$dbname}->{'db_stack'}}) {
			$idxnextdb++;
			if ($dsn eq $_->[0]) {
				# we got to the current db server in the stack
				# next db server in the stack is the correct one
				$foundmatch = 1;
				last;
			}
		}
		if (! $foundmatch) {	# didn't find a match, current dsn is invalid
			warn "$prefix in _getnextdb: current dsn is invalid for $dbname: $dsn \n" if (DBIx_HA_DEBUG);
			$idxnextdb = 0;
		} elsif ($idxnextdb > ($stackcount - 1)) {
			warn "$prefix in _getnextdb: Reached end of db server stack for $dbname. Staying there.\n" if (DBIx_HA_DEBUG);
			$DATABASE::conf{$dbname}->{'end_of_stack'} = 1;
			_writesharedfile($dbname, -1);
			return undef;
		}
		_writesharedfile($dbname, $idxnextdb);
		warn "$prefix in _getnextdb: activated ".$DATABASE::conf{$dbname}->{'active_db'}->[0]." \n" if (DBIx_HA_DEBUG);
	} elsif ($DATABASE::conf{$dbname}->{'end_of_stack'}) {
		return undef;
	} else {
		warn "$prefix in _getnextdb: found different active db server, switching to ".$DATABASE::conf{$dbname}->{'active_db'}->[0]."\n" if (DBIx_HA_DEBUG);
	}
	return $DATABASE::conf{$dbname}->{'active_db'}->[0];
}

sub _getApacheDBIidx {
	# generates the ApacheDBI cache idx key from the passed dsn info
	if (! $loaded_Apache_DBI) {
		# Apache::DBI isn't loaded, exit.
		return undef;
	}
	# first generate the same $idx key entry as ApacheDBI does
	my @args   = map { defined $_ ? $_ : "" } @_;
	if ($args[0] =~ /^dbi:/i) { $args[0] =~ s/^dbi:[^:]+://io; };	# remove the dbi:driver: piece
	my $idx = join $;, $args[0], $args[1], $args[2];

	if (3 == $#args and ref $args[3] eq "HASH") {
		map { $idx .= "$;$_=$args[3]->{$_}" } sort keys %{$args[3]};
	}
	warn "$prefix in getApacheDBIidx: generated idx: $idx , from dsn $args[0]\n" if (DBIx_HA_DEBUG > 1);
	return $idx;
}

sub _reconnect {
	my $currdsn = shift;
	my $dbh = shift || undef;
	my $olddsn = $currdsn;	# old dsn to delete from Apache::DBI
	my $conn_str;
	my $selrow;
	my $dbname = _getdbname ($currdsn);
	my $newdbh;
	my $i;

	if (! _isactivedb ($currdsn)) {	# wrong database server, use the active one
		$currdsn = _getnextdb ($currdsn);
	}
	if (! $currdsn) {
		warn "$prefix in _reconnect: No data source available, end of stack is reached. dbh is undefined. \n";
		eval { $dbh->disconnect if ((defined $dbh) && (ref $dbh)); undef $dbh; };
		return ($currdsn, undef);	# bad dbh and dsn
	}

	FINDDB: {
	my $dbstackindex = 0;	# pointer to position in the stack
	foreach $selrow (@{$DATABASE::conf{$dbname}->{'db_stack'}}) {	# loop through the stack
		if ($currdsn eq $selrow->[0]) {	# found the proper db server in the stack
			if ($loaded_Apache_DBI) { # delete the cached ApacheDBI entry
				my $ApacheDBIConnections = Apache::DBI::all_handlers();
				delete $$ApacheDBIConnections{$DBIx::HA::ApacheDBIidx{$olddsn}} if ($DBIx::HA::ApacheDBIidx{$olddsn});
				warn "$prefix in _reconnect: deleted cached ApacheDBI entry ".$DBIx::HA::ApacheDBIidx{$olddsn}."\n" if (DBIx_HA_DEBUG);
			}
			warn "$prefix in _reconnect: retrying ".$selrow->[0]."\n" if (DBIx_HA_DEBUG);
			$i=0;
			$DATABASE::retries{$currdsn} = 0 if (! $DATABASE::retries{$currdsn});
			for ($i=$DATABASE::retries{$currdsn}; $i < $DATABASE::conf{$dbname}->{'max_retries'}; $i++) {	# retry max_retries
				$DATABASE::retries{$currdsn}++;
				# now we're going to create a new good database handle and swap it with the old bad one
				$newdbh = _connect_with_timeout (@$selrow);
				if (defined $newdbh) {
					# we managed to create a new database handle
					if ((defined $dbh) && (ref $dbh)) {
						# the old one still exists, so we're going to swap it and then destroy it
						warn "$prefix in _reconnect: Pointing dbh to newdbh\n" if (DBIx_HA_DEBUG);
						$dbh->swap_inner_handle($newdbh);
						# wipe the old database handle (which in turn finishes all its children sth's)
						# If we're using DBD::Sybase, make sure syb_flush_finish is off so we don't get remaining results
                                                $newdbh->{syb_flush_finish} = 0 if $newdbh->{syb_flush_finish}
                                                    and $newdbh->{Driver}{Name} ne 'Gofer';
						eval { undef $newdbh; };
					} else {
						# there was no previous active database handle, so that's easy
						$dbh = $newdbh;
					}
					warn "$prefix Successfully reconnected to $currdsn\n";
					$DATABASE::retries{$currdsn} = 0; # reset the retries counter
					_writesharedfile($dbname, $dbstackindex);
					# Do callback if it exists
					if ( ref $DATABASE::conf{$dbname}->{'callback_function'}) {
						&{$DATABASE::conf{$dbname}->{'callback_function'}}($dbh, $dbname);
					}
					return ($currdsn, $dbh); 
				} #if
				warn "$prefix in _reconnect: failed ".($i+1)." times to connect to $currdsn\n" if (DBIx_HA_DEBUG > 1);
				select undef, undef, undef, 0.2; # wait a fraction of a second
			} #for
			# we found our db server in the stack, but couldn't connect to it
			# Get another one, and try again, assuming we've not exhausted the stack!
			$olddsn = $currdsn;			# remember the old one to delete it from Apache::DBI
			$currdsn = _getnextdb ($currdsn);	# go to next dsn
			if (! $currdsn) {			# we reached the end of the stack!
				warn "$prefix *** ERROR: Exhausted DBI failover stack. Last DSN is: $olddsn \n";
				return ($olddsn, undef);
			}
			warn "$prefix in _reconnect: dbstackindex: $dbstackindex; Trying another db server: $currdsn \n";
			goto FINDDB;
		} #if
		$dbstackindex++;
	} #foreach
	} # FINDDB
	warn "$prefix in _reconnect: Couldn't find a good data source, dbh is undefined. Pointing to $currdsn\n";
	return ($currdsn, undef);	# bad dbh! (multiple tries failed)
}

sub connect {
	warn "$prefix Apache::DBI handlers are: \n" if (DBIx_HA_DEBUG > 1);
	warn Dumper Apache::DBI::all_handlers() if (DBIx_HA_DEBUG > 1 && $loaded_Apache_DBI);
	my $class = shift;
	my $dbname = shift;
	my $conf = $DATABASE::conf{$dbname}
            or Carp::croak("No entry for '$dbname' in %DATABASE::conf");
	my $active_db = $conf->{'active_db'}
            or Carp::croak("No active_db for '$dbname' (did you call initialize?)");
	my ($dsn, $username, $auth, $attrs) = @$active_db;

	# Update the active db. If it's been updated, switch to it
	if (! _isactivedb($dsn)) {
		($dsn, $username, $auth, $attrs) = @{$DATABASE::conf{$dbname}->{'active_db'}};
		warn "$prefix in connect: switching to active db $dsn" if (DBIx_HA_DEBUG);
	}

	# now we've got the right data source. Go ahead.
	$DATABASE::retries{$dsn} = 0;	# initialize # of retries for the dsn
	my $dbh = _connect_with_timeout($dsn, $username, $auth, $attrs);
	if (defined $dbh) {
		warn "$prefix in connect: first try worked for $dsn\n" if (DBIx_HA_DEBUG);
	} else {
		warn "$prefix in connect: retrying connect of $dsn\n" if (DBIx_HA_DEBUG);
		($dsn, $dbh) = _reconnect ($dsn, $dbh);
	}
	return $dbh;
}

sub _connect_with_timeout {
	my ($dsn, $username, $auth, $attrs) = @_;
	warn "$prefix in _connect_with_timeout: dsn: $dsn \n" if (DBIx_HA_DEBUG > 1);
	my $res;
	my $dbh;
	my $timeout = 0;
	eval {
		no strict;
		my $h = set_sig_handler(
			'ALRM', 
			sub { $timeout = 1; die 'TIMEOUT'; },
			{ mask=>['ALRM'], safe=>1 }
		);
		alarm($DATABASE::conf{_getdbname($dsn)}->{'connecttimeout'});
		$dbh = DBI->connect($dsn, $username, $auth, $attrs);
		alarm(0);
	};
	alarm(0);
	if ($@ or $timeout) {	# there's a problem above
		if ($timeout) {	# it's a timeout
			warn "$prefix *** CONNECT TIMED OUT in $dsn";
			eval { $dbh->disconnect };
			$dbh = undef;
		} else {	# problem in the connection
			warn "$prefix Error in DBI::connect: $@\n" if $@;
		}
	}
        $dbh->{private_dbixha_dsn} = $dsn if $dbh;
	return $dbh;
}
} # end package DBIx::HA

{
package DBIx::HA::db;
use strict;
use constant DBIx_HA_DEBUG => DBIx::HA::DBIx_HA_DEBUG;
use vars qw ( @ISA );
@ISA = qw(DBI::db DBIx::HA);
our $prefix = "[$$] DBIx::HA:db:        "; 

# note that the DBI::db methods do not fail if the database connection is dead
sub prepare {
	my $dbh = shift;
	my $sql = shift;
	my $sth;
	my $dsn = $dbh->{private_dbixha_dsn} || die "panic: no private_dbixha_dsn";
	warn "$prefix in prepare: dsn: $dsn ; sql: $sql \n" if (DBIx_HA_DEBUG > 1);
	if (DBIx::HA::_isactivedb ($dsn)) {
		warn join "\n", "$prefix Statement handle being prepared while existing statement handle still open!",
                        "\tdbh:\t\t$dsn",
                        "\tprevious statement:\t".$dbh->{Statement},
                        "\tcurrent statement:\t$sql",
                        "\tACTIVE KIDS: ".$dbh->{ActiveKids}."\n"
                    if $dbh->{ActiveKids};
	} else {
		my $dbname = DBIx::HA::_getdbname($dsn);
		($dsn, $dbh) = DBIx::HA::_reconnect ($dsn, $dbh);
		if (! defined $dbh) { # we couldn't connect at all
			warn "$prefix in prepare: couldn't prepare sql: $sql\n";
			return undef;
		}
	}
	$sth = $dbh->SUPER::prepare($sql,@_);
	return $sth;
}
	
} # end package DBIx::HA::db

{
package DBIx::HA::st;
use strict;
use constant DBIx_HA_DEBUG => DBIx::HA::DBIx_HA_DEBUG;
use Sys::SigAction qw( set_sig_handler );
use vars qw ( @ISA $prefix );
@ISA = qw(DBI::st DBIx::HA);
our $prefix = "[$$] DBIx::HA:st:        "; 

sub execute {
	my $sth = shift;
	my $dbh = $sth->{Database};
	my $sql = $dbh->{Statement};
	my $dsn = $dbh->{private_dbixha_dsn} || die "panic: no private_dbixha_dsn";
	my $dbname = DBIx::HA::_getdbname($dsn);
	my $res;
	my $to;	# did we trip a timeout on the execution?
	my $orig_error_code;
	my $orig_error_string;
	my $max_executions = $DATABASE::conf{$dbname}->{'max_retries'} * scalar(@{$DATABASE::conf{$dbname}->{'db_stack'}});

	warn "=================\n" if (DBIx_HA_DEBUG > 1);
	warn "$prefix in execute: dsn: $dsn ; sql: $sql \n" if (DBIx_HA_DEBUG > 1);
	if (DBIx::HA::_isactivedb ($dsn)) {
		($res, $to) = &_execute_with_timeout ($dsn, $sth);
		$orig_error_code = $DBI::err;
		$orig_error_string = $DBI::errstr;
		if ($to || ((! defined $res) && &{$DATABASE::conf{$dbname}->{'failtest_function'}}($orig_error_code, $orig_error_string))) {
			# It was a timeout error or a critical network library error (connection in a bad state)
			warn "$prefix in execute: timeout error or network lib error, reexecuting: $sql ; dsn: $dsn \n" if (DBIx_HA_DEBUG);
			for (my $count_execs = 0; $count_execs < $max_executions; $count_execs++) {
				($dsn, $sth, $res) = _reexecute ($dsn, $sql, $sth);
				last if (defined $res); # reexecution worked (or failed hard with -666)
			} 
		} elsif (! defined $res) {
			# We got an error code from the server upon statement execution.
			# We will let the client decide what to do and let it be.
			warn "$prefix *** ERROR: $orig_error_code; $orig_error_string \n" if (DBIx_HA_DEBUG);
			warn "$prefix in execute: bad sql: $sql ; dsn: $dsn \n" if (DBIx_HA_DEBUG);
		}
	} else { # current db is not active
		for (my $count_execs = 0; $count_execs < $max_executions; $count_execs++) {
			($dsn, $sth, $res) = _reexecute ($dsn, $sql, $sth);
			last if (defined $res); # reexecution worked (or failed hard with -666)
		}
	}
	if (! defined $res) { # Execution failed
		warn "$prefix in execute: result is undefined, statement execution failed! statement: $sql ; dsn: $dsn \n" if (DBIx_HA_DEBUG);
		warn "+++++++++++++++++\n" if (DBIx_HA_DEBUG > 1);
		return undef;
	}
	if ($res == -666) { # the devil killed you! We couldn't connect to the db!
		warn "$prefix in execute: statement couldn't be executed because connect failed abnormally. statement: $sql ; dsn: $dsn \n";
		warn "+++++++++++++++++\n" if (DBIx_HA_DEBUG > 1);
		return undef;
	}
	warn "$prefix in execute: statement executed successfully! statement: $sql ; dsn: $dsn \n" if (DBIx_HA_DEBUG);
	warn "$prefix in execute: res: $res ; errstr: $DBI::errstr \n" if (DBIx_HA_DEBUG);
	$DATABASE::retries{$dsn} = 0;	# flush the retries to this dsn, since executing worked
	undef $@; # don't make an upstream eval die because of what happened here, since we're fine now
	warn "+++++++++++++++++\n" if (DBIx_HA_DEBUG > 1);
	return $res;
}

sub _execute_with_timeout {
	my $dsn = shift;
	my $sth = shift;
	my $sql = $sth->{Statement};
	warn "$prefix in _execute_with_timeout: dsn: $dsn ; sql : $sql \n" if (DBIx_HA_DEBUG > 1);
	my $res;
	my $timeout = 0;
	eval {
		my $h = set_sig_handler(
			'ALRM',
			sub { $timeout = 1; die 'TIMEOUT'; },
			{ mask=>['ALRM'],
			safe=>1 }
		);
		alarm($DATABASE::conf{DBIx::HA::_getdbname($dsn)}->{'executetimeout'});
		$res = $sth->SUPER::execute;
		alarm(0);
	};
	alarm(0);
	if ($@ or $timeout) {	# there's a problem above
		if ($timeout) {	# it's a timeout
			warn "$prefix *** EXECUTION TIMED OUT in $dsn ; SQL: $sql";
		} else {	# problem in the execution
			warn "$prefix Error in DBI::execute: $@\n" if $@;
		}
		eval { $sth->finish; };
		$sth = undef;
		$res = undef;
	}
	return ($res, $timeout);
}

sub _reexecute {
	# reexecute the statement in the following way:
	# reconnect with a new dbh
	# redo prepare and execute until it works
	my $dsn = shift;
	my $sql = shift;
	my $sth = shift || undef;
	my $dbh = undef;
	my $newsth;
	my $res;
	my $to;

	warn "$prefix in _reexecute: dsn: $dsn \n" if (DBIx_HA_DEBUG > 1);
	warn "$prefix Reexecuting statement: $sql" if (DBIx_HA_DEBUG > 1);
	if (defined $sth) {
		$dbh = $sth->{Database};
	}
	($dsn, $dbh) = DBIx::HA::_reconnect ($dsn, $dbh);
	if (! defined $dbh) { return ($dsn, $sth, -666); } # we couldn't connect at all
	$newsth = $dbh->prepare($sql);
	($res, $to) = &_execute_with_timeout ($dsn, $newsth);
	if (! $res) {	# execute_with_timeout failed
		warn "$prefix in _reexecute: reexecuting failed. dsn: $dsn  ; statement: $sql\n" if (DBIx_HA_DEBUG);
		eval { $sth->finish; };
		return ($dsn, $sth, undef);
	}
	if (defined $sth) {
		$sth->swap_inner_handle($newsth, 1);	# allow reparenting of the statement handle
		eval { $newsth->finish; };
		undef $newsth;
	} else {
		$sth = $newsth;
	}
	return ($dsn, $sth, $res);
}

} # end package DBIx::HA::st

1;

__END__