view release on metacpan or  search on metacpan

t/AI/transaction_extra.t  view on Meta::CPAN

use Test2::V0;
use DBI;
use File::Temp qw/tempdir/;

# Extra transaction coverage on plain SQLite, exercising documented behavior in
# DBIx::QuickORM::Manual::Transactions that t/transactions.t does not assert on
# the SQLite path: real persistence (verified via an independent DBI handle),
# savepoint nesting/isolation, callback firing rules, the transaction object's
# state() transitions, DESTROY-time rollback of an abandoned transaction, and
# auto_retry's return value and in-transaction guard.

BEGIN {
    skip_all "DBD::SQLite is required for these tests"
        unless eval { require DBD::SQLite; 1 };
}

require DBIx::QuickORM;

my $dir  = tempdir(CLEANUP => 1);
my $file = "$dir/txn.sqlite";
my $dsn  = "dbi:SQLite:dbname=$file";

{
    my $dbh = DBI->connect($dsn, '', '', {RaiseError => 1, PrintError => 0});
    $dbh->do('CREATE TABLE items (item_id INTEGER PRIMARY KEY, name TEXT NOT NULL)');
    $dbh->disconnect;
}

my $con = DBIx::QuickORM->quick(credentials => {dsn => $dsn});

# Independent connection used to confirm what is actually committed to disk.
# The ORM connection's own dbh would see uncommitted in-transaction writes, so
# we read through a separate handle to verify true persistence.
my $probe = DBI->connect($dsn, '', '', {RaiseError => 1, PrintError => 0});

sub disk_names {
    my $rows = $probe->selectcol_arrayref('SELECT name FROM items ORDER BY name');
    return [@$rows];
}

subtest commit_persists => sub {
    ok(!$con->in_txn, "not in a txn to start");

    my $txn = $con->txn(sub {
        my $t = shift;
        ok($con->in_txn,      "in_txn true inside the action");
        ok($con->current_txn, "current_txn set inside the action");
        is($con->current_txn, $t, "current_txn is the active txn object");
        ok(!$t->is_savepoint, "top-level txn is not a savepoint");
        is($t->state, 'active', "state is active inside the action");
        $con->handle('items')->insert({name => 'committed'});
    });

    ok(!$con->in_txn,      "in_txn false after commit");
    ok(!$con->current_txn, "current_txn cleared after commit");
    # state() is derived from result: success records 1, so it reports
    # 'committed' once the action returns normally.
    is($txn->state, 'committed', "state transitioned out of active to committed on implicit commit");
    ok($txn->committed, "committed is true");
    ok(!$txn->rolled_back, "rolled_back is false");
    is($txn->result, 1, "result is 1 after commit");

    is(disk_names(), ['committed'], "row persisted to disk after commit");
};

subtest rollback_on_die => sub {
    my $before = disk_names();

    my $err = dies {
        $con->txn(sub {
            $con->handle('items')->insert({name => 'doomed'});
            die "boom\n";
        });
    };

    like($err, qr/boom/, "exception propagated out of txn()");
    is(disk_names(), $before, "row gone from disk after rollback-on-die");
};

subtest savepoint_nesting => sub {
    my $before = disk_names();

    $con->txn(sub {
        my $outer = shift;
        ok(!$outer->is_savepoint, "outer txn is not a savepoint");

        $con->handle('items')->insert({name => 'outer_keep'});

        $con->txn(sub {