Merge 'savepoints' into 'trunk'
Anders Nor Berle [Mon, 24 Mar 2008 10:08:51 +0000 (10:08 +0000)]
Changes
lib/DBIx/Class/Schema.pm
lib/DBIx/Class/Storage.pm
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/Storage/DBI/Oracle.pm
lib/DBIx/Class/Storage/DBI/Pg.pm
lib/DBIx/Class/Storage/DBI/mysql.pm
lib/DBIx/Class/Storage/Statistics.pm
t/71mysql.t
t/72pg.t
t/lib/DBICTest/Stats.pm [new file with mode: 0644]

diff --git a/Changes b/Changes
index 8a6f06e..3d391bb 100644 (file)
--- a/Changes
+++ b/Changes
@@ -5,6 +5,8 @@ Revision history for DBIx::Class
         - Refactored DBIx::Class::Schema::Versioned
         - Syntax errors from resultset components are now reported correctly
         - sqltargs respected correctly in deploy et al.
+        - Added support for savepoints, and using them automatically in
+          nested transactions if auto_savepoint is set in connect_info.
 
 0.08010 2008-03-01 10:30
         - Fix t/94versioning.t so it passes with latest SQL::Translator
index 1ce0250..ae0c427 100644 (file)
@@ -800,6 +800,57 @@ sub txn_rollback {
   $self->storage->txn_rollback;
 }
 
+=head2 svp_begin
+
+Creates a new savepoint (does nothing outside a transaction). 
+Equivalent to calling $schema->storage->svp_begin.  See
+L<DBIx::Class::Storage::DBI/"svp_begin"> for more information.
+
+=cut
+
+sub svp_begin {
+  my ($self, $name) = @_;
+
+  $self->storage or $self->throw_exception
+    ('svp_begin called on $schema without storage');
+
+  $self->storage->svp_begin($name);
+}
+
+=head2 svp_release
+
+Releases a savepoint (does nothing outside a transaction). 
+Equivalent to calling $schema->storage->svp_release.  See
+L<DBIx::Class::Storage::DBI/"svp_release"> for more information.
+
+=cut
+
+sub svp_release {
+  my ($self, $name) = @_;
+
+  $self->storage or $self->throw_exception
+    ('svp_release called on $schema without storage');
+
+  $self->storage->svp_release($name);
+}
+
+=head2 svp_rollback
+
+Rollback to a savepoint (does nothing outside a transaction). 
+Equivalent to calling $schema->storage->svp_rollback.  See
+L<DBIx::Class::Storage::DBI/"svp_rollback"> for more information.
+
+=cut
+
+sub svp_rollback {
+  my ($self, $name) = @_;
+
+  $self->storage or $self->throw_exception
+    ('svp_rollback called on $schema without storage');
+
+  $self->storage->svp_rollback($name);
+}
+
 =head2 clone
 
 =over 4
index 91fe228..79064a4 100644 (file)
@@ -262,6 +262,38 @@ which allows the rollback to propagate to the outermost transaction.
 
 sub txn_rollback { die "Virtual method!" }
 
+=head2 svp_begin
+
+Arguments: $savepoint_name
+
+Establishes a new savepoint of the specified name within the current
+transaction.
+
+=cut
+
+sub svp_begin { die "Virtual method!" }
+
+=head2 svp_release
+
+Arguments: $savepoint_name
+
+Destroy a savepoint, but keep the effects of the commands executed since
+it's creation.
+
+=cut
+
+sub svp_release { die "Virtual method!" }
+
+=head2 svp_rollback
+
+Arguments: $savepoint_name
+
+Rollback to the savepoint of the specified name.
+
+=cut
+
+sub svp_rollback { die "Virtual method!" }
+
 =for comment
 
 =head2 txn_scope_guard
index 64a0f04..cb55d20 100644 (file)
@@ -14,7 +14,8 @@ use Scalar::Util qw/blessed weaken/;
 __PACKAGE__->mk_group_accessors('simple' =>
     qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
        _conn_pid _conn_tid disable_sth_caching on_connect_do
-       on_disconnect_do transaction_depth unsafe _dbh_autocommit/
+       on_disconnect_do transaction_depth unsafe _dbh_autocommit
+       auto_savepoint/
 );
 
 __PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
@@ -429,6 +430,12 @@ Note that your custom settings can cause Storage to malfunction,
 especially if you set a C<HandleError> handler that suppresses exceptions
 and/or disable C<RaiseError>.
 
+=item auto_savepoint
+
+If this option is true, L<DBIx::Class> will use savepoints when nesting
+transactions, making it possible to recover from failure in the inner
+transaction without having to abort all outer transactions.
+
 =back
 
 These options can be mixed in with your other L<DBI> connection attributes,
