view release on metacpan or  search on metacpan

lib/DBIx/QuickORM/Connection/Transaction.pm  view on Meta::CPAN

package DBIx::QuickORM::Connection::Transaction;
use strict;
use warnings;

our $VERSION = '0.000022';

use Carp qw/croak confess/;

use Object::HashBase qw{
    <id
    +savepoint

    +on_success
    +on_fail
    +on_completion

    verbose

    <result
    <errors
    <trace

    exception
    +aborted

    <in_destroy
    +finalize

    no_last
};

=pod

=encoding UTF-8

=head1 NAME

DBIx::QuickORM::Connection::Transaction - One transaction or savepoint on a
DBIx::QuickORM connection.

=head1 DESCRIPTION

Represents a single transaction (or savepoint) and the callbacks queued
against it. C<commit> and C<rollback> record the outcome and break out of the
enclosing C<QORM_TRANSACTION> loop; C<terminate> records the final result and
fires the queued success / fail / completion callbacks. An optional finalize
callback runs when the transaction completes or, as a safety net, when the
object is destroyed while still pending.

=head1 SYNOPSIS

    QORM_TRANSACTION: {
        my $txn = DBIx::QuickORM::Connection::Transaction->new(id => $id);
        $txn->add_success_callback(sub { ... });
        ...
        $txn->commit;
    }

=head1 ATTRIBUTES

=over 4

=item id

The transaction identifier (required).

=item savepoint

True when this represents a savepoint rather than a top-level transaction.

=item on_success

=item on_fail

=item on_completion

Callback queues (arrayrefs, or a single coderef normalized to one) fired by
C<terminate>. Success or fail callbacks run depending on the outcome,
followed by completion callbacks in both cases.

=item verbose

When true, C<commit> / C<rollback> warn a trace line. A string longer than
one character is used as the transaction name in that warning.

=item result

Undef while open; 1 on success, 0 on failure once terminated.

=item errors

The error(s) captured on failure.

=item trace

Arrayref describing where the transaction was started, used in C<throw>.

=item exception

The exception that forced the transaction to roll back, if any. Set when the
transaction's body threw (or the transaction fell out of scope); undef for a
normal commit or an explicit C<rollback>.

=item in_destroy

True while finalize runs from C<DESTROY>.

=item finalize

The finalize callback, if set.

=item no_last

When true, C<commit> / C<rollback> skip the C<last QORM_TRANSACTION> jump.

=back

=head1 PUBLIC METHODS

=over 4

=item $bool = $txn->is_savepoint

True when this is a savepoint.

=cut

sub is_savepoint { $_[0]->{+SAVEPOINT} ? 1 : 0 }

sub init {
    my $self = shift;

    croak "A transaction ID is required" unless $self->{+ID};

    $self->{+RESULT} = undef;

    $self->{+ON_SUCCESS}    = [$self->{+ON_SUCCESS}]    if 'CODE' eq ref($self->{+ON_SUCCESS});
    $self->{+ON_FAIL}       = [$self->{+ON_FAIL}]       if 'CODE' eq ref($self->{+ON_FAIL});
    $self->{+ON_COMPLETION} = [$self->{+ON_COMPLETION}] if 'CODE' eq ref($self->{+ON_COMPLETION});

lib/DBIx/QuickORM/Connection/Transaction.pm  view on Meta::CPAN

        else {
            $why = $trace;
        }
    }

    $self->{+ABORTED} = 1;

    $self->finalize(1, $why) if $self->{+FINALIZE};

    return if $self->{+NO_LAST};

    no warnings 'exiting';
    last QORM_TRANSACTION;
}

=pod

=item $txn->commit

=item $txn->commit($why)

Records the commit (optionally with a reason), runs finalize when set, and
breaks out of the enclosing C<QORM_TRANSACTION> loop unless C<no_last> is set.

=cut

sub commit {
    my $self = shift;
    my ($why) = @_;

    if ($self->{+VERBOSE} || !$why) {
        my @caller = caller;
        my $trace = "$caller[1] line $caller[2]";

        if (my $verbose = $self->{+VERBOSE}) {
            my $name = length($verbose) > 1 ? $verbose : $self->{+ID};
            warn "Transaction '$name' committed in $trace" . ($why ? " ($why)" : ".") . "\n";
        }

        if ($why) {
            $why .= " in $trace" unless $why =~ m/\n$/;
        }
        else {
            $why = $trace;
        }
    }

    $self->finalize(1) if $self->{+FINALIZE};

    return if $self->{+NO_LAST};

    no warnings 'exiting';
    last QORM_TRANSACTION;
}

=pod

=item ($ok, $errors) = $txn->terminate($res, $err)

Records the final result, clears the callback queues and savepoint, then runs
the success-or-fail callbacks followed by the completion callbacks. Returns a
list: a boolean for whether all callbacks succeeded, and an arrayref of any
callback errors (undef when none).

=cut

sub terminate {
    my $self = shift;
    my ($res, $err) = @_;

    $self->{+RESULT} = $res ? 1 : 0;
    $self->{+ERRORS} = $res ? undef : $err;

    my $todo = $res ? $self->{+ON_SUCCESS} : $self->{+ON_FAIL};
    $todo = [@{$todo // []}, @{$self->{+ON_COMPLETION} // []}];

    delete $self->{+ON_SUCCESS};
    delete $self->{+ON_FAIL};
    delete $self->{+ON_COMPLETION};
    delete $self->{+SAVEPOINT};

    return (1, undef) unless $todo && @$todo;

    my ($out, $out_err) = (1, undef);
    for my $cb (@$todo) {
        local $@;
        eval { $cb->($self); 1 } and next;
        push @{$out_err //= []} => $@;
        $out = 0;
    }

    return ($out, $out_err);
}

=pod

=item $txn->add_success_callback($cb)

=item $txn->add_fail_callback($cb)

=item $txn->add_completion_callback($cb)

Queue a callback to run from C<terminate> on success, on failure, or in both
cases respectively.

=cut

sub add_success_callback {
    my $self = shift;
    my ($cb) = @_;
    push @{$self->{+ON_SUCCESS} //= []} => $cb;
}

sub add_fail_callback {
    my $self = shift;
    my ($cb) = @_;
    push @{$self->{+ON_FAIL} //= []} => $cb;
}

sub add_completion_callback {
    my $self = shift;
    my ($cb) = @_;