#!/usr/bin/env perl -w
use strict;
use warnings;
use Test::More tests => 42;
#use Test::More 'no_plan';
use Test::MockModule;
my $CLASS;
BEGIN {
$CLASS = 'DBIx::Connector';
use_ok $CLASS or die;
}
ok my $conn = $CLASS->new( 'dbi:ExampleP:dummy', '', '' ),
'Get a connection';
my $module = Test::MockModule->new($CLASS);
my $driver = Test::MockModule->new("$CLASS\::Driver");
# Mock the savepoint driver methods.
$driver->mock( $_ => sub { shift } ) for qw(savepoint release rollback_to);
# Test with no existing dbh.
$module->mock( _connect => sub {
pass '_connect should be called';
$module->original('_connect')->(@_);
});
ok my $dbh = $conn->dbh, 'Fetch the database handle';
ok !$conn->{_in_run}, '_in_run should be false';
ok $dbh->{AutoCommit}, 'AutoCommit should be true';
ok !$conn->in_txn, 'in_txn() should know it, too';
is $conn->{_svp_depth}, 0, 'Depth should be 0';
# This should just pass to txn.
ok $conn->svp( fixup => sub {
ok !shift->{AutoCommit}, 'Inside, we should be in a transaction';
ok $conn->in_txn, 'in_txn() should know it that';
ok $conn->{_in_run}, '_in_run should be true';
is $conn->{_svp_depth}, 0, 'Depth should still be 0';
}), 'Do something with no existing handle';
$module->unmock( '_connect');
ok !$conn->{_in_run}, '_in_run should be false again';
ok $dbh->{AutoCommit}, 'Transaction should be committed';
ok !$conn->in_txn, 'And in_txn() should know it';
is $conn->{_svp_depth}, 0, 'Depth should be 0 again';
# Test with instantiated dbh.
is $conn->{_dbh}, $dbh, 'The dbh should be stored';
ok $conn->connected, 'We should be connected';
ok $conn->svp( fixup => sub {
my $dbha = shift;
is $dbha, $dbh, 'The handle should have been passed';
is $_, $dbh, 'It should also be in $_';
ok !$dbha->{AutoCommit}, 'We should be in a transaction';
ok $conn->in_txn, 'in_txn() should know all about it';
}), 'Do something with existing handle';
# Run the same test from inside a transaction, so we're sure that the svp
# code executes properly. This is because svp must be called from inside a
# txn. If it's not, it just dispatches to txn() and returns.
ok $conn->txn(fixup => sub {
$conn->svp(sub {
my $dbha = shift;
is $conn->{_mode}, 'fixup', 'Should be in fixup mode';
is $dbha, $dbh, 'The handle should have been passed';
is $_, $dbh, 'It should also be in $_';
ok !$dbha->{AutoCommit}, 'We should be in a transaction';
ok $conn->in_txn, 'in_txn() should know it, too';
});
}), 'Do something inside a transaction';
# Test the return value. Gotta do it inside a transaction.
$conn->txn(sub {
ok my $foo = $conn->svp( fixup => sub {
return (2, 3, 5);
}), 'Do in scalar context';
is $foo, 5, 'The return value should be the last value';
ok my @foo = $conn->svp( fixup => sub {
return (2, 3, 5);
}), 'Do in array context';
is_deeply \@foo, [2, 3, 5], 'The return value should be the list';
});
# Make sure nested calls work.
$conn->svp( fixup => sub {
my $dbh = shift;
ok !$dbh->{AutoCommit}, 'Inside, we should be in a transaction';
ok $conn->in_txn, 'in_txn() should know all about it';
is $conn->{_svp_depth}, 0, 'Depth should be 0';
local $dbh->{Active} = 0;
$conn->svp( fixup => sub {
is shift, $dbh, 'Nested svp should always get the current dbh';
ok !$dbh->{AutoCommit}, 'Nested txn_runup should be in the txn';
ok $conn->in_txn, 'in_txn() should know all about it';
is $conn->{_svp_depth}, 1, 'Depth should be 1';
});
is $conn->{_svp_depth}, 0, 'Depth should be 0 again';
});