view release on metacpan or  search on metacpan

lib/UR/Context/Transaction.pm  view on Meta::CPAN

    # TODO: limit to objects that changed within transaction as to not duplicate
    # error checking unnecessarily.

    my @changed_objects =
        grep { ! $_->isa('UR::DeletedRef') }
        map  { $_->changed_object() } $self->get_changes();

    # This is primarily to catch custom validity logic in class overrides.
    my @invalid = grep { $_->__errors__ } @changed_objects;
    if (@invalid) {
        $self->display_invalid_data_for_save(\@invalid);
        return;
    }

    return 1;
}

sub eval_or_do {
    my $is_failure = shift;
    my $block = shift;

    my $class = __PACKAGE__;
    if (@_) {
        confess('%s::eval takes one argument', $class);
    }
    my $tx = $class->begin();
    my $result = CORE::eval { $block->() };
    my $eval_error = $@;

    if ($is_failure->($result, $eval_error)) {
        $class->debug_message(shortmess('Rolling back transaction'));
        $class->debug_message($eval_error) if ($eval_error);
        unless($tx->rollback()) {
            Carp::croak 'failed to rollback transaction';
        }
    } else {
        unless($tx->commit()) {
            Carp::croak 'failed to commit transaction';
        }
    }

    if (wantarray) {
        return ($result, $eval_error);
    } else {
        return $result;
    }
}

# eval function takes a block (&) sort of like CORE::eval
# eval will rollback on a caught die
sub eval(&) {
    my $is_failure = sub {
        my ($result, $eval_error) = @_;
        return $eval_error;
    };
    return eval_or_do($is_failure, @_);
}

# do function takes a block (&) sort of like CORE::do
# do will rollback on a false result as well as before re-throwing a caught die
sub do(&) {
    my $is_failure = sub {
        my ($result, $eval_error) = @_;
        return !$result || $eval_error;
    };
    my ($result, $eval_error) = eval_or_do($is_failure, @_);
    if ($eval_error) {
        croak $eval_error, "\t...propogated";
    }
    return $result;
}

1;

=pod

=head1 NAME

UR::Context::Transaction - API for software transactions

=head1 SYNOPSIS

  my $o = Some::Obj->create(foo => 1);
  print "o's foo is ",$o->foo,"\n";  # prints 1

  my $t = UR::Context::Transaction->begin();

  $o->foo(4);

  print "In transaction, o's foo is ",$o->foo,"\n";  # prints 4

  if (&should_we_commit()) {
      $t->commit();
      print "Transaction committed, o's foo is ",$o->foo,"\n";  # prints 4

  } else {
      $t->rollback();
      print "Transaction rollback, o's foo is ",$o->foo,"\n";  # prints 1
  }

=head1 DESCRIPTION

UR::Context::Transaction instances represent in-memory transactions as a diff
of the contents of the object cache in the Process context.  Transactions are
nestable.  Their instances exist in the object cache and  are subject to the
same scoping rules as other UR-based objects, meaning that they do not
disappear mearly because the lexical variable they're assigned to goes out of
scope.  They must be explicitly disposed of via the commit or rollback methods.

=head1 INHERITANCE

UR::Context::Transaction is a subclass of UR::Context

=head1 CONSTRUCTOR

=over 4

=item begin

  $t = UR::Context::Transaction->begin();