view release on metacpan or  search on metacpan

t/01-distributed.t  view on Meta::CPAN

#!perl
use strict;
use warnings;
use Test::More;
use Test::Fatal;
use Test::Warnings qw(warning warnings);
use Test::Deep;
use DBI;
use DBD::Mock;
use DBIx::TransactionManager::Distributed qw(register_dbh release_dbh dbh_is_registered txn register_cached_dbh);
use Scalar::Util qw(refaddr);
use Test::Refcount;

subtest register_dbh => sub {
    my $dbh;
    is(exception { $dbh = DBI->connect('DBI:Mock:', '', '', {RaiseError => 1}) }, undef, "create dbh");
    is(register_dbh('category1', $dbh), $dbh, 'register successfully');
    is_oneref($dbh, 'refcount is not increased');
    my $result;
    like(
        warning { $result = register_dbh('category1', $dbh) },
        qr/already registered this database handle at/,
        'register again to same category will failed'
    );
    ok(!$result, 'register failed');
    my $history = $dbh->{mock_all_history};
    is(scalar(@$history), 0, 'no statement executed');
    is_deeply(warning { $result = register_cached_dbh('category1', $dbh) }, [], 'but register again with cached_dbh  will success');
    ok($result, 'register success');
    is(release_dbh('category1', $dbh), $dbh, 'release successfully');
    is_deeply(warning { register_dbh('category1', $dbh) },
        [], 'register 3rd time to same category will not failed because previous register already released');
    is(release_dbh('category1', $dbh), $dbh, 'clear regsiter for later tests');

    local $DBIx::TransactionManager::Distributed::IN_TRANSACTION = 1;
    is(register_dbh('category1', $dbh), $dbh, 'register successfully');
    $history = $dbh->{mock_all_history};
    is(scalar(@$history),        1,            'has 1 statement executed');
    is($history->[0]->statement, 'BEGIN WORK', 'begin_work statement when registered during IN_TRANSACTION');
    is_deeply(warning { $result = register_dbh('category2', $dbh) }, [], 'no warnings emit');    # that means begin-work is not called again
    is($result, $dbh, 'register twice successfully');
    $result = undef;
    is_oneref($dbh, 'dbh refcount is not increased');
    $history = $dbh->{mock_all_history};
    is(scalar(@$history),        1,            'still has only 1 statement executed, that means begin-work only run once');
    is($history->[0]->statement, 'BEGIN WORK', 'begin_work statement when registered during IN_TRANSACTION');
    is(release_dbh('category1', $dbh), $dbh, 'release it from category1');
    ok(!dbh_is_registered('category1', $dbh), 'dbh should not be in category2 now');
    ok(dbh_is_registered('category2', $dbh), 'the dbh should still be in category2');
    like(
        warning { release_dbh('category1', $dbh) },
        qr/releasing unregistered dbh (\S+) for category category1 \(but found it in these categories instead: category2/,
        'has warnings because dbh already released before'
    );
    ok(!dbh_is_registered('category2', $dbh), 'dbh should not be in category2 now');
    done_testing();
};

subtest register_fork => sub {
    my $dbh1 = DBI->connect('DBI:Mock:', '', '');
    my $dbh2 = DBI->connect('DBI:Mock:', '', '');
    is(register_dbh('category1', $dbh1), $dbh1, 'register dbh1');
    is(register_dbh('category2', $dbh2), $dbh2, 'register dbh2');
    ok(dbh_is_registered('category1', $dbh1), 'the dbh1 is registered in category1');
    ok(dbh_is_registered('category2', $dbh2), 'the dbh2 is registered in category2');