#!perl;

package DBIx::Transaction::db;

use DBI;
use base q(DBI::db);
use strict;
use warnings (FATAL => 'all');
use Carp qw(confess);

return 1;

sub transaction_trace {
    my($self, $method) = @_;
    my @vals = map { "$_=$self->{$_}" } map { "private_DBIx_Transaction_$_" }
        qw(AutoCommit Level Error);

    $self->trace_msg("DBIx::Transaction: $method: " . join(" ", @vals), 3);
}

sub transaction_level {
    my $self = shift;
    return $self->{private_DBIx_Transaction_Level};
}

sub inc_transaction_level {
    my $self = shift;
    $self->{private_DBIx_Transaction_Level}++;
    return $self->{private_DBIx_Transaction_Level};
}

sub dec_transaction_level {
    my $self = shift;
    confess "Asked to decrement transaction level below zero!"
        unless($self->{private_DBIx_Transaction_Level});
    $self->{private_DBIx_Transaction_Level}--;
    return $self->{private_DBIx_Transaction_Level};
}

sub clear_transaction_error {
    my $self = shift;
    $self->{private_DBIx_Transaction_Error} = 0;
    $self->{private_DBIx_Transaction_Error_Caller} = undef;
    return;    
}

sub inc_transaction_error {
    my($self, @caller) = @_;
    $self->{private_DBIx_Transaction_Error}++;
    if(@caller) {
        $self->{private_DBIx_Transaction_Error_Caller} ||= [];
        push(@{$self->{private_DBIx_Transaction_Error_Caller}}, \@caller);
    }
    return;
}

sub transaction_error {
    my $self = shift;
    return $self->{private_DBIx_Transaction_Error};
}

sub transaction_error_callers {
    my $self = shift;
    if($self->{private_DBIx_Transaction_Error_Caller}) {
        return @{$self->{private_DBIx_Transaction_Error_Caller}};
    } else {
        return;
    }
}

sub close_transaction {
    my $self = shift;
    my $method = shift;
    my $code = DBI::db->can($method);

    $self->{private_DBIx_Transaction_Level} = 0;
    $self->clear_transaction_error;
    $self->transaction_trace($method);
    my $rv = $code->($self, @_);
    return $rv;
}

sub begin_work {
    my $self = shift;
    if(!$self->transaction_level) {
        $self->inc_transaction_level;
        if($self->{private_DBIx_Transaction_AutoCommit}) {
            $self->transaction_trace('begin_work');
            return DBI::db::begin_work($self, @_);
        } else {
            return 1;
        }
    } else {
        $self->inc_transaction_level;
        $self->transaction_trace('begin_work');
        return 1;
    }
}

sub commit {
    my $self = shift;
    if(my $error = $self->transaction_error) {
        my $err = "commit() called after a transaction error or rollback!";
        if(my @callers = $self->transaction_error_callers) {
            foreach my $i (@callers) {
                $err .= "\nError or rollback at: $i->[1] line $i->[2]";
            }
        }
            
        confess $err;
    }

    if(my $l = $self->dec_transaction_level) {
        $self->transaction_trace('fake_commit');
        return 1;
    }
    return $self->close_transaction('commit', @_);
}

sub rollback {
    my $self = shift;
    if(my $l = $self->dec_transaction_level) {
        $self->transaction_trace('fake_rollback');
        $self->inc_transaction_error(caller);
        return 1;
    }
    return $self->close_transaction('rollback', @_);
}

sub do {
    my $self = shift;
    my $rv = eval { DBI::db::do($self, @_); };
    if($@) {
        $self->inc_transaction_error(caller);
        die "$@\n";
    }
    if(!$rv) {
        $self->inc_transaction_error(caller);
    }
    return $rv;
}

sub transaction {
    my($self, $run) = @_;
    my $rv;

    $self->begin_work;

    eval { $rv = $run->(); };

    if($@) {
        $self->rollback;
        die $@;
    } elsif(!$rv) {
        $self->rollback;
    } else {
        $self->commit;
    }

    return $rv;    
}

=pod

=head1 NAME

DBIx::Transaction::db - Database handle that is aware of nested transactions

=head1 SYNOPSIS

See L<DBIx::Transaction>

=head1 DESCRIPTION

When you connect to a database using DBIx::Transaction, your database handle
will be a DBIx::Transaction::db object. These objects keep track of your
transaction state, allowing for transactions to occur within transactions,
and only sending "C<commit>" or "C<rollback>" instructions to the underlying
database when the outermost transaction has completed. See L<DBIx::Transaction>
for a more complete explanation.

=head1 METHODS

=head2 Overridden Methods

The following methods are overridden by DBIx::Transaction::db:

=over

=item begin_work

Start a transaction.

If there are no transactions currently running, C<begin_work> will check
if C<AutoCommit> is enabled. If it is enabled, a C<begin_work> instruction
is sent to the underlying database layer. If C<AutoCommit> is disabled, we
assume that the database has already started a transaction for us, and do
nothing. This means that B<you must always use begin_work to start a
transaction>, even if C<AutoCommit> is enabled!

If there is a transaction started, C<begin_work> simply records that a nested
transaction has started.

