Merge 0.09's savepoint branch
Cory G Watson [Sun, 23 Mar 2008 23:42:04 +0000 (23:42 +0000)]
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/lib/DBICTest/Stats.pm [new file with mode: 0644]

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..de373aa 100644 (file)
@@ -867,6 +867,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($self->dbh(), $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($self->dbh(), $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($self->dbh(), $name);
+}
 
 sub txn_begin {
   my $self = shift;
index d52adbb..778d12f 100644 (file)
@@ -25,6 +25,19 @@ sub _rebless {
     }
 }
 
+sub _svp_begin {
+    my ($self, $dbh, $name) = @_;
+    $dbh->do("SAVEPOINT $name");
+}
+
+# Would've implemented _svp_release here, but Oracle doesn't support it.
+
+sub _svp_rollback {
+    my ($self, $dbh, $name) = @_;
+
+    $dbh->do("ROLLBACK TO SAVEPOINT $name")
+}
 
 1;
 
index a2d7f1e..fdf308e 100644 (file)
@@ -79,6 +79,24 @@ sub _sequence_fetch {
   return $id;
 }
 
+sub _svp_begin {
+    my ($self, $dbh, $name) = @_;
+
+    $dbh->pg_savepoint($name);
+}
+
+sub _svp_release {
+    my ($self, $dbh, $name) = @_;
+
+    $dbh->pg_release($name;)
+}
+
+sub _svp_rollback {
+    my ($self, $dbh, $name) = @_;
+
+    $dbh->pg_rollback_to($name);
+}
+
 1;
 
 =head1 NAME
index 8ecdfca..19b035c 100644 (file)
@@ -16,6 +16,24 @@ sub sqlt_type {
   return 'MySQL';
 }
 
+sub _svp_begin {
+    my ($self, $dbh, $name) = @_;
+
+    $dbh->do("SAVEPOINT $name");
+}
+
+sub _svp_release {
+    my ($self, $dbh, $name) = @_;
+
+    $dbh->do("RELEASE SAVEPOINT $name");
+}
+
+sub _svp_rollback {
+    my ($self, $dbh, $name) = @_;
+
+    $dbh->do("ROLLBACK TO SAVEPOINT $name")
+}
+
 1;
 
 =head1 NAME
index c2a2209..1ecf1fc 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 svn_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;
diff --git a/t/lib/DBICTest/Stats.pm b/t/lib/DBICTest/Stats.pm
new file mode 100644 (file)
index 0000000..97fbc55
--- /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 svn_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;
\ No newline at end of file