From: Justin Guenther <jguenther@cpan.org>
Date: Sun, 26 Feb 2006 03:01:41 +0000 (+0000)
Subject: Added DBIx::Class::Schema::txn_do()
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a62cf8d4bbd7df7082e0fab3d52a45afeeb64293;p=dbsrgits%2FDBIx-Class-Historic.git

Added DBIx::Class::Schema::txn_do()
---

diff --git a/MANIFEST b/MANIFEST
index 5c040e3..3935f5d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -66,6 +66,7 @@ lib/DBIx/Class/ResultSourceProxy/Table.pm
 lib/DBIx/Class/Row.pm
 lib/DBIx/Class/Schema.pm
 lib/DBIx/Class/Serialize.pm
+lib/DBIx/Class/Storage.pm
 lib/DBIx/Class/Storage/DBI.pm
 lib/DBIx/Class/Storage/DBI/Cursor.pm
 lib/DBIx/Class/Test/SQLite.pm
@@ -144,6 +145,7 @@ t/helperrels/17join_count.t
 t/helperrels/18self_referencial.t
 t/helperrels/19uuid.t
 t/helperrels/20unique.t
+t/helperrels/21transactions.t
 t/lib/DBICTest.pm
 t/lib/DBICTest/BasicRels.pm
 t/lib/DBICTest/Extra.pm
@@ -189,6 +191,7 @@ t/run/17join_count.tl
 t/run/18self_referencial.tl
 t/run/19uuid.tl
 t/run/20unique.tl
+t/run/21transactions.tl
 t/testlib/Actor.pm
 t/testlib/ActorAlias.pm
 t/testlib/Binary.pm
diff --git a/README b/README
index 20cf5cd..dd554e9 100644
--- a/README
+++ b/README
@@ -112,6 +112,8 @@ CONTRIBUTORS
 
     Scotty Allen <scotty@scottyallen.com>
 
+    Justin Guenther <jguenther@gmail.com>
+
 LICENSE
     You may distribute this code under the same terms as Perl itself.
 
diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 3b7418e..554a0a4 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -371,6 +371,96 @@ Rolls back the current transaction.
 
 sub txn_rollback { shift->storage->txn_rollback }
 
