[Bast-commits] r4220 - in DBIx-Class/0.08/branches/savepoints:
lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI t t/lib/DBICTest
debolaz at dev.catalyst.perl.org
debolaz at dev.catalyst.perl.org
Mon Mar 24 03:14:15 GMT 2008
Author: debolaz
Date: 2008-03-24 03:14:15 +0000 (Mon, 24 Mar 2008)
New Revision: 4220
Modified:
DBIx-Class/0.08/branches/savepoints/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/savepoints/lib/DBIx/Class/Storage/DBI/Pg.pm
DBIx-Class/0.08/branches/savepoints/t/72pg.t
DBIx-Class/0.08/branches/savepoints/t/lib/DBICTest/Stats.pm
Log:
Initial commit of auto_savepoint + some fixes
Modified: DBIx-Class/0.08/branches/savepoints/lib/DBIx/Class/Storage/DBI/Pg.pm
===================================================================
--- DBIx-Class/0.08/branches/savepoints/lib/DBIx/Class/Storage/DBI/Pg.pm 2008-03-23 23:52:13 UTC (rev 4219)
+++ DBIx-Class/0.08/branches/savepoints/lib/DBIx/Class/Storage/DBI/Pg.pm 2008-03-24 03:14:15 UTC (rev 4220)
@@ -88,7 +88,7 @@
sub _svp_release {
my ($self, $name) = @_;
- $self->dbh->pg_release($name;)
+ $self->dbh->pg_release($name);
}
sub _svp_rollback {
Modified: DBIx-Class/0.08/branches/savepoints/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/savepoints/lib/DBIx/Class/Storage/DBI.pm 2008-03-23 23:52:13 UTC (rev 4219)
+++ DBIx-Class/0.08/branches/savepoints/lib/DBIx/Class/Storage/DBI.pm 2008-03-24 03:14:15 UTC (rev 4220)
@@ -14,7 +14,8 @@
__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');
@@ -516,6 +517,7 @@
$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 +628,7 @@
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;
@@ -931,6 +933,8 @@
# 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}++;
}
@@ -946,7 +950,9 @@
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;
}
}
@@ -963,6 +969,10 @@
}
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;
Modified: DBIx-Class/0.08/branches/savepoints/t/72pg.t
===================================================================
--- DBIx-Class/0.08/branches/savepoints/t/72pg.t 2008-03-23 23:52:13 UTC (rev 4219)
+++ DBIx-Class/0.08/branches/savepoints/t/72pg.t 2008-03-24 03:14:15 UTC (rev 4220)
@@ -4,6 +4,7 @@
use Test::More;
use lib qw(t/lib);
use DBICTest;
+use DBICTest::Stats;
{
package DBICTest::Schema::Casecheck;
@@ -27,10 +28,10 @@
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 @@
}
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,16 +186,88 @@
});
}
-# 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) {
$dbh->do("DROP TABLE testschema.artist;");
Modified: DBIx-Class/0.08/branches/savepoints/t/lib/DBICTest/Stats.pm
===================================================================
--- DBIx-Class/0.08/branches/savepoints/t/lib/DBICTest/Stats.pm 2008-03-23 23:52:13 UTC (rev 4219)
+++ DBIx-Class/0.08/branches/savepoints/t/lib/DBICTest/Stats.pm 2008-03-24 03:14:15 UTC (rev 4220)
@@ -32,7 +32,7 @@
return $self->{'SVP_BEGIN'};
}
-sub svn_release {
+sub svp_release {
my ($self, $name) = @_;
$self->{'SVP_RELEASE'}++;
@@ -60,4 +60,4 @@
return $self->{'QUERY_START'};
}
-1;
\ No newline at end of file
+1;
More information about the Bast-commits
mailing list