view release on metacpan or  search on metacpan

lib/DBIx/Poggy/DBI.pm  view on Meta::CPAN

=head4 commit

Takes resolution value of the transaction, commits and resolves the promise returned
by L</begin_work> with the value.

Dies if you call commit without transaction or while queries are active.

=cut

sub commit {
    my $self = shift;
    my $state = $self->{private_poggy_state};
    die "Can not commit when you have active queries"
        if $state->{active} || @{$state->{queue}};
    my $d = delete $state->{txn} or die "No transaction in progress";
    my $rv = $self->SUPER::commit();
    unless ( $rv ) {
        $d->reject($self->errobj);
        return $rv;
    }
    $d->resolve(@_);
    return $rv;
}

=head4 rollback

Takes rollback value of the transaction, commits and rejects the promise returned
by L</begin_work> with the value.

Dies if you call rollback without transaction or while queries are active.

=cut

sub rollback {
    my $self = shift;
    my $state = $self->{private_poggy_state};
    die "Can not commit when you have active queries"
        if $state->{active} || @{$state->{queue}};
    my $d = delete $state->{txn} or die "No transaction in progress";
    my $rv = $self->SUPER::rollback();
    unless ( $rv ) {
        $d->reject($self->errobj);
        return $rv;
    }
    $d->reject(@_);
    return $rv;
}

sub errobj {
    my $self = shift;
    return DBIx::Poggy::Error->new( $self );
}

my $orig;
BEGIN { $orig = __PACKAGE__->can('DESTROY') }
sub DESTROY {
    my $self = shift;
    unless (in_global_destruction) {
        # ressurect DBH, bu pushing it back into the pool
        # I know it's hackish, but I couldn't find good way to implement
        # auto release that works transparently
        my $state = $self->{private_poggy_state} || {};
        if ( $state->{release_to} ) {
            $self->SUPER::rollback() if delete $state->{txn};
            return $state->{release_to}->release($self);
        }
    }
    return $orig->($self, @_) if $orig;
    return;
}

package DBIx::Poggy::DBI::st;
use base 'DBI::st';

sub errobj {
    my $self = shift;
    return DBIx::Poggy::Error->new( $self );
}

1;