view release on metacpan or  search on metacpan

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

        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 {
            my $inner = shift;
            ok($inner->is_savepoint, "nested txn is a savepoint");
            isnt($inner, $outer, "inner txn is a distinct object");
            $con->handle('items')->insert({name => 'inner_drop'});
            $inner->rollback;
        });

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

    is(
        disk_names(),
        [sort(@$before, 'outer_keep', 'outer_keep2')],
        "outer changes persisted, inner savepoint rollback discarded only its row",
    );
};

subtest callbacks_on_commit => sub {
    my %seen;
    $con->txn(
        action        => sub { $seen{action}++ },
        on_success    => sub { $seen{success}++ },
        on_fail       => sub { $seen{fail}++ },
        on_completion => sub { $seen{completion}++ },
    );
    is(\%seen, {action => 1, success => 1, completion => 1}, "commit fires success+completion, not fail");
};

subtest callbacks_on_rollback => sub {
    my %seen;
    $con->txn(
        action        => sub { $seen{action}++; $_[0]->rollback },
        on_success    => sub { $seen{success}++ },
        on_fail       => sub { $seen{fail}++ },
        on_completion => sub { $seen{completion}++ },
    );
    is(\%seen, {action => 1, fail => 1, completion => 1}, "rollback fires fail+completion, not success");
};

subtest callbacks_added_to_object => sub {
    my %seen;
    $con->txn(sub {
        my $t = shift;
        $t->add_success_callback(sub { $seen{success}++ });
        $t->add_fail_callback(sub { $seen{fail}++ });
        $t->add_completion_callback(sub { $seen{completion}++ });
    });
    is(\%seen, {success => 1, completion => 1}, "add_*_callback success path");
};

subtest state_rolled_back => sub {
    my $txn = $con->txn(sub { $_[0]->rollback("nope") });
    is($txn->state, 'rolled_back', "state transitioned to rolled_back");
    is($txn->result, 0, "result is 0 after rollback");
    ok($txn->complete, "complete is true after rollback");
};

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

    my $warns = warnings {
        my $txn = $con->txn;
        ok($txn->isa('DBIx::QuickORM::Connection::Transaction'), "txn() with no action returns a live txn object");
        is($txn->state, 'active', "long-lived txn starts active");
        $con->handle('items')->insert({name => 'abandoned'});
        # $txn falls out of scope here while still active.
        $txn = undef;
    };

    ok(!$con->in_txn, "connection no longer in a txn after abandoned txn destroyed");
    is(disk_names(), $before, "abandoned active txn was rolled back on DESTROY");

    # DESTROY-driven rollback is a documented safety net and surfaces a
    # diagnostic noting that the transaction fell out of scope.
    ok(
        (grep { $_ =~ /fell out of scope/i } @$warns),
        "DESTROY rollback warns that the dropped txn fell out of scope",
    ) or diag(explain($warns));
};

subtest auto_retry_returns_value => sub {
    my $calls = 0;
    my $out   = $con->auto_retry(sub { $calls++; return 'the-result' });
    is($out, 'the-result', "auto_retry returns the callback result on success");
    is($calls, 1, "auto_retry ran the callback once on immediate success");
};

subtest auto_retry_in_txn_croaks => sub {
    my $err = dies {
        $con->txn(sub {
            $con->auto_retry(sub { 1 });
        });
    };
    like($err, qr/Cannot use auto_retry inside a transaction/, "auto_retry croaks inside an open txn");
};

subtest auto_retry_txn_persists => sub {
    my $before = disk_names();
    my $txn    = $con->auto_retry_txn(sub {
        $con->handle('items')->insert({name => 'via_retry'});