use strict;
use warnings;
use Test::More;
use DBIx::Fast;

# Tests for the low/info follow-up fixes:
#  - rank 22: errors_redact also scrubs backtick-quoted identifiers.
#  - rank 37: get_indexs emits a one-time deprecation warning.
#  - rank 29: savepoint() outside a transaction records an error (no silent no-op).
#  - rank 36: now_utc() returns a UTC timestamp.

eval "use DBD::SQLite 1.74";
plan skip_all => "DBD::SQLite 1.74 required" if $@;

subtest 'rank 22: errors_redact scrubs backtick-quoted identifiers' => sub {
    my $db = DBIx::Fast->new(
        dsn => 'dbi:SQLite:dbname=:memory:', driver => 'SQLite',
        RaiseError => 0, PrintError => 0, errors_redact => 1,
    );
    $db->set_error(1054, q{Unknown column `secret_col` in 'field list'});
    my $msg = $db->errors->[-1]{error};
    unlike($msg, qr/secret_col/,   'backtick-quoted identifier is redacted');
    like($msg,   qr/`<redacted>`/, 'backtick redaction marker present');
};

subtest 'rank 37: get_indexs warns once (deprecated alias)' => sub {
    my $db = DBIx::Fast->new(
        dsn => 'dbi:SQLite:dbname=:memory:', driver => 'SQLite',
        RaiseError => 1, PrintError => 0,
    );
    $db->exec('CREATE TABLE t (id INTEGER PRIMARY KEY, n INTEGER)');
    $db->exec('CREATE INDEX idx_n ON t (n)');

    my @warns;
    local $SIG{__WARN__} = sub { push @warns, $_[0] };
    $db->schema->get_indexs('t');
    $db->schema->get_indexs('t');   # second call must not warn again

    my @dep = grep { /get_indexs is deprecated/ } @warns;
    is(scalar @dep, 1, 'deprecation warning emitted exactly once');
};

subtest 'rank 29: savepoint outside a transaction records an error' => sub {
    my $db = DBIx::Fast->new(
        dsn => 'dbi:SQLite:dbname=:memory:', driver => 'SQLite',
        RaiseError => 1, PrintError => 0,
    );
    my $before = scalar @{ $db->errors };
    my $r = $db->transaction->savepoint('sp_outside');
    ok(!$r, 'savepoint() outside a transaction returns falsy');
    ok(scalar @{ $db->errors } > $before, 'an error was recorded (not a silent no-op)');
    like($db->last_error, qr/active transaction/, 'error explains the cause');
};

subtest 'rank 36: now_utc returns a UTC timestamp' => sub {
    my $db = DBIx::Fast->new(
        dsn => 'dbi:SQLite:dbname=:memory:', driver => 'SQLite',
        RaiseError => 1, PrintError => 0,
    );
    like($db->now_utc, qr/^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/, 'now_utc format');
    like($db->now,     qr/^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/, 'now format');
};

subtest 'rank 30: rollback_to removes same-level sibling savepoints' => sub {
    my $db = DBIx::Fast->new(
        dsn => 'dbi:SQLite:dbname=:memory:', driver => 'SQLite',
        RaiseError => 1, PrintError => 0,
    );
    $db->exec('CREATE TABLE t (id INTEGER PRIMARY KEY)');
    $db->txn(sub {
        $db->transaction->savepoint('sp1');
        $db->transaction->savepoint('sp2');     # sibling created after sp1
        $db->transaction->rollback_to('sp1');   # the DB also destroys sp2
        # sp2 must be gone from the map: a graceful "does not exist" (falsy),
        # not a raw DBD "no such savepoint" error.
        my $r = $db->transaction->rollback_to('sp2');
        ok(!$r, 'rollback_to a destroyed sibling savepoint returns falsy');
    });
    is($db->transaction->level, 0, 'transaction closed cleanly');
};

subtest 'rank 31: EXPLAIN allowlist rejects info-leak constructs' => sub {
    require DBIx::Fast::Profile::MariaDB;
    my $db = DBIx::Fast->new(
        dsn => 'dbi:SQLite:dbname=:memory:', driver => 'SQLite',
        RaiseError => 1, PrintError => 0,
    );
    # The validator is pure regex; a SQLite-backed instance is enough to test it.
    my $p = DBIx::Fast::Profile::MariaDB->new(dbix => $db);
    ok( $p->_validate_explainable_sql('SELECT * FROM t WHERE id = 1'), 'plain SELECT allowed');
    ok(!$p->_validate_explainable_sql('SELECT LOAD_FILE("/etc/passwd")'), 'LOAD_FILE rejected');
    ok(!$p->_validate_explainable_sql('SELECT a INTO OUTFILE "/tmp/x" FROM t'), 'INTO OUTFILE rejected');
    ok(!$p->_validate_explainable_sql('SELECT 0x4142'), 'bare hex literal rejected');
    ok(!$p->_validate_explainable_sql('SELECT 1; DROP TABLE t'), 'statement terminator rejected');
    # A 0x token INSIDE a quoted string value must NOT be rejected.
    ok( $p->_validate_explainable_sql(q{SELECT * FROM t WHERE c = '0x41'}),
        'hex-looking value inside a string literal is allowed');
    ok( $p->_validate_explainable_sql(q{SELECT note FROM t WHERE note = 'load_file x'}),
        'load_file-looking value inside a string literal is allowed');
};

done_testing;