@@ -516,6 +523,7 @@ sub connect_info {
     $last_info = { %$last_info }; # so delete is non-destructive
     my @storage_option = qw(
       on_connect_do on_disconnect_do disable_sth_caching unsafe cursor_class
+      auto_savepoint
     );
     for my $storage_opt (@storage_option) {
       if(my $value = delete $last_info->{$storage_opt}) {
@@ -626,7 +634,7 @@ sub txn_do {
   ref $coderef eq 'CODE' or $self->throw_exception
     ('$coderef must be a CODE reference');
 
-  return $coderef->(@_) if $self->{transaction_depth};
+  return $coderef->(@_) if $self->{transaction_depth} && ! $self->auto_savepoint;
 
   local $self->{_in_dbh_do} = 1;
 
@@ -867,6 +875,59 @@ sub _connect {
   $dbh;
 }
 
+sub svp_begin {
+  my ($self, $name) = @_;
+  $self->throw_exception("You failed to provide a savepoint name!") if !$name;
+
+  if($self->{transaction_depth} == 0) {
+    warn("Can't use savepoints without a transaction.");
+    return 0;
+  }
+
+  if(!$self->can('_svp_begin')) {
+    warn("Your Storage implementation doesn't support savepoints!");
+    return 0;
+  }
+  $self->debugobj->svp_begin($name) if $self->debug;
+  $self->_svp_begin($name);
+}
+
+sub svp_release {
+  my ($self, $name) = @_;
+
+  $self->throw_exception("You failed to provide a savepoint name!") if !$name;
+
+  if($self->{transaction_depth} == 0) {
+    warn("Can't use savepoints without a transaction.");
+    return 0;
+  }
+
+  if(!$self->can('_svp_release')) {
+      warn("Your Storage implementation doesn't support savepoint releasing!");
+      return 0;
+  }
+  $self->debugobj->svp_release($name) if $self->debug;
+  $self->_svp_release($name);
+}
+
+sub svp_rollback {
+  my ($self, $name) = @_;
+
+  $self->throw_exception("You failed to provide a savepoint name!") if !$name;
+
+  if($self->{transaction_depth} == 0) {
+    warn("Can't use savepoints without a transaction.");
+    return 0;
+  }
+
+  if(!$self->can('_svp_rollback')) {
+      warn("Your Storage implementation doesn't support savepoints!");
+      return 0;
+  }
+  $self->debugobj->svp_rollback($name) if $self->debug;
+  $self->_svp_rollback($name);
+}
 
 sub txn_begin {
   my $self = shift;
@@ -878,6 +939,8 @@ sub txn_begin {
     #  we should reconnect on begin_work
     #  for AutoCommit users
     $self->dbh->begin_work;
+  } elsif ($self->auto_savepoint) {
+    $self->svp_begin ("savepoint_$self->{transaction_depth}");
   }
   $self->{transaction_depth}++;
 }
@@ -893,7 +956,9 @@ sub txn_commit {
       if $self->_dbh_autocommit;
   }
   elsif($self->{transaction_depth} > 1) {
-    $self->{transaction_depth}--
+    $self->{transaction_depth}--;
+    $self->svp_release ("savepoint_$self->{transaction_depth}")
+      if $self->auto_savepoint;
   }
 }
 
@@ -910,6 +975,10 @@ sub txn_rollback {
     }
     elsif($self->{transaction_depth} > 1) {
       $self->{transaction_depth}--;
+      if ($self->auto_savepoint) {
+        $self->svp_rollback ("savepoint_$self->{transaction_depth}");
+        $self->svp_release ("savepoint_$self->{transaction_depth}");
+      }
     }
     else {
       die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
index d52adbb..64bf9f1 100644 (file)
@@ -25,6 +25,19 @@ sub _rebless {
     }
 }
 
+sub _svp_begin {
+    my ($self, $name) = @_;
+    $self->dbh->do("SAVEPOINT $name");
+}
+
+# Would've implemented _svp_release here, but Oracle doesn't support it.
+
+sub _svp_rollback {
+    my ($self, $name) = @_;
+
+    $self->dbh->do("ROLLBACK TO SAVEPOINT $name")
+}
 
 1;
 
index a2d7f1e..bd28e02 100644 (file)
@@ -79,6 +79,24 @@ sub _sequence_fetch {
   return $id;
 }
 
+sub _svp_begin {
+    my ($self, $name) = @_;
+
+    $self->dbh->pg_savepoint($name);
+}
+
+sub _svp_release {
+    my ($self, $name) = @_;
+
+    $self->dbh->pg_release($name);
+}
+
+sub _svp_rollback {
+    my ($self, $name) = @_;
+
+    $self->dbh->pg_rollback_to($name);
+}
+
 1;
 
 =head1 NAME
index 8ecdfca..ec36176 100644 (file)
@@ -16,6 +16,24 @@ sub sqlt_type {
   return 'MySQL';
 }
 
+sub _svp_begin {
+    my ($self, $name) = @_;
+
+    $self->dbh->do("SAVEPOINT $name");
+}
+
+sub _svp_release {
+    my ($self, $name) = @_;
+
+    $self->dbh->do("RELEASE SAVEPOINT $name");
+}
+
+sub _svp_rollback {
+    my ($self, $name) = @_;
+
+    $self->dbh->do("ROLLBACK TO SAVEPOINT $name")
+}
+
 1;
 
 =head1 NAME
index c2a2209..b60c44e 100644 (file)
@@ -108,6 +108,39 @@ sub txn_commit {
   $self->print("COMMIT\n");
 }
 
+=head2 svp_begin
+
+Called when a savepoint is created.
+
+=cut
+sub svp_begin {
+  my ($self, $name) = @_;
+
+  $self->print("SAVEPOINT $name\n");
+}
+
+=head2 svp_release
+
+Called when a savepoint is released.
+
+=cut
+sub svp_release {
+  my ($self, $name) = @_;
+
+ $self->print("RELEASE SAVEPOINT $name\n");
+}
+
+=head2 svp_rollback
+
+Called when rolling back to a savepoint.
+
+=cut
+sub svp_rollback {
+  my ($self, $name) = @_;
+
+ $self->print("ROLLBACK TO SAVEPOINT $name\n");
+}
+
 =head2 query_start
 
 Called before a query is executed.  The first argument is the SQL string being
index a326dda..3d53820 100644 (file)
@@ -5,6 +5,7 @@ use Test::More;
 use lib qw(t/lib);
 use DBICTest;
 use DBI::Const::GetInfoType;
+use DBICTest::Stats;
 
 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/};
 
@@ -13,15 +14,18 @@ my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/};
 plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test'
   unless ($dsn && $user);
 
-plan tests => 5;
+plan tests => 9;
 
 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
 
 my $dbh = $schema->storage->dbh;
+my $stats = new DBICTest::Stats();
+$schema->storage->debugobj($stats);
+$schema->storage->debug(1);
 
 $dbh->do("DROP TABLE IF EXISTS artist;");
 
-$dbh->do("CREATE TABLE artist (artistid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255), charfield CHAR(10));");
+$dbh->do("CREATE TABLE artist (artistid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255), charfield CHAR(10)) ENGINE=InnoDB;");
 
 #'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', '');
 
@@ -68,6 +72,32 @@ my $test_type_info = {
     },
 };
 
