Revision history for DBIx::Class
+ - Fix exception propagation from with_deferred_fk_checks
+
0.08200 2012-08-24 (UTC)
* Fixes
- Change one of the new tests for the previous release to not require
use overload ();
use Data::Compare (); # no imports!!! guard against insane architecture
use DBI::Const::GetInfoType (); # no import of retarded global hash
+use Context::Preserve 'preserve_context';
use namespace::clean;
# default cursor class, overridable in connect_info attributes
__PACKAGE__->mk_group_accessors('inherited' => qw/
sql_limit_dialect sql_quote_char sql_name_sep
+ _unsatisfied_deferred_constraints_autorollback
/);
+# see with_deferred_fk_checks
+__PACKAGE__->_unsatisfied_deferred_constraints_autorollback(0);
+
__PACKAGE__->mk_group_accessors('component_class' => qw/sql_maker_class datetime_parser_type/);
__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker');
=cut
-# Storage subclasses should override this
+# In most cases the driver can just implement the methods
+# _set_constraints_deferred and _set_constraints_immediate for the appropriate
+# statements to make FKs deferred until COMMIT and make them immediately checked
+# again, respectively.
+
sub with_deferred_fk_checks {
my ($self, $sub) = @_;
- $sub->();
+
+ if ($self->can('_set_constraints_deferred') &&
+ $self->can('_set_constraints_immediate')) {
+
+ my $tried_to_reset_constraints = 0;
+
+ return try {
+ my $guard = $self->txn_scope_guard;
+ $self->_set_constraints_deferred;
+ preserve_context { $sub->() } after => sub {
+ my $e;
+ eval {
+ $guard->commit;
+ };
+ if ($@) {
+ if ($self->_unsatisfied_deferred_constraints_autorollback) {
+ $guard->{inactivated} = 1; # DO NOT ROLLBACK
+ $self->{transaction_depth}--;
+ }
+ $e = $@;
+ }
+ eval {
+ $tried_to_reset_constraints = 1;
+ $self->_set_constraints_immediate;
+ };
+ if ($@) {
+ if ($e) {
+ $e .= " also set constraints immediate failed: $@";
+ }
+ else {
+ $e = "set constraints immediate failed: $@";
+ }
+ }
+ $self->throw_exception($e) if $e;
+ };
+ }
+ catch {
+ my $e = $_;
+ if (not $tried_to_reset_constraints) {
+ eval {
+ $self->_set_constraints_immediate;
+ };
+ if ($@) {
+ $e .= " also setting constraints immediate failed: $@";
+ }
+ }
+ $self->throw_exception($e);
+ };
+ }
+ else {
+ carp_unique
+ 'Your Storage driver '.ref($self).' '.
+ 'has not implemented with_deferred_fk_checks, please '.
+ 'file an RT';
+
+ return $sub->();
+ }
}
=head2 connected
use strict;
use warnings;
-use base qw/DBIx::Class::Storage::DBI/;
+use base 'DBIx::Class::Storage::DBI';
use mro 'c3';
-use Context::Preserve 'preserve_context';
+use Try::Tiny;
use namespace::clean;
__PACKAGE__->sql_limit_dialect ('SkipFirst');
=cut
+__PACKAGE__->_unsatisfied_deferred_constraints_autorollback(1);
+
+sub _set_constraints_deferred {
+ $_[0]->_do_query('SET CONSTRAINTS ALL DEFERRED');
+}
+
+# Constraints are deferred only for the current transaction, new transactions
+# start with constraints IMMEDIATE by default. If we are already in a
+# transaction when with_deferred_fk_checks is fired, we want to switch
+# constraints back to IMMEDIATE mode at the end of the savepoint or "nested
+# transaction" so that they can be checked.
+
+sub _set_constraints_immediate {
+ $_[0]->_do_query('SET CONSTRAINTS ALL IMMEDIATE') if $_[0]->transaction_depth;
+}
+
+# A failed commit due to unsatisfied deferred FKs throws a "DBD driver has not
+# implemented the AutoCommit attribute" exception, masking the actual error. We
+# fix it up here by doing a manual $dbh->do("COMMIT WORK"), propagating the
+# exception, and resetting the $dbh->{AutoCommit} attribute.
+
+sub _exec_txn_commit {
+ my $self = shift;
+
+ my $tried_resetting_autocommit = 0;
+
+ try {
+ $self->_dbh->do('COMMIT WORK');
+ if ($self->_dbh_autocommit && $self->transaction_depth == 1) {
+ eval {
+ $tried_resetting_autocommit = 1;
+ $self->_dbh->{AutoCommit} = 1;
+ };
+ if ($@) {
+ $self->throw_exception('$dbh->{AutoCommit} = 1 failed: '.$@);
+ }
+ }
+ }
+ catch {
+ my $e = $_;
+ if ((not $tried_resetting_autocommit) &&
+ $self->_dbh_autocommit && $self->transaction_depth == 1) {
+ eval {
+ $self->_dbh->{AutoCommit} = 1
+ };
+ if ($@ && $@ !~ /DBD driver has not implemented the AutoCommit attribute/) {
+ $e .= ' also $dbh->{AutoCommit} = 1 failed: '.$@;
+ }
+ }
+ $self->throw_exception($e);
+ };
+}
+
sub _execute {
my $self = shift;
my ($op) = @_;
$self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
}
-sub with_deferred_fk_checks {
- my ($self, $sub) = @_;
-
- my $txn_scope_guard = $self->txn_scope_guard;
-
- $self->_do_query('SET CONSTRAINTS ALL DEFERRED');
-
- return preserve_context { $sub->() } after => sub {
- $txn_scope_guard->commit;
- $self->_do_query('SET CONSTRAINTS ALL IMMEDIATE')
- if $self->transaction_depth;
- };
-}
-
=head2 connect_call_datetime_setup
Used as:
You may distribute this code under the same terms as Perl itself.
=cut
+# vim:sts=2 sw=2:
return $self->sql_maker->_shorten_identifier($alias);
}
-=head2 with_deferred_fk_checks
+# Since these are session variables, they affect all subsequent transactions,
+# not just the current transaction like in Pg/Informix, this is why we have to
+# reset constraints to immediate regardless of transaction_depth.
-Runs a coderef between:
-
- alter session set constraints = deferred
- ...
- alter session set constraints = immediate
-
-to defer foreign key checks.
-
-Constraints must be declared C<DEFERRABLE> for this to work.
-
-=cut
-
-sub with_deferred_fk_checks {
- my ($self, $sub) = @_;
-
- my $txn_scope_guard = $self->txn_scope_guard;
-
- $self->_do_query('alter session set constraints = deferred');
+sub _set_constraints_deferred {
+ $_[0]->_do_query('alter session set constraints = deferred');
+}
- return
- preserve_context { $sub->() } after => sub {
- $txn_scope_guard->commit;
- $self->_do_query('alter session set constraints = immediate')
- if $self->transaction_depth;
- };
+sub _set_constraints_immediate {
+ $_[0]->_do_query('alter session set constraints = immediate')
}
=head1 ATTRIBUTES
use base qw/DBIx::Class::Storage::DBI/;
-use Context::Preserve 'preserve_context';
use DBIx::Class::Carp;
use Try::Tiny;
use namespace::clean;
;
}
-sub with_deferred_fk_checks {
- my ($self, $sub) = @_;
+__PACKAGE__->_unsatisfied_deferred_constraints_autorollback(1);
- my $txn_scope_guard = $self->txn_scope_guard;
+sub _set_constraints_deferred {
+ $_[0]->_do_query('SET CONSTRAINTS ALL DEFERRED');
+}
- $self->_do_query('SET CONSTRAINTS ALL DEFERRED');
+# Constraints are deferred only for the current transaction, new transactions
+# start with constraints IMMEDIATE by default. If we are already in a
+# transaction when with_deferred_fk_checks is fired, we want to switch
+# constraints back to IMMEDIATE mode at the end of the savepoint or "nested
+# transaction" so that they can be checked.
- return preserve_context { $sub->() } after => sub {
- $txn_scope_guard->commit;
- $self->_do_query('SET CONSTRAINTS ALL IMMEDIATE')
- if $self->transaction_depth;
- };
+sub _set_constraints_immediate {
+ $_[0]->_do_query('SET CONSTRAINTS ALL IMMEDIATE') if $_[0]->transaction_depth;
}
# only used when INSERT ... RETURNING is disabled
You may distribute this code under the same terms as Perl itself.
=cut
+# vim:sts=2 sw=2:
use base qw/DBIx::Class::Storage::DBI/;
+use Try::Tiny;
+use namespace::clean;
+
__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MySQL');
__PACKAGE__->sql_limit_dialect ('LimitXY');
__PACKAGE__->sql_quote_char ('`');
__PACKAGE__->_use_multicolumn_in (1);
+# We turn FOREIGN_KEY_CHECKS off, do a transaction, then turn them back on right
+# before the COMMIT so that they can be checked during the COMMIT.
+
sub with_deferred_fk_checks {
my ($self, $sub) = @_;
$self->_do_query('SET FOREIGN_KEY_CHECKS = 0');
- $sub->();
- $self->_do_query('SET FOREIGN_KEY_CHECKS = 1');
+
+ my $tried_fk_checks_reset = 0;
+
+ return try {
+ my $guard = $self->txn_scope_guard;
+ preserve_context { $sub->() } after => sub {
+ $tried_fk_checks_reset = 1;
+ $self->_do_query('SET FOREIGN_KEY_CHECKS = 1');
+ $guard->commit;
+ };
+ }
+ catch {
+ my $e = $_;
+ if (not $tried_fk_checks_reset) {
+ eval {
+ $self->_do_query('SET FOREIGN_KEY_CHECKS = 1');
+ };
+ if ($@) {
+ $e .= " also 'SET FOREIGN_KEY_CHECKS = 1' failed: $@"
+ }
+ }
+ $self->throw_exception($e);
+ };
}
sub connect_call_set_strict_mode {
trackid => 9999, cd => 9999, position => 1, title => 'orphaned deferred FK track',
});
});
-} qr/constraint/i, 'unsatisfied deferred FK throws';
+} qr/constraint/, 'unsatisfied deferred FK throws';
ok !$schema->resultset('Track')->find(9999), 'orphaned deferred FK track not inserted';
throws_ok {
artist => 1, cdid => 9999, year => '2003', title => 'dupe PK cd'
}) foreach 0..1;
});
-} qr/unique/i, 'unique constraint violation inside deferred block propagated';
+} qr/unique/, 'unique constraint violation inside deferred block propagated';
ok !$schema->resultset('CD')->find(9999), 'duplicate PK track not inserted';
done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff