package DBIx::Fast::Transaction;

use v5.38;
use Object::Pad;
use Time::HiRes 'time';

use constant {
	      DELAY   => 1,
	      RETRIES => 3,
	      SLOW    => 5
	     };

my %VALID_ISOLATION = map { $_ => 1 } (
    'READ UNCOMMITTED',
    'READ COMMITTED',
    'REPEATABLE READ',
    'SERIALIZABLE',
);

class DBIx::Fast::Transaction :isa(DBIx::Fast::Base) {
  field $level      :accessor = 0;
  field $savepoints :accessor = {};
  field $_sp_seq              = 0;   # monotonic savepoint sequence
  field $start_time :accessor = undef;
  field $stats      :accessor = {
				 avg_duration   => 0,
				 deadlock_count => 0,
				 error_count    => 0,
				 success_count  => 0,
				 total_count    => 0,
				 total_duration => 0,
				 max_duration   => 0
				};

  method do ($code, $options = {}) {
    $self->dbix->Exception("Transaction code block required")
      unless ref $code eq 'CODE';

    # Nested call: we are already inside a transaction owned by an outer do().
    # Run the code within that transaction and let the outermost do() own
    # begin/commit/rollback, retries and stats. Errors propagate to the outer
    # handler (which performs the single rollback). Retry and isolation options
    # only take effect at the outermost level.
    if ($level > 0) {
      $level++;
      my $nested = eval { $code->() };
      if (my $error = $@) {
        $level--;
        die $error;
      }
      $level--;
      return $nested;
    }

    my $max_retries = $options->{max_retries} // RETRIES;
    my $retry_delay = $options->{retry_delay} // DELAY;
    my $isolation   = $options->{isolation};

    if (defined $isolation) {
      my $norm = uc $isolation;
      $norm =~ s/\s+/ /g;
      $norm =~ s/^\s+|\s+$//g;
      $self->dbix->Exception(
          "DBIx::Fast::Transaction - Invalid isolation level: $isolation")
        unless $VALID_ISOLATION{$norm};
      $isolation = $norm;
    }

    $stats->{total_count}++;

    # Isolation is applied once via SET SESSION (it persists for the whole
    # connection), so it survives across retries; restore the baseline once on
    # exit.
    my $iso_baseline = defined $isolation
      ? $self->_apply_isolation($isolation)
      : undef;

    my $result;
    my $retries = 0;

    while (1) {
      $start_time = time();

      my $ok = eval {
        $self->_begin_work;        # level == 0 at the outermost
        $level   = 1;
        $result  = $code->();
        $self->_commit;
        $level      = 0;
        # Drop this transaction's savepoints on success too (the failure path
        # already does): a name left behind would let a later rollback_to()
        # pass the exists() guard and fire a ROLLBACK TO on a savepoint the
        # server no longer has, aborting the new transaction.
        $savepoints = {};
        1;
      };

      if ($ok) {
        $self->_update_stats(1);
        last;
      }

      my $error = $@;

      # Determine retryability from the live handle BEFORE rolling back, since
      # the rollback itself resets $dbh->err. Also note whether the driver
      # reported this failure: if so, HandleError already recorded it in the
      # errors buffer and the generic "Transaction failed" entry would be a
      # duplicate of the same event.
      my $retryable    = $self->_is_retryable($error);
      my $db_reported  = do {
        my $dbh = eval { $self->dbix->db->dbh };
        $dbh && defined $dbh->err;
      };

      # Unwind to a clean outermost state: roll back whatever is open, reset the
      # nesting level and drop savepoints so the next attempt (or the caller)
      # starts from scratch.
      eval { $self->_rollback() } if $level > 0;
      $level      = 0;
      $savepoints = {};

      if ($retryable) {
        $stats->{deadlock_count}++;
        if ($retries < $max_retries) {
          $retries++;
          sleep($retry_delay) if $retry_delay;
          next;
        }
      }

      $self->_update_stats(0);
      $self->_restore_isolation($iso_baseline) if defined $iso_baseline;
      $self->dbix->set_error(500, "Transaction failed: $error")
        unless $db_reported;
      die $error;
    }

    $self->_restore_isolation($iso_baseline) if defined $iso_baseline;
    return $result;
  }