+=head2 txn_do
+
+=head3 Arguments: <coderef>, [@coderef_args]
+
+Executes <coderef> with (optional) arguments <@coderef_args> transactionally,
+returning its result (if any). If an exception is caught, a rollback is issued
+and the exception is rethrown. If the rollback fails, (i.e. throws an
+exception) an exception is thrown that includes a "Rollback failed" message.
+
+For example,
+
+  my $foo = $schema->resultset('foo')->find(1);
+
+  my $coderef = sub {
+    my ($foo, @bars) = @_;
+
+    # If any one of these fails, the entire transaction fails
+    $foo->create_related('bars', {
+      col => $_
+    }) foreach (@bars);
+
+    return $foo->bars;
+  };
+
+  my $rs;
+  eval {
+    $rs = $schema->txn_do($coderef, $foo, qw/foo bar baz/);
+  };
+
+  if ($@) {
+    my $error = $@;
+    if ($error =~ /Rollback failed/) {
+      die "something terrible has happened!";
+    } else {
+      deal_with_failed_transaction();
+      die $error;
+    }
+  }
+
+Nested transactions should work as expected (i.e. only the outermost
+transaction will issue a txn_commit on the Schema's storage)
+
+=cut
+
+sub txn_do {
+  my ($self, $coderef, @args) = @_;
+
+  ref $self or $self->throw_exception('Cannot execute txn_do as a '.
+    'class method');
+
+  my (@return_values, $return_value);
+
+  $self->txn_begin; # If this throws an exception, no rollback is needed
+
+  my $wantarray = wantarray; # Need to save this since it's reset in eval{}
+
+  eval {
+    # Need to differentiate between scalar/list context to allow for returning
+    # a list in scalar context to get the size of the list
+    if ($wantarray) {
+      @return_values = $coderef->(@args);
+    } else {
+      $return_value = $coderef->(@args);
+    }
+    $self->txn_commit;
+  };
+
+  if ($@) {
+    my $error = $@;
+
+    eval {
+      $self->txn_rollback;
+    };
+
+    if ($@) {
+      my $rollback_error = $@;
+      my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
+      $self->throw_exception($error)  # propagate nested rollback
+	if $rollback_error =~ /$exception_class/;
+
+      $self->throw_exception("Transaction aborted: $error. Rollback failed: ".
+                             $rollback_error);
+    } else {
+      $self->throw_exception($error); # txn failed but rollback succeeded
+    }
+  }
+
+  return $wantarray ? @return_values : $return_value;
+}
+
 =head2 clone
 
 Clones the schema and its associated result_source objects and returns the
@@ -397,12 +487,12 @@ Populates the source registered with the given moniker with the supplied data.
 @data should be a list of listrefs, the first containing column names, the
 second matching values - i.e.
 
-$schema->populate('Foo', [
-  [ qw/foo_id foo_string/ ],
-  [ 1, 'One' ],
-  [ 2, 'Two' ],
-  ...
-]);
+  $schema->populate('Foo', [
+    [ qw/foo_id foo_string/ ],
+    [ 1, 'One' ],
+    [ 2, 'Two' ],
+    ...
+  ]);
 
 =cut
 
diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm
new file mode 100644
index 0000000..6a51979
--- /dev/null
+++ b/lib/DBIx/Class/Storage.pm
@@ -0,0 +1,39 @@
+package DBIx::Class::Storage;
+
+use strict;
+use warnings;
+
+sub new { die "Virtual method!" }
+sub debug { die "Virtual method!" }
+sub debugcb { die "Virtual method!" }
+sub debugfh { die "Virtual method!" }
+sub disconnect { die "Virtual method!" }
+sub connected { die "Virtual method!" }
+sub ensure_connected { die "Virtual method!" }
+sub sql_maker { die "Virtual method!" }
+sub txn_begin { die "Virtual method!" }
+sub txn_commit { die "Virtual method!" }
+sub txn_rollback { die "Virtual method!" }
+sub insert { die "Virtual method!" }
+sub update { die "Virtual method!" }
+sub delete { die "Virtual method!" }
+sub select { die "Virtual method!" }
+sub select_single { die "Virtual method!" }
+sub columns_info_for { die "Virtual method!" }
+
+
+
+
+package DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION;
+
+use overload '"' => sub {
+  'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION'
+};
+
+sub new {
+  my $class = shift;
+
+  return bless {}, $class;
+}
+
+1;
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index a197ed2..d0024b3 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1,5 +1,7 @@
 package DBIx::Class::Storage::DBI;
 
+use base 'DBIx::Class::Storage';
+
 use strict;
 use warnings;
 use DBI;
@@ -363,11 +365,24 @@ Issues a rollback against the current dbh.
 
 sub txn_rollback {
   my $self = shift;
-  if ($self->{transaction_depth} == 0) {
-    $self->dbh->rollback unless $self->dbh->{AutoCommit};
-  }
-  else {
-    --$self->{transaction_depth} == 0 ? $self->dbh->rollback : die $@;    
+
+  eval {
+    if ($self->{transaction_depth} == 0) {
+      $self->dbh->rollback unless $self->dbh->{AutoCommit};
+    }
+    else {
+      --$self->{transaction_depth} == 0 ?
+        $self->dbh->rollback :
+	die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
+    }
+  };
+
+  if ($@) {
+    my $error = $@;
+    my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
+    $error =~ /$exception_class/ and $self->throw_exception($error);
+    $self->{transaction_depth} = 0;          # ensure that a failed rollback
+    $self->throw_exception($error);          # resets the transaction depth
   }
 }
 
diff --git a/t/helperrels/21transactions.t b/t/helperrels/21transactions.t
new file mode 100644
index 0000000..5730483
--- /dev/null
+++ b/t/helperrels/21transactions.t
@@ -0,0 +1,7 @@
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/21transactions.tl";
+run_tests(DBICTest->schema);
diff --git a/t/run/21transactions.tl b/t/run/21transactions.tl
new file mode 100644
index 0000000..798a76b
--- /dev/null
+++ b/t/run/21transactions.tl
@@ -0,0 +1,162 @@
+sub run_tests {
+my $schema = shift;
+plan tests => 37;
+
+my $code = sub {
+  my ($artist, @cd_titles) = @_;
+  
+  $artist->create_related('cds', {
+    title => $_,
+    year => 2006,
+  }) foreach (@cd_titles);
+  
+  return $artist->cds->all;
+};
+
+# Test successful txn_do() - scalar context
+{
+  my @titles = map {'txn_do test CD ' . $_} (1..5);
+  my $artist = $schema->resultset('Artist')->find(1);
+  my $count_before = $artist->cds->count;
+  my $count_after = $schema->txn_do($code, $artist, @titles);
+  is($count_after, $count_before+5, 'successful txn added 5 cds');
+  is($artist->cds({
+    title => "txn_do test CD $_",
+  })->first->year, 2006, "new CD $_ year correct") for (1..5);
+}
+
+# Test successful txn_do() - list context
+{
+  my @titles = map {'txn_do test CD ' . $_} (6..10);
+  my $artist = $schema->resultset('Artist')->find(1);
+  my $count_before = $artist->cds->count;
+  my @cds = $schema->txn_do($code, $artist, @titles);
+  is(scalar @cds, $count_before+5, 'added 5 CDs and returned in list context');
+  is($artist->cds({
+    title => "txn_do test CD $_",
+  })->first->year, 2006, "new CD $_ year correct") for (6..10);
+}
+
+# Test nested successful txn_do()
+{
+  my $nested_code = sub {
+    my ($schema, $artist, $code) = @_;
+
+    my @titles1 = map {'nested txn_do test CD ' . $_} (1..5);
+    my @titles2 = map {'nested txn_do test CD ' . $_} (6..10);
+
+    $schema->txn_do($code, $artist, @titles1);
+    $schema->txn_do($code, $artist, @titles2);
+  };
+
+  my $artist = $schema->resultset('Artist')->find(2);
+  my $count_before = $artist->cds->count;
+
+  eval {
+    $schema->txn_do($nested_code, $schema, $artist, $code);
+  };
+
+  my $error = $@;
+
+  ok(!$error, 'nested txn_do succeeded');
+  is($artist->cds({
+    title => 'nested txn_do test CD '.$_,
+  })->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10);
+  is($artist->cds->count, $count_before+10, 'nested txn_do added all CDs');
+}
+
+my $fail_code = sub {
+  my ($artist) = @_;
+  $artist->create_related('cds', {
+    title => 'this should not exist',
+    year => 2005,
+  });
+  die "the sky is falling";
+};
+
+# Test failed txn_do()
+{
+  my $artist = $schema->resultset('Artist')->find(3);
+
+  eval {
+    $schema->txn_do($fail_code, $artist);
+  };
+
+  my $error = $@;
+
+  like($error, qr/the sky is falling/, 'failed txn_do threw an exception');
+  my $cd = $artist->cds({
+    title => 'this should not exist',
+    year => 2005,
+  })->first;
+  ok(!defined($cd), q{failed txn_do didn't change the cds table});
+}
+
+# Test failed txn_do() with failed rollback
+{
+  my $artist = $schema->resultset('Artist')->find(3);
+
+  # Force txn_rollback() to throw an exception
+  no warnings 'redefine';
+  local *{"DBIx::Class::Schema::txn_rollback"} = sub{die 'FAILED'};
+
+  eval {
+    $schema->txn_do($fail_code, $artist);
+  };
+
+  my $error = $@;
+
+  like($error, qr/Rollback failed/, 'failed txn_do with a failed '.
+       'txn_rollback threw a rollback exception');
+  like($error, qr/the sky is falling/, 'failed txn_do with a failed '.
+       'txn_rollback included the original exception');
+
+  my $cd = $artist->cds({
+    title => 'this should not exist',
+    year => 2005,
+  })->first;
+  isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }.
+         q{changed the cds table});
+  $cd->delete; # Rollback failed
+  $cd = $artist->cds({
+    title => 'this should not exist',
+    year => 2005,
+  })->first;
+  ok(!defined($cd), q{deleted the failed txn's cd});
+  $schema->storage->{transaction_depth} = 0; # Must reset this or further tests
+                                             # will fail
+}
+
+# Test nested failed txn_do()
+{
+  my $nested_fail_code = sub {
+    my ($schema, $artist, $code1, $code2) = @_;
+
+    my @titles = map {'nested txn_do test CD ' . $_} (1..5);
+
+    $schema->txn_do($code1, $artist, @titles); # successful txn
+    $schema->txn_do($code2, $artist);          # failed txn
+  };
+
+  my $artist = $schema->resultset('Artist')->find(3);
+
+  eval {
+    $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code);
+  };
+
+  my $error = $@;
+
+  like($error, qr/the sky is falling/, 'nested failed txn_do threw exception');
+  ok(!defined($artist->cds({
+    title => 'nested txn_do test CD '.$_,
+    year => 2006,
+  })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5);
+  my $cd = $artist->cds({
+    title => 'this should not exist',
+    year => 2005,
+  })->first;
+  ok(!defined($cd), q{failed txn_do didn't add failed txn's cd});
+}
+}
+
+1;