@@ -1,5 +1,18 @@
Revision history for Perl extension DBIx::RetryOverDisconnects.
+0.12 08.02.2013
+ - https://rt.cpan.org/Ticket/Display.html?id=83205 (txn_do doesn't rollback after last retry)
+
+0.11 05.02.2013
+ - [rt.cpan.org #83138] take_measures - SUPER::ping throws an exception, Laurent Dami
+ - [rt.cpan.org #83139] infinite ping() loop under connect_cached, Laurent Dami
+
+0.10 05.02.2013
+ - [rt.cpan.org #83140] no localization of @_, 10x Laurent Dami
+
+0.09 31.01.2013
+ - Add more error messages support for PostgreSQL and PGBouncer
+
0.08 20.10.2012
- Update Module::Install version
diff --git a/var/tmp/source/SYBER/DBIx-RetryOverDisconnects-0.08/DBIx-RetryOverDisconnects-0.08/DBIx-RetryOverDisconnects-0.07.tar.gz b/var/tmp/source/SYBER/DBIx-RetryOverDisconnects-0.08/DBIx-RetryOverDisconnects-0.08/DBIx-RetryOverDisconnects-0.07.tar.gz
deleted file mode 100644
index b9710ea9..00000000
Binary files a/var/tmp/source/SYBER/DBIx-RetryOverDisconnects-0.08/DBIx-RetryOverDisconnects-0.08/DBIx-RetryOverDisconnects-0.07.tar.gz and /dev/null differ
@@ -1,5 +1,4 @@
Changes
-DBIx-RetryOverDisconnects-0.07.tar.gz
inc/Module/AutoInstall.pm
inc/Module/Install.pm
inc/Module/Install/AutoInstall.pm
@@ -24,4 +24,4 @@ requires:
perl: 5.6.0
resources:
license: http://dev.perl.org/licenses/
-version: 0.08
+version: 0.12
@@ -3,7 +3,7 @@ use base 'DBI';
use strict;
use 5.006;
-our $VERSION = '0.08';
+our $VERSION = '0.12';
our ($errstr, $err);
use Exception::Class qw(DBIx::RetryOverDisconnects::Exception);
DBIx::RetryOverDisconnects::Exception->Trace(1);
@@ -189,8 +189,11 @@ 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;
- $new_self->{PRIV()} = { %{ $self->{PRIV()} } };
+ delete $data->{is_cloning};
+ $new_self->{PRIV()} = {%$data};
return $new_self;
}
@@ -305,6 +308,7 @@ foreach my $func (qw/
while(1) {
$data->{Intercept} = 1;
+ local $@;
my $ok = eval {
defined $wa ? $wa ? (@retval = $self->$super_method(@_)) :
($retval = $self->$super_method(@_)) :
@@ -333,6 +337,7 @@ ping and if it is false then it reconnects.
sub ping {
my $self = shift;
return 1 if $self->SUPER::ping;
+ return if $self->{PRIV()}{is_cloning};
my $in_trans = !$self->{AutoCommit};
$self->reconnect;
$self->exc_conn_trans->throw if $in_trans;
@@ -342,7 +347,8 @@ sub ping {
sub take_measures {
my ($self, $e, $sth, $autocommit) = @_;
$self->exc_flush;
- $self->SUPER::ping and $self->exc_std($e)->rethrow;
+ local $@;
+ $self->exc_std($e)->rethrow if eval { $self->SUPER::ping };
my $is_disconnect_method = 'is_disconnect_'.lc($self->{Driver}->{Name});
if ($self->$is_disconnect_method($e)) {
@@ -367,7 +373,11 @@ sub is_disconnect_pg {
my $self = shift;
local $_ = shift;
return 1 if /server\s+closed\s+the\s+connection\s+unexpectedly/i or
- /terminating connection/;
+ /terminating connection/ or
+ /no\s+more\s+connections\s+allowed/ or # pgbouncer
+ /no\s+working\s+server\s+connection/ or # pgbouncer 1.4.2
+ /_timeout/ or # pgbouncer
+ /pgbouncer\s+cannot\s+connect\s+to\s+server/; # pgbouncer 1.5+
return;
}
*is_disconnect_pgpp = *is_disconnect_pg;
@@ -403,6 +413,7 @@ sub reconnect {
alarm(0);
die($alarm = 1);
};
+ local $@;
eval {
alarm($data->{timeout});
eval {
@@ -469,8 +480,10 @@ sub txn_do {
return $coderef->(@_) unless $self->{AutoCommit};
my $wa = wantarray;
- my (@result, $result, $i);
+ my (@result, $result);
+ my $i = 0;
while ('preved') {
+ local $@;
my $ok = eval {
$self->begin_work;
defined $wa ? $wa ? (@result = $coderef->(@_)) :
@@ -481,7 +494,7 @@ sub txn_do {
};
last if $ok;
- $self->exc_conn_trans_fatal->throw if $self->{PRIV()}{txn_retries} <= ++$i;
+ $self->exc_conn_trans_fatal->throw if $self->{PRIV()}{txn_retries} <= $i++;
next if $self->is_trans_disconnect;
$@->rethrow if $self->is_fatal_disconnect;
my $txn_err = $@;
@@ -516,6 +529,7 @@ foreach my $func (qw/execute execute_array execute_for_fetch/) {
while(1) {
$data->{Intercept} = 1;
+ local $@;
my $ok = eval {
defined $wa ? $wa ? (@retval = $self->$super_method(@_)) :
($retval = $self->$super_method(@_)) :