  # A transaction is retryable when the failure is a deadlock or lock-wait
  # timeout. Prefer the driver error code (read from the live handle before any
  # rollback); fall back to a free-text match so drivers without codes and the
  # documented "deadlock" convention still trigger a retry.
  method _is_retryable ($error) {
    my $dbh = eval { $self->dbix->db->dbh };
    my ($err, $state) = ('', '');
    if ($dbh) {
      $err   = $dbh->err   // '';
      $state = $dbh->state // '';
      # MySQL/MariaDB: 1213 deadlock, 1205 lock wait timeout.
      return 1 if $err eq '1213' || $err eq '1205';
      # PostgreSQL SQLSTATE: 40P01 deadlock_detected, 40001 serialization_failure.
      return 1 if $state eq '40P01' || $state eq '40001';
    }
    # The driver reported a (non-retryable) error code: do NOT fall through to
    # the free-text match. Driver messages echo user data ("Duplicate entry
    # 'deadlock' for key ..."), which must not be able to force a retry loop.
    # err 0 is DBI's "success with info" and S1000 its generic no-detail
    # SQLSTATE; treat both as "no code".
    return 0 if ($err ne '' && $err ne '0')
             || ($state ne '' && $state ne 'S1000');
    # No driver code at all: keep the documented convention that user code can
    # die('deadlock ...') to request a retry.
    return 1
      if $error =~ /deadlock|lock wait timeout|try restarting transaction/i;
    return 0;
  }
  
  method _begin_work () {
    eval {
      $self->dbix->db->dbh->begin_work;
    };

    if ($@) {
      $self->dbix->set_error( 500,
			      "Could not begin transaction: $@" );
      die $@;
    }
  }

  # Apply isolation level for the duration of one transaction.
  # Returns the baseline level (driver-specific opaque string) so the caller
  # can restore it after the transaction ends. Driver behavior:
  # - MariaDB/mysql: SET SESSION (DBD::MariaDB does not honor SET TRANSACTION
  #   before begin_work). Caller MUST restore baseline.
  # - Pg: SET SESSION (consistent semantics).
  # - SQLite: no-op (SQLite is effectively SERIALIZABLE always).
  method _apply_isolation ($level_name) {
    return undef unless defined $level_name;
    return undef unless $VALID_ISOLATION{$level_name};

    my $driver = $self->dbix->dbd;
    return undef if $driver eq 'SQLite';

    my $dbh = $self->dbix->db->dbh;
    my $baseline;
    eval {
      if ($driver eq 'MariaDB' || $driver eq 'mysql') {
        ($baseline) = $dbh->selectrow_array('SELECT @@transaction_isolation');
        # MariaDB reports as REPEATABLE-READ etc, normalize for SET syntax
        $baseline =~ s/-/ /g if defined $baseline;
      } elsif ($driver eq 'Pg') {
        ($baseline) = $dbh->selectrow_array('SHOW default_transaction_isolation');
      }
      $dbh->do($self->_isolation_set_sql($level_name));
    };
    if ($@) {
      $self->dbix->set_error(500, "Could not set isolation level: $@");
      die $@;
    }
    return $baseline;
  }

  # The driver-specific SQL to set the session isolation level. $level is always
  # a whitelist-validated value (see %VALID_ISOLATION), so interpolation is safe.
  # Pg's session form is "SET SESSION CHARACTERISTICS AS TRANSACTION ..."; plain
  # "SET SESSION TRANSACTION ISOLATION LEVEL" is a no-op (warning only) on Pg.
  method _isolation_set_sql ($level) {
    return $self->dbix->dbd eq 'Pg'
      ? "SET SESSION CHARACTERISTICS AS TRANSACTION ISOLATION LEVEL $level"
      : "SET SESSION TRANSACTION ISOLATION LEVEL $level";
  }

  method _restore_isolation ($baseline) {
    return unless defined $baseline;
    return unless $VALID_ISOLATION{ uc $baseline };

    my $driver = $self->dbix->dbd;
    return if $driver eq 'SQLite';

    eval {
      $self->dbix->db->dbh->do($self->_isolation_set_sql($baseline));
    };
    # Restoration failure is non-fatal, but fail closed: drop the connection so
    # the next dbh() call reconnects with default session state. Otherwise every
    # later query on this handle would silently run at the transaction's
    # isolation level (e.g. READ UNCOMMITTED) for the life of the worker.
    if ($@) {
      $self->dbix->set_error(500, "Could not restore isolation level: $@");
      eval { $self->dbix->db->disconnect };
    }
  }
  
  method _commit () {
    eval {
      $self->dbix->db->dbh->commit;
    };
    if ($@) {
      $self->dbix->set_error( 500,
			      "Could not commit transaction: $@" );
      die $@;
    }
  }
  
