$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
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
$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;
}
}
+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;
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
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
$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
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/};
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', '');
},
};
+$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;
--- /dev/null
+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
projects / dbsrgits/DBIx-Class-Historic.git / commitdiff