From: Ash Berlin Date: Sat, 17 Mar 2007 19:25:17 +0000 (+0000) Subject: fix server disconnect checking for select outside of transaction X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0b5dee17b40cc4029549209a6c84b14c3647a361;p=dbsrgits%2FDBIx-Class-Historic.git fix server disconnect checking for select outside of transaction --- diff --git a/Changes b/Changes index f1671d7..2571ace 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ Revision history for DBIx::Class + - select et al weren't properly detecing when the server connection + had timed out when not in a transaction + 0.07999_02 2007-01-25 20:11:00 - add support for binding BYTEA and similar parameters (w/Pg impl) - add support to Ordered for multiple ordering columns diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 61fef77..941b6a4 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -842,47 +842,55 @@ sub _execute { map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind; $self->debugobj->query_start($sql, @debug_bind); } - my $sth = eval { $self->sth($sql,$op) }; - if (!$sth || $@) { - $self->throw_exception( - 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql" - ); - } + my ($rv, $sth); + RETRY: while (1) { + $sth = eval { $self->sth($sql,$op) }; - my $rv; - if ($sth) { - my $time = time(); - $rv = eval { - my $placeholder_index = 1; + if (!$sth || $@) { + $self->throw_exception( + 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql" + ); + } - foreach my $bound (@bind) { + if ($sth) { + my $time = time(); + $rv = eval { + my $placeholder_index = 1; - my $attributes = {}; - my($column_name, @data) = @$bound; + foreach my $bound (@bind) { - if( $bind_attributes ) { - $attributes = $bind_attributes->{$column_name} - if defined $bind_attributes->{$column_name}; - } + my $attributes = {}; + my($column_name, @data) = @$bound; - foreach my $data (@data) - { - $data = ref $data ? ''.$data : $data; # stringify args + if( $bind_attributes ) { + $attributes = $bind_attributes->{$column_name} + if defined $bind_attributes->{$column_name}; + } - $sth->bind_param($placeholder_index, $data, $attributes); - $placeholder_index++; + foreach my $data (@data) + { + $data = ref $data ? ''.$data : $data; # stringify args + + $sth->bind_param($placeholder_index, $data, $attributes); + $placeholder_index++; + } } + $sth->execute(); + }; + + if ($@ || !$rv) { + $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr)) + if $self->connected; + $self->_populate_dbh; + } else { + last RETRY; } - $sth->execute(); - }; - - if ($@ || !$rv) { - $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr)); + } else { + $self->throw_exception("'$sql' did not generate a statement."); } - } else { - $self->throw_exception("'$sql' did not generate a statement."); - } + } # While(1) to retry if disconencted + if ($self->debug) { my @debug_bind = map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind; diff --git a/t/92storage.t b/t/92storage.t index 67a594f..5994e2a 100644 --- a/t/92storage.t +++ b/t/92storage.t @@ -4,12 +4,30 @@ use warnings; use Test::More; use lib qw(t/lib); use DBICTest; +use DBICTest::ExplodingStorage; -plan tests => 1; +plan tests => 3; my $schema = DBICTest->init_schema(); is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite', 'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' ); + +my $storage = $schema->storage; +$storage->ensure_connected; + +bless $storage, "DBICTest::ExplodingStorage"; +$schema->storage($storage); + +eval { + $schema->resultset('Artist')->create({ name => "Exploding Sheep" }) +}; + +is($@, "", "Exploding \$sth->execute was caught"); + +is(1, $schema->resultset('Artist')->search({name => "Exploding Sheep" })->count, + "And the STH was retired"); + + 1; diff --git a/t/lib/DBICTest/ExplodingStorage.pm b/t/lib/DBICTest/ExplodingStorage.pm new file mode 100644 index 0000000..e5dd455 --- /dev/null +++ b/t/lib/DBICTest/ExplodingStorage.pm @@ -0,0 +1,28 @@ +package DBICTest::ExplodingStorage::Sth; + +sub execute { + die "Kablammo!"; +} + +sub bind_param {} + +package DBICTest::ExplodingStorage; + +use strict; +use warnings; + +use base 'DBIx::Class::Storage::DBI::SQLite'; + +my $count = 0; +sub sth { + my ($self, $sql) = @_; + return bless {}, "DBICTest::ExplodingStorage::Sth" unless $count++; + return $self->next::method($sql); +} + +sub connected { + return 0 if $count == 1; + return shift->next::method(@_); +} + +1;