  method _rollback () {
    eval {
      $self->dbix->db->dbh->rollback;
    };
    
    if ($@) {
      $self->dbix->set_error( 500,
			      "Could not rollback transaction: $@" );
      die $@;
    }
  }
  
  method savepoint ($name) {
    $self->dbix->Exception(
			   "DBIx::Fast::Transaction - Savepoint name required")
      unless $name;
    $self->dbix->Exception(
			   "DBIx::Fast::Transaction - Invalid savepoint name: $name")
      unless $name =~ /^[a-zA-Z_][a-zA-Z0-9_]*$/;

    unless ($level > 0) {
      $self->dbix->set_error(500,
          "savepoint('$name') requires an active transaction");
      return;
    }

    $savepoints->{$name} = {
			    level => $level,
			    seq   => ++$_sp_seq,
			    time  => time()
			   };
    
    my $qname = $self->dbix->db->dbh->quote_identifier($name);
    eval {
      $self->dbix->exec("SAVEPOINT $qname");
    };
    if ($@) {
      delete $savepoints->{$name};
      $self->dbix->set_error( 500,
			      "Could not create savepoint: $@" );
      die $@;
    }
    
    return 1;
  }
  
  method rollback_to ($name) {
    $self->dbix->Exception(
			   "DBIx::Fast::Transaction - Savepoint name required")
      unless $name;
    $self->dbix->Exception(
			   "DBIx::Fast::Transaction - Invalid savepoint name: $name")
      unless $name =~ /^[a-zA-Z_][a-zA-Z0-9_]*$/;
    
    unless ( exists $savepoints->{$name} ) {
      $self->dbix->set_error( 500,
			      "Savepoint '$name' does not exist" );
      return;
    }
    
    my $qname = $self->dbix->db->dbh->quote_identifier($name);
    eval {
      $self->dbix->exec("ROLLBACK TO SAVEPOINT $qname");
    };
    
    if ($@) {
      $self->dbix->set_error( 500,
			      "Could not rollback to savepoint: $@" );
      die $@;
    }
    
    # Drop every savepoint created after the target (higher sequence),
    # including same-level siblings, which the DB rolled back too.
    my $target_seq = $savepoints->{$name}->{seq};
    for my $sp ( keys %{$savepoints} ) {
      delete $savepoints->{$sp}
	if $savepoints->{$sp}->{seq} > $target_seq;
    }
    
    return 1;
  }
  
  method _update_stats ($success) {
    my $duration = time() - $start_time;
    
    if ($success) {
      $stats->{success_count}++;
    }
    else {
      $stats->{error_count}++;
    }
    
    $stats->{total_duration} += $duration;
    $stats->{max_duration} = $duration
      
      if $duration > $stats->{max_duration};
    $stats->{avg_duration} = $stats->{total_duration} / $stats->{total_count};
    
    if ( $duration > SLOW ) {
      warn sprintf(
		   "Slow transaction detected: %.2fs (threshold: %ds)",
		   $duration, SLOW );
    }
  }
  
  method get_stats () { return $stats }
  
  method reset_stats () {
    $stats = {
	      total_count    => 0,
	      success_count  => 0,
	      error_count    => 0,
	      deadlock_count => 0,
	      total_duration => 0,
	      max_duration   => 0,
	      avg_duration   => 0
	     };
  }
}

1;

__END__

=head1 NAME

DBIx::Fast::Transaction - Transaction management for DBIx::Fast

=head1 DESCRIPTION

Manages database transactions with support for nested transactions, savepoints,
automatic deadlock retry, and performance statistics tracking. Transactions that
exceed the slow threshold (5 seconds) emit a warning.

=head1 METHODS

=head2 do

    my $result = $tx->do(sub { ... }, \%options);

Executes a code block inside a transaction. Supports nested calls, automatic
commit/rollback, and deadlock retry. Options: C<max_retries> (default 3),
C<retry_delay> (default 1 second).

=head2 savepoint

    $tx->savepoint('my_savepoint');

Creates a named savepoint within an active transaction.

=head2 rollback_to

    $tx->rollback_to('my_savepoint');

Rolls back to the named savepoint and removes any savepoints created after it.

=head2 get_stats

    my $stats = $tx->get_stats();

Returns a hashref with transaction statistics: total_count, success_count,
error_count, deadlock_count, total_duration, max_duration, and avg_duration.

=head2 reset_stats

Resets all transaction statistics counters to zero.

=head1 AUTHOR

SeHarrys

=head1 LICENSE

This is free software under the Artistic License 2.0.

=cut
