savepoints for SQLite

diff --git a/Changes b/Changes
index b4f48a7..97eef01 100644 (file)
--- a/Changes
+++ b/Changes
@@ -8,6 +8,7 @@ Revision history for DBIx::Class
         - All limit dialects (except for the older Top and FetchFirst) are
           now using bind parameters for the limits/offsets, making DBI's
           prepare_cached useful across paged resutsets
+        - Support for savepoints for SQLite
         - Support for MS Access databases via DBD::ODBC and DBD::ADO (only
           Win32 support currently tested)
         - Support for the Firebird RDBMS over the new DBD::Firebird driver

diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm
index 15e70ba..ecdc37d 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/SQLite.pm
+++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm
@@ -47,6 +47,28 @@ sub backup {
   return $backupfile;
 }
 
+sub _exec_svp_begin {
+  my ($self, $name) = @_;
+
+  $self->_dbh->do("SAVEPOINT $name");
+}
+
+sub _exec_svp_release {
+  my ($self, $name) = @_;
+
+  $self->_dbh->do("RELEASE SAVEPOINT $name");
+}
+
+sub _exec_svp_rollback {
+  my ($self, $name) = @_;
+
+  # For some reason this statement changes the value of $dbh->{AutoCommit}, so
+  # we localize it here to preserve the original value.
+  local $self->_dbh->{AutoCommit} = $self->_dbh->{AutoCommit};
+
+  $self->_dbh->do("ROLLBACK TRANSACTION TO SAVEPOINT $name");
+}
+
 sub deployment_statements {
   my $self = shift;
   my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_;

diff --git a/t/752sqlite.t b/t/752sqlite.t
new file mode 100644 (file)
index 0000000..51541ac
--- /dev/null
+++ b/t/752sqlite.t
@@ -0,0 +1,41 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema(auto_savepoint => 1);
+
+my $ars = $schema->resultset('Artist');
+
+# test two-phase commit and inner transaction rollback from nested transactions
+$schema->txn_do(sub {
+  $ars->create({ name => 'in_outer_transaction' });
+  $schema->txn_do(sub {
+    $ars->create({ name => 'in_inner_transaction' });
+  });
+  ok($ars->search({ name => 'in_inner_transaction' })->first,
+    'commit from inner transaction visible in outer transaction');
+  throws_ok {
+    $schema->txn_do(sub {
+      $ars->create({ name => 'in_inner_transaction_rolling_back' });
+      die 'rolling back inner transaction';
+    });
+  } qr/rolling back inner transaction/, 'inner transaction rollback executed';
+  $ars->create({ name => 'in_outer_transaction2' });
+});
+ok($ars->search({ name => 'in_outer_transaction' })->first,
+  'commit from outer transaction');
+ok($ars->search({ name => 'in_outer_transaction2' })->first,
+  'second commit from outer transaction');
+ok($ars->search({ name => 'in_inner_transaction' })->first,
+  'commit from inner transaction');
+is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
+  undef,
+  'rollback from inner transaction';
+
+done_testing;
+
+# vim:sts=2 sw=2: