- Added Oracle/WhereJoins.pm for Oracle >= 8 to support
Oracle <= 9i, and provide Oracle with a better join method for
later versions. (I use the term better loosely.)
- - select et al weren't properly detecing when the server connection
- had timed out when not in a transaction
- The SQL::T parser class now respects a relationship attribute of
is_foreign_key_constrain to allow explicit control over wether or
not a foreign constraint is needed
map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind;
$self->debugobj->query_start($sql, @debug_bind);
}
+ my $sth = eval { $self->sth($sql,$op) };
- my ($rv, $sth);
- RETRY: while (1) {
- $sth = eval { $self->sth($sql,$op) };
+ if (!$sth || $@) {
+ $self->throw_exception(
+ 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
+ );
+ }
- if (!$sth || $@) {
- $self->throw_exception(
- 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
- );
- }
+ my $rv;
+ if ($sth) {
+ my $time = time();
+ $rv = eval {
+ my $placeholder_index = 1;
- if ($sth) {
- my $time = time();
- $rv = eval {
- my $placeholder_index = 1;
+ foreach my $bound (@bind) {
- foreach my $bound (@bind) {
+ my $attributes = {};
+ my($column_name, @data) = @$bound;
- my $attributes = {};
- my($column_name, @data) = @$bound;
-
- if( $bind_attributes ) {
- $attributes = $bind_attributes->{$column_name}
- if defined $bind_attributes->{$column_name};
- }
+ if( $bind_attributes ) {
+ $attributes = $bind_attributes->{$column_name}
+ if defined $bind_attributes->{$column_name};
+ }
- foreach my $data (@data)
- {
- $data = ref $data ? ''.$data : $data; # stringify args
+ foreach my $data (@data)
+ {
+ $data = ref $data ? ''.$data : $data; # stringify args
- $sth->bind_param($placeholder_index, $data, $attributes);
- $placeholder_index++;
- }
+ $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;
}
- } else {
- $self->throw_exception("'$sql' did not generate a statement.");
+ $sth->execute();
+ };
+
+ if ($@ || !$rv) {
+ $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
}
- } # While(1) to retry if disconencted
-
+ } else {
+ $self->throw_exception("'$sql' did not generate a statement.");
+ }
if ($self->debug) {
my @debug_bind =
map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind;
use Test::More;
use lib qw(t/lib);
use DBICTest;
-use DBICTest::ExplodingStorage;
-plan tests => 3;
+plan tests => 1;
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;
+++ /dev/null
-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;