C<begin_work> returns the result of the database's C<begin_work> call if it
makes one; otherwise it always returns true.

=item rollback

Abort a transaction.

If there are no sub-transactions currently running, C<rollback> will issue the
C<rollback> call to the underlying database layer.

If there are sub-transactions currently running, C<rollback> notes that the
nested transaction has been aborted.

If there is no transaction running at all, C<rollback> will raise a fatal
error.

=item commit

If there are sub-transactions currently running, C<commit> records that this
transaction has completed successfully and does nothing to the underlying
database layer.

If there are no sub-transactions currently running, C<commit> checks if
there have been any transaction errors. If there has been a transaction
error, C<commit> raises an exception. Otherwise, a C<commit> call is
issued to the underlying database layer.

If there is no transaction running at all, C<commit> will raise a fatal
error. This error will contain a full stack trace, and should also contain
the file names and line numbers where any rollbacks or query failures
happened.

=item do

Calls L<do()|DBI/do> on your underlying database handle. If an error
occurs, this is recorded and you will not be able to issue a C<commit>
for the current transaction.

=back

=head2 Extra Methods

The following method is provided for convienence in setting up database
transactions:

=over

=item transaction($coderef)

Execute the code contained inside C<$coderef> within a transaction.
C<$coderef> is expected to return a scalar value.
If C<$coderef> returns true, the transaction is committed. If
C<$coderef> returns false or raises a fatal error, the transaction
is rolled back. The return value is the same as what is returned by
C<$coderef>.

This method is supplied to make it easier to create nested transactions
out of many small transactions. Example:

  sub get_max_id {
    my $dbh = shift;
    # this will roll back if it can't get MAX(num)
    $dbh->transaction(sub {
      if(my($id) = $dbh->selectrow_array("SELECT MAX(num) FROM foo")) {
        return $id;
      } else {
        return;
      }
    });
  }
  
  sub do_something {
    my($dbh, $num) = @_;
    $dbh->transaction(sub {
      $dbh->do("UPDATE foo SET bar = bar + 1 WHERE num = $num");
    });
  }
  
  sub do_many_things {
    my $dbh = shift;
    # if any of these sub-transactions roll back, the whole thing will roll
    # back
    $dbh->transaction(sub {
      if(
        do_something($dbh, 1) &&
        do_something($dbh, 2) &&
        (my $id = get_max_id($dbh))
      ) {
        return do_something($dbh, $id);
      } else {
        return;
      }
    });
  }

=back

=head2 Other Methods

The following methods are used by the overridden methods. In most cases
you won't have to use them yourself.

=over

=item transaction_level

Returns an integer value representing how deeply nested our transactions
currently are. eg; if we are in a top-level transaction, this returns "1";
if we are 4 transactions deep, this returns "4", if we are not in a transaction
at all, this returns "0". In some extreme cases this may be used to bail out
of a nested transaction safely, as in:

  $dbh->rollback while $dbh->transaction_level;

But I would suggest that you structure your code so that each transaction
and sub-transaction bails out safely instead, as that's a lot easier to
trace and debug with confidence.

=item transaction_error

Returns a true value if a sub-transaction has rolled back, false otherwise.
Again, you could use this to back out of a transaction safely, but I'd suggest
just writing your code to handle this case on each transaction level instead.

=item transaction_trace

For debugging; If DBI's trace level is 3 or over, emit the current values
of all of the internal variables DBIx::Transaction uses to track it's
transaction states.

=item inc_transaction_level

Indicate that we have started a sub transaction by increasing
C<transaction_level> by one. This is used by the C<begin_work> override
and should not be called directly.

=item dec_transaction_level

Indicate that we have finished a sub transaction by decrementing
C<transaction_level> by one. If this results in a negative number
(meaning more transactions have been commited/rolled back than started),
C<dec_transaction_level> throws a fatal error. This is used by the
C<commit> and C<rollback> methods and should not be called directly.

=item inc_transaction_error

Indicate that a sub-transaction has failed and that the entire
transaction should not be allowed to be committed. This is done
automatically whenever a sub-transaction issues a C<rollback>.
Optional parameters are the package, filename, and line where
the transaction error occured. If provided, they will be used in
error messages relating to the rollback.

=item clear_transaction_error

Clear the transaction error flag. This flag is set whenever a
sub-transaction issues a C<rollback>, and cleared whenever the
outermost transaction issues a C<rollback>.

=item close_transaction($method)

Close the outermost transaction by calling C<$method>
("C<commit>" or "C<rollback>") on the underlying database layer and
resetting the DBIx::Transaction state. This method is used by the
C<commit> and C<rollback> methods and you shouldn't need to use it yourself,
unless you wanted to forcibly bail out of an entire transaction without
calling C<rollback> repeatedly, but as stated above, that's a bad idea,
isn't it?

=back

=head1 SEE ALSO

L<DBI>, L<DBIx::Transaction>

=head1 AUTHOR

Tyler "Crackerjack" MacDonald <japh@crackerjack.net>

=head1 LICENSE

Copyright 2005 Tyler MacDonald
This is free software; you may redistribute it under the same terms as perl itself.

=cut
