diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm index f961c4e44..7b1c6b8b0 100644 --- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm +++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm @@ -42,7 +42,7 @@ sub new { sub commit { my $self = shift; - $self->{storage}->throw_exception("Refusing to execute multiple commits on scope guard $self") + $self->{storage}->throw_exception("Refusing to execute multiple commit/rollbacks on scope guard $self") if $self->{inactivated}; # FIXME - this assumption may be premature: a commit may fail and a rollback @@ -54,6 +54,16 @@ sub commit { $self->{storage}->txn_commit; } +sub rollback { + my $self = shift; + + $self->{storage}->throw_exception("Refusing to execute multiple commit/rollbacks on scope guard $self") + if $self->{inactivated}; + + $self->{inactivated} = 1; + $self->{storage}->txn_rollback; +} + sub DESTROY { return if &detected_reinvoked_destructor; @@ -149,6 +159,12 @@ Commit the transaction, and stop guarding the scope. If this method is not called and this object goes out of scope (e.g. an exception is thrown) then the transaction is rolled back, via L +=head2 rollback + +Roll back the transaction, and stop guarding the scope. You can use this to +avoid the warning when the scope guard goes out of scope, for deliberate +rollbacks. + =cut =head1 SEE ALSO diff --git a/t/storage/txn_scope_guard.t b/t/storage/txn_scope_guard.t index 00d81a46d..91ccb6f54 100644 --- a/t/storage/txn_scope_guard.t +++ b/t/storage/txn_scope_guard.t @@ -57,7 +57,24 @@ use DBICTest; ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created"); - }, 'rollback successful withot exception'); + }, 'rollback successful without exception'); + + lives_ok (sub { + # this weird assignment is to stop perl <= 5.8.9 leaking $schema on nested sub{}s + my $s = $schema; + + warnings_are ( sub { + my $guard = $schema->txn_scope_guard; + $schema->resultset('Artist')->create({ + name => 'Death Cab for Cutie', + }); + inner($schema, 0); + $guard->rollback; + }, [], 'Deliberate rollback without warning'); + + ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created"); + + }, 'rollback successful without exception'); sub outer { my ($schema, $fatal) = @_;