view release on metacpan or  search on metacpan

t/transaction.t  view on Meta::CPAN

# here's a bad package that does something naughty
{
	package bad::citizen;
	sub new { bless \@_ }
	sub DESTROY { undef $@ }
	sub AUTOLOAD {}
}

# On some versions of perl, destroyers may unset $@; we're immune to it.
{
	my $expected_exceptions = qr/(?:the hills are alive|an error was encountered in your transaction)/;

	{
		local $@;
		eval {
			run_in_transaction {
				my $fake_dbh = bad::citizen->new;
				die 'the hills are alive';
			} db_handle => $stub_dbh, on_error => 'rollback';
		};

		like( $@, $expected_exceptions, 'if $@ is unintentionally unset on object destruction, we set a sensible default error' );
	}

	{
		local $@;
		run_in_transaction {
			my $fake_dbh = bad::citizen->new;
			die 'the hills are alive';
		} db_handle => $stub_dbh, on_error => 'continue';

		like( $@, $expected_exceptions, 'if $@ is unintentionally unset on object destruction, we set a sensible default error' );
	}
}