view release on metacpan or  search on metacpan

worktrees/audit-fixes-master/lib/DBIx/QuickORM/Connection/Transaction.pm  view on Meta::CPAN

=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 }

=pod

=item $txn->init

Object construction hook invoked by L<Object::HashBase>. Validates the id and
normalizes the callback queues. Not called directly.

=cut

sub init {
    my $self = shift;

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

    # Hold the connection weakly. The connection holds its transactions weakly in
    # turn, so this back-reference does not create a strong cycle; weakening it
    # keeps a transaction from pinning its connection alive and from dragging the
    # whole connection into a dump or deep comparison of the txn.
    weaken($self->{+CONNECTION}) if $self->{+CONNECTION};

    $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});
}

=pod

=item $bool = $txn->complete

True once a result has been recorded.

=cut

sub complete { defined $_[0]->{+RESULT} }

=pod

=item $str = $txn->state

Returns C<active> while the transaction is open, then C<committed> or
C<rolled_back> once it finishes. Derived from C<result>.

=item $bool = $txn->committed

True if the transaction committed, false if it rolled back, undef while still
open. Derived from C<result>.

=item $bool = $txn->rolled_back

The inverse of C<committed>: true if it rolled back, false if it committed,
undef while still open.

=item $bool = $txn->aborted

True if an explicit C<rollback> was requested on this transaction.

=cut

sub committed {
    my $r = $_[0]->{+RESULT};
    return undef unless defined $r;
    return $r ? 1 : 0;
}

sub rolled_back {
    my $r = $_[0]->{+RESULT};
    return undef unless defined $r;
    return $r ? 0 : 1;
}

# True if an explicit rollback was requested (drives the commit/rollback
# decision in Connection::txn before the result is recorded).
sub aborted { $_[0]->{+ABORTED} ? 1 : 0 }

sub _assert_innermost {
    my $self = shift;
    my ($op) = @_;

    # last QORM_TRANSACTION unwinds to the innermost dynamically-enclosing
    # transaction callback, which is not necessarily this transaction's. When a
    # nested (callback-managed) transaction is open, committing or rolling back
    # an outer transaction object would resolve the wrong (inner) one, so refuse.
    #
    # The connection is held weakly (the connection already holds its
    # transactions weakly, so this just avoids following the back-ref in a dump
    # or deep comparison). By the time commit()/rollback() reach this point we
    # are running inside the transaction's own action, so the connection is
    # alive and it always has a current transaction (at least this one) --
    # neither being missing is a normal case, so croak rather than skip the
    # check silently.
    my $con = $self->{+CONNECTION}
        or croak "Cannot $op a transaction whose connection is gone";
    my $current = $con->current_txn
        or croak "Cannot $op: the connection reports no current transaction";
    return if $current == $self;

    croak "Cannot $op an outer transaction from within a nested transaction; resolve the innermost transaction first";
}

sub state {
    my $self = shift;
    my $r = $self->{+RESULT};
    return 'active' unless defined $r;
    return $r ? 'committed' : 'rolled_back';
}

=pod

=item $txn->rollback

=item $txn->rollback($why)

=item $txn->abort

=item $txn->abort($why)

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

=cut

{
    no warnings 'once';
    *abort = \&rollback;
}
sub rollback {
    my $self = shift;
    my ($why) = @_;

    croak "Transaction is already complete" if $self->complete;

    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' rolled back in $trace" . ($why ? " ($why)" : ".") . "\n";
        }

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