+$schema->txn_begin();
+
+my $arty = $schema->resultset('Artist')->find(1);
+
+my $name = $arty->name();
+
+$schema->svp_begin('savepoint1');
+
+cmp_ok($stats->{'SVP_BEGIN'}, '==', 1, 'Statistics svp_begin tickled');
+
+$arty->update({ name => 'Jheephizzy' });
+
+$arty->discard_changes();
+
+cmp_ok($arty->name(), 'eq', 'Jheephizzy', 'Name changed');
+
+$schema->svp_rollback('savepoint1');
+
+cmp_ok($stats->{'SVP_ROLLBACK'}, '==', 1, 'Statistics svp_rollback tickled');
+
+$arty->discard_changes();
+
+cmp_ok($arty->name(), 'eq', $name, 'Name rolled back');
+
+$schema->txn_commit();
+
 SKIP: {
     my $mysql_version = $dbh->get_info( $GetInfoType{SQL_DBMS_VER} );
     skip "Cannot determine MySQL server version", 1 if !$mysql_version;
index c517600..fcee899 100644 (file)
--- a/t/72pg.t
+++ b/t/72pg.t
@@ -4,6 +4,7 @@ use warnings;
 use Test::More;
 use lib qw(t/lib);
 use DBICTest;
+use DBICTest::Stats;
 
 {
   package DBICTest::Schema::Casecheck;
@@ -27,10 +28,10 @@ my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
 plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
  . ' (note: creates and drops tables named artist and casecheck!)' unless ($dsn && $user);
 
-plan tests => 32;
+plan tests => 43;
 
 DBICTest::Schema->load_classes( 'Casecheck' );
-my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { auto_savepoint => 1});
 
 # Check that datetime_parser returns correctly before we explicitly connect.
 SKIP: {
@@ -45,6 +46,10 @@ SKIP: {
 }
 
 my $dbh = $schema->storage->dbh;
+my $stats = new DBICTest::Stats();
+$schema->storage->debugobj($stats);
+$schema->storage->debug(1);
+
 $schema->source("Artist")->name("testschema.artist");
 $schema->source("SequenceTest")->name("testschema.sequence_test");
 $dbh->do("CREATE SCHEMA testschema;");
@@ -181,15 +186,87 @@ SKIP: {
     });
 }
 
-# test auto increment using sequences WITHOUT triggers
-for (1..5) {
+SKIP: {
+  skip "Oracle Auto-PK tests are broken", 16;
+  # test auto increment using sequences WITHOUT triggers
+  
+  for (1..5) {
     my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' });
     is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key");
     is($st->pkid2, $_ + 9, "Oracle Auto-PK without trigger: Second primary key");
     is($st->nonpkid, $_ + 19, "Oracle Auto-PK without trigger: Non-primary key");
+  }
+  my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
+  is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
 }
-my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
-is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
+
+$schema->txn_begin();
+
+my $arty = $schema->resultset('Artist')->find(1);
+
+my $name = $arty->name();
+
+$schema->svp_begin('savepoint1');
+
+cmp_ok($stats->{'SVP_BEGIN'}, '==', 1, 'Statistics svp_begin tickled');
+
+$arty->update({ name => 'Jheephizzy' });
+
+$arty->discard_changes();
+
+cmp_ok($arty->name(), 'eq', 'Jheephizzy', 'Name changed');
+
+$schema->svp_rollback('savepoint1');
+
+cmp_ok($stats->{'SVP_ROLLBACK'}, '==', 1, 'Statistics svp_rollback tickled');
+
+$arty->discard_changes();
+
+cmp_ok($arty->name(), 'eq', $name, 'Name rolled back');
+
+$schema->txn_commit();
+
+$schema->txn_do (sub {
+    $schema->txn_do (sub {
+        $arty->name ('Muff');
+
+        $arty->update;
+      });
+
+    eval {
+      $schema->txn_do (sub {
+          $arty->name ('Moff');
+
+          $arty->update;
+
+          $arty->discard_changes;
+
+          is($arty->name,'Moff','Value updated in nested transaction');
+
+          $schema->storage->dbh->do ("GUARANTEED TO PHAIL");
+        });
+    };
+
+    ok ($@,'Nested transaction failed (good)');
+
+    $arty->discard_changes;
+
+    is($arty->name,'Muff','auto_savepoint rollback worked');
+
+    $arty->name ('Miff');
+
+    $arty->update;
+  });
+
+$arty->discard_changes;
+
+is($arty->name,'Miff','auto_savepoint worked');
+
+cmp_ok($stats->{'SVP_BEGIN'},'==',3,'Correct number of savepoints created');
+
+cmp_ok($stats->{'SVP_RELEASE'},'==',2,'Correct number of savepoints released');
+
+cmp_ok($stats->{'SVP_ROLLBACK'},'==',2,'Correct number of savepoint rollbacks');
 
 END {
     if($dbh) {
diff --git a/t/lib/DBICTest/Stats.pm b/t/lib/DBICTest/Stats.pm
new file mode 100644 (file)
index 0000000..5a4544f
--- /dev/null
@@ -0,0 +1,63 @@
+package DBICTest::Stats;
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::Statistics/;
+
+sub txn_begin {
+  my $self = shift;
+
+  $self->{'TXN_BEGIN'}++;
+  return $self->{'TXN_BEGIN'};
+}
+
+sub txn_rollback {
+  my $self = shift;
+
+  $self->{'TXN_ROLLBACK'}++;
+  return $self->{'TXN_ROLLBACK'};
+}
+
+sub txn_commit {
+  my $self = shift;
+
+  $self->{'TXN_COMMIT'}++;
+  return $self->{'TXN_COMMIT'};
+}
+
+sub svp_begin {
+  my ($self, $name) = @_;
+
+  $self->{'SVP_BEGIN'}++;
+  return $self->{'SVP_BEGIN'};
+}
+
+sub svp_release {
+  my ($self, $name) = @_;
+
+  $self->{'SVP_RELEASE'}++;
+  return $self->{'SVP_RELEASE'};
+}
+
+sub svp_rollback {
+  my ($self, $name) = @_;
+
+  $self->{'SVP_ROLLBACK'}++;
+  return $self->{'SVP_ROLLBACK'};
+}
+
+sub query_start {
+  my ($self, $string, @bind) = @_;
+
+  $self->{'QUERY_START'}++;
+  return $self->{'QUERY_START'};
+}
+
+sub query_end {
+  my ($self, $string) = @_;
+
+  $self->{'QUERY_END'}++;
+  return $self->{'QUERY_START'};
+}
+
+1;