[Bast-commits] r9057 - in DBIx-Class/0.08/trunk: lib/DBIx/Class/Storage/DBI t

caelum at dev.catalyst.perl.org caelum at dev.catalyst.perl.org
Fri Mar 26 09:55:55 GMT 2010


Author: caelum
Date: 2010-03-26 09:55:55 +0000 (Fri, 26 Mar 2010)
New Revision: 9057

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Informix.pm
   DBIx-Class/0.08/trunk/t/748informix.t
Log:
savepoints for Informix

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Informix.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Informix.pm	2010-03-26 08:55:46 UTC (rev 9056)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Informix.pm	2010-03-26 09:55:55 UTC (rev 9057)
@@ -32,6 +32,22 @@
   return { limit_dialect => 'SkipFirst', %{$self->{_sql_maker_opts}||{}} };
 }
 
+sub _svp_begin {
+    my ($self, $name) = @_;
+
+    $self->_get_dbh->do("SAVEPOINT $name");
+}
+
+# can't release savepoints
+sub _svp_release { 1 }
+
+sub _svp_rollback {
+    my ($self, $name) = @_;
+
+    $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
+}
+
+
 1;
 
 __END__

Modified: DBIx-Class/0.08/trunk/t/748informix.t
===================================================================
--- DBIx-Class/0.08/trunk/t/748informix.t	2010-03-26 08:55:46 UTC (rev 9056)
+++ DBIx-Class/0.08/trunk/t/748informix.t	2010-03-26 09:55:55 UTC (rev 9057)
@@ -13,7 +13,9 @@
 plan skip_all => 'Set $ENV{DBICTEST_INFORMIX_DSN}, _USER and _PASS to run this test'
   unless $dsn;
 
-my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
+  auto_savepoint => 1
+});
 
 my $dbh = $schema->storage->dbh;
 
@@ -72,7 +74,28 @@
 is( $lim->next->artistid, 102, "iterator->next ok" );
 is( $lim->next, undef, "next past end of resultset ok" );
 
+# test savepoints
+eval {
+  $schema->txn_do(sub {
+    eval {
+      $schema->txn_do(sub {
+        $ars->create({ name => 'in_savepoint' });
+        die "rolling back savepoint";
+      });
+    };
+    ok ((not $ars->search({ name => 'in_savepoint' })->first),
+      'savepoint rolled back');
+    $ars->create({ name => 'in_outer_txn' });
+    die "rolling back outer txn";
+  });
+};
 
+like $@, qr/rolling back outer txn/,
+  'correct exception for rollback';
+
+ok ((not $ars->search({ name => 'in_outer_txn' })->first),
+  'outer txn rolled back');
+
 done_testing;
 
 # clean up our mess




More information about the Bast-commits mailing list