From: Rafael Kitover <rkitover@cpan.org>
Date: Thu, 24 Nov 2011 17:27:10 +0000 (-0500)
Subject: fix with_deferred_fk_checks exception propagation
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=26d54a1d1c51e7e852360b5179ca834a7323c8ee;p=dbsrgits%2FDBIx-Class.git

fix with_deferred_fk_checks exception propagation

The general case of a SET CONSTRAINTS ALL DEFERRED statement affecting
the current transaction has been implemented in ::Storage::DBI, with
specific storage drivers only having to implement
_set_constraints_deferred and _set_constraints_immediate to run the
necessary queries.

For DBDs that do not allow a ROLLBACK after a failed COMMIT, setting the
unsatisifed_deferred_constraints_autorollback inherited accessor flag
will take care of not issuing the ROLLBACK and decrementing the
transaction_depth.

The MySQL implementation has been changed to use a transaction as well,
so that before COMMIT the FOREIGN_KEY_CHECKS variable is set back to
1 so that (in theory) the COMMIT will run with FK checks enabled and
throw an error if they are unsatisfied. This is not currently
tested, we need innodb tests in t/71mysql.t, at some point.

Also work around buggy $dbh->commit behavior in DBD::Informix, an RT
will be forthcoming.
---

diff --git a/Changes b/Changes
index 2fef676..d34e6fd 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 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
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index ac84176..3f9c2e8 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -17,6 +17,7 @@ use Try::Tiny;
 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
@@ -24,8 +25,12 @@ __PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
 
 __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');
@@ -850,10 +855,70 @@ in MySQL's case disabled entirely.
 
 =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
diff --git a/lib/DBIx/Class/Storage/DBI/Informix.pm b/lib/DBIx/Class/Storage/DBI/Informix.pm
index 2a756d0..dd6ffcd 100644
--- a/lib/DBIx/Class/Storage/DBI/Informix.pm
+++ b/lib/DBIx/Class/Storage/DBI/Informix.pm
@@ -2,10 +2,10 @@ package DBIx::Class::Storage::DBI::Informix;
 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');
@@ -29,6 +29,59 @@ This class implements storage-specific support for the Informix RDBMS
 
 =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) = @_;
@@ -59,20 +112,6 @@ sub _exec_svp_rollback {
     $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:
@@ -180,3 +219,4 @@ See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
 You may distribute this code under the same terms as Perl itself.
 
 =cut
+# vim:sts=2 sw=2:
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index ae5d823..af0d677 100644
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -646,33 +646,16 @@ sub relname_to_table_alias {
   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
diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm
index 40dcd8c..709ec60 100644
--- a/lib/DBIx/Class/Storage/DBI/Pg.pm
+++ b/lib/DBIx/Class/Storage/DBI/Pg.pm
@@ -5,7 +5,6 @@ use warnings;
 
 use base qw/DBIx::Class::Storage::DBI/;
 
-use Context::Preserve 'preserve_context';
 use DBIx::Class::Carp;
 use Try::Tiny;
 use namespace::clean;
@@ -22,18 +21,20 @@ sub _determine_supports_insert_returning {
   ;
 }
 
-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
@@ -274,3 +275,4 @@ See L<DBIx::Class/CONTRIBUTORS>
 You may distribute this code under the same terms as Perl itself.
 
 =cut
+# vim:sts=2 sw=2:
diff --git a/lib/DBIx/Class/Storage/DBI/mysql.pm b/lib/DBIx/Class/Storage/DBI/mysql.pm
index dc7ff90..616d7d7 100644
--- a/lib/DBIx/Class/Storage/DBI/mysql.pm
+++ b/lib/DBIx/Class/Storage/DBI/mysql.pm
@@ -5,18 +5,45 @@ use warnings;
 
 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 {
diff --git a/t/748informix.t b/t/748informix.t
index 6040b15..0481b44 100644
--- a/t/748informix.t
+++ b/t/748informix.t
@@ -147,7 +147,7 @@ throws_ok {
       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 {
@@ -156,7 +156,7 @@ 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;