#!perl -w

# Path-coverage tests for Database::Abstraction.
#
# Every uniquely identifiable execution path (branch, guard, loop boundary,
# early return) in the key routines is exercised here.  Helpers are called
# directly where they are not decorated :Private/:Protected; for those that
# are, the relevant path is reached through the public API.
#
# CFG summary — routines covered and their path counts:
#   _like_match              12 paths  (5 fast-paths, DP with % and _ chars)
#   _match_criterion         21 paths  (all operators + edge cases)
#   _has_complex_criteria     5 paths
#   _build_where_conditions  19 paths  (all operators + error guards)
#   _build_where              6 paths  (-or, -and, combined, empty, plain)
#   _build_joins              8 paths  (single/array, defaults, croaks)
#   _is_local_host            6 paths
#   _fixate                   3 paths  (tested via slurp state)
#   _quote_identifier         2 paths  (dbh present, ANSI fallback)
#   _is_deep_db               5 paths
#   _open_table               5 paths  (explicit table, cached, cold)
#   AUTOLOAD                  9 paths  (guards, no_entry, keyed, SQL)

use strict;
use warnings;

use FindBin   qw($Bin);
use File::Spec;
use File::Temp ();
use Readonly;
use Scalar::Util qw(blessed);
use Test::Most  tests => 102;
use Test::NoWarnings;

use lib 't/lib';
use Database::test1;   # keyed CSV  (entry / number)
use Database::test3;   # XML
use Database::test4;   # no_entry keyed-by-cardinal CSV
use Database::test4ne; # no_entry arrayref CSV

Readonly my $DATA_DIR => File::Spec->catfile($Bin, File::Spec->updir(), 't', 'data');

# Shared keyed-CSV object; data is slurped so all in-memory paths are open.
my $db = Database::test1->new($DATA_DIR);
$db->count();   # trigger _open so all internal state is ready

# ============================================================
# Section 1: _like_match (package-level function — 12 paths)
# ============================================================
# Called as Database::Abstraction::_like_match($str, $pattern)

note('_like_match');

# P1-1: fast path 1 — bare '%' always matches
is(Database::Abstraction::_like_match('anything', '%'), 1,
    '_like_match: bare % → always 1');

# P1-2: fast path 2 — no wildcard, case-insensitive equality (match)
is(Database::Abstraction::_like_match('Hello', 'hello'), 1,
    '_like_match: no wildcard, same string case-insensitively → 1');

# P1-3: fast path 2 — no wildcard, different strings → false
ok(!Database::Abstraction::_like_match('Hello', 'world'),
    '_like_match: no wildcard, different strings → false');

# P1-4: fast path 3 — '%suffix', string ends with suffix → 1
is(Database::Abstraction::_like_match('foobar', '%bar'), 1,
    '_like_match: %suffix, string ends with suffix → 1');

# P1-5: fast path 3 — '%suffix', string does NOT end with suffix → false
ok(!Database::Abstraction::_like_match('foobar', '%baz'),
    '_like_match: %suffix, string missing suffix → false');

# P1-6: fast path 4 — 'prefix%', string starts with prefix → 1
is(Database::Abstraction::_like_match('foobar', 'foo%'), 1,
    '_like_match: prefix%, string starts with prefix → 1');

# P1-7: fast path 4 — 'prefix%', string does NOT start with prefix → false
ok(!Database::Abstraction::_like_match('bazbar', 'foo%'),
    '_like_match: prefix%, string missing prefix → false');

# P1-8: fast path 5 — '%literal%', string contains literal → 1
is(Database::Abstraction::_like_match('xfoox', '%foo%'), 1,
    '_like_match: %literal%, string contains literal → 1');

# P1-9: fast path 5 — '%literal%', string missing literal → false
ok(!Database::Abstraction::_like_match('xbarx', '%foo%'),
    '_like_match: %literal%, string missing literal → false');

# P1-10: fast path 5 BYPASS — inner % in middle forces full DP
# '%a%b%' has an inner '%' in the middle segment, so falls through to DP
is(Database::Abstraction::_like_match('xaxbx', '%a%b%'), 1,
    '_like_match: %a%b% (inner % in middle) → full DP, match');

# P1-11: DP path — '_' wildcard matching exactly one character → 1
is(Database::Abstraction::_like_match('abc', 'a_c'), 1,
    '_like_match: _ wildcard matches single char → 1');

# P1-12: DP path — '_' wildcard, wrong length → false
ok(!Database::Abstraction::_like_match('abbc', 'a_c'),
    '_like_match: _ wildcard, extra char means no match → false');

# ============================================================
# Section 2: _match_criterion — all 21 paths
# ============================================================

note('_match_criterion');

# P2-1: plain scalar — both undef → 1
is($db->_match_criterion(undef, undef), 1,
    '_match_criterion: undef==undef → 1');

# P2-2: plain scalar — row_val undef, crit defined → false
ok(!$db->_match_criterion(undef, 'val'),
    '_match_criterion: undef row vs defined crit → false');

# P2-3: plain scalar — row_val defined, crit undef → false
ok(!$db->_match_criterion('val', undef),
    '_match_criterion: defined row vs undef crit → false');

# P2-4: plain scalar — equal strings → 1
is($db->_match_criterion('hello', 'hello'), 1,
    '_match_criterion: equal strings → 1');

# P2-5: plain scalar — different strings → false
ok(!$db->_match_criterion('hello', 'world'),
    '_match_criterion: different strings → false');

# P2-6: -in, value in list → 1
is($db->_match_criterion('b', { '-in' => [qw(a b c)] }), 1,
    '_match_criterion: -in, value in list → 1');

# P2-7: -in, value NOT in list → false
ok(!$db->_match_criterion('z', { '-in' => [qw(a b c)] }),
    '_match_criterion: -in, value not in list → false');

# P2-8: -not_in, value IS in list → false
ok(!$db->_match_criterion('b', { '-not_in' => [qw(a b c)] }),
    '_match_criterion: -not_in, value in list → false');

# P2-9: -not_in, value NOT in list → 1
is($db->_match_criterion('z', { '-not_in' => [qw(a b c)] }), 1,
    '_match_criterion: -not_in, value not in list → 1');

# P2-10: -between, value in range → 1
is($db->_match_criterion(5, { '-between' => [1, 10] }), 1,
    '_match_criterion: -between, in range → 1');

# P2-11: -between, value outside range → false
ok(!$db->_match_criterion(15, { '-between' => [1, 10] }),
    '_match_criterion: -between, out of range → false');

# P2-12: -like, matches → 1
is($db->_match_criterion('foobar', { '-like' => '%bar' }), 1,
    '_match_criterion: -like, match → 1');

# P2-13: -like, no match → false
ok(!$db->_match_criterion('foobar', { '-like' => '%baz' }),
    '_match_criterion: -like, no match → false');

# P2-14: -not_like, pattern matches → false
ok(!$db->_match_criterion('foobar', { '-not_like' => '%bar' }),
    '_match_criterion: -not_like, pattern matches → false');

# P2-15: -not_like, pattern does not match → 1
is($db->_match_criterion('foobar', { '-not_like' => '%baz' }), 1,
    '_match_criterion: -not_like, pattern no match → 1');

# P2-16: != undef operand, row_val defined → 1 (IS NOT NULL path)
is($db->_match_criterion('val', { '!=' => undef }), 1,
    '_match_criterion: != undef operand, row defined → 1');

# P2-17: != undef operand, row_val undef → false
ok(!$db->_match_criterion(undef, { '!=' => undef }),
    '_match_criterion: != undef operand, row undef → false');

# P2-18: != defined, row equals operand → false
ok(!$db->_match_criterion('x', { '!=' => 'x' }),
    '_match_criterion: != defined, values equal → false');

# P2-19: != defined, row differs → 1
is($db->_match_criterion('x', { '!=' => 'y' }), 1,
    '_match_criterion: != defined, values differ → 1');

# P2-20: > passes
is($db->_match_criterion(10, { '>' => 5 }), 1,
    '_match_criterion: > passes → 1');

# P2-21: empty HASH criteria — no ops → always match (return 1)
is($db->_match_criterion('x', {}), 1,
    '_match_criterion: empty hashref → 1 (no operators to fail)');

# ============================================================
# Section 3: _has_complex_criteria — 5 paths
# ============================================================

note('_has_complex_criteria');

# P3-1: undef params → 0
is($db->_has_complex_criteria(undef), 0,
    '_has_complex_criteria: undef → 0');

# P3-2: -or present → 1
is($db->_has_complex_criteria({ '-or' => [] }), 1,
    '_has_complex_criteria: -or present → 1');

# P3-3: -and present → 1
is($db->_has_complex_criteria({ '-and' => [] }), 1,
    '_has_complex_criteria: -and present → 1');

# P3-4: hashref value → 1
is($db->_has_complex_criteria({ col => { '>' => 5 } }), 1,
    '_has_complex_criteria: operator hashref value → 1');

# P3-5: plain params, no complex criteria → 0
is($db->_has_complex_criteria({ col => 'plain_value' }), 0,
    '_has_complex_criteria: plain scalar value → 0');

# ============================================================
# Section 4: _build_where_conditions — 19 assertion paths
# ============================================================

note('_build_where_conditions');

{
	# Helper: extract SQL and args from _build_where_conditions
	my $bwc = sub { $db->_build_where_conditions(@_) };

	# P4-1: undef value → IS NULL (2 assertions)
	my ($sql, $args) = $bwc->({ col => undef });
	like($sql, qr/col IS NULL/, '_build_where_conditions: undef → IS NULL');
	is(scalar @{$args}, 0, '_build_where_conditions: IS NULL has no bind args');

	# P4-2: plain string with % → LIKE (2 assertions)
	($sql, $args) = $bwc->({ col => 'foo%' });
	like($sql, qr/col LIKE \?/, '_build_where_conditions: string with % → LIKE');
	is($args->[0], 'foo%', '_build_where_conditions: LIKE bind arg correct');

	# P4-3: plain string without wildcard → = ? (2 assertions)
	($sql, $args) = $bwc->({ col => 'exact' });
	like($sql, qr/col = \?/, '_build_where_conditions: plain string → = ?');
	is($args->[0], 'exact', '_build_where_conditions: equality bind arg correct');

	# P4-4: -in operator (2 assertions)
	($sql, $args) = $bwc->({ col => { '-in' => ['a', 'b'] } });
	like($sql, qr/col IN \(\?, \?\)/, '_build_where_conditions: -in → IN (?,?)');
	is_deeply($args, ['a', 'b'], '_build_where_conditions: -in bind args');

	# P4-5: -not_in operator (1 assertion)
	($sql, $args) = $bwc->({ col => { '-not_in' => ['x'] } });
	like($sql, qr/col NOT IN/, '_build_where_conditions: -not_in → NOT IN');

	# P4-6: -between operator (2 assertions)
	($sql, $args) = $bwc->({ col => { '-between' => [1, 10] } });
	like($sql, qr/col BETWEEN \? AND \?/, '_build_where_conditions: -between → BETWEEN');
	is_deeply($args, [1, 10], '_build_where_conditions: -between bind args');

	# P4-7: -like operator (1 assertion)
	($sql, $args) = $bwc->({ col => { '-like' => 'pat%' } });
	like($sql, qr/col LIKE \?/, '_build_where_conditions: -like → LIKE');

	# P4-8: -not_like operator (1 assertion)
	($sql, $args) = $bwc->({ col => { '-not_like' => 'pat%' } });
	like($sql, qr/col NOT LIKE \?/, '_build_where_conditions: -not_like → NOT LIKE');

	# P4-9: != with undef operand → IS NOT NULL (2 assertions)
	($sql, $args) = $bwc->({ col => { '!=' => undef } });
	like($sql, qr/col IS NOT NULL/, '_build_where_conditions: != undef → IS NOT NULL');
	is(scalar @{$args}, 0, '_build_where_conditions: IS NOT NULL has no bind arg');

	# P4-10: != with defined operand → != ? (1 assertion)
	($sql, $args) = $bwc->({ col => { '!=' => 'val' } });
	like($sql, qr/col != \?/, '_build_where_conditions: != defined → != ?');

	# P4-11: > operator (1 assertion)
	($sql, $args) = $bwc->({ col => { '>' => 5 } });
	like($sql, qr/col > \?/, '_build_where_conditions: > → > ?');

	# P4-12: unknown operator → croak (1 assertion)
	throws_ok {
		$bwc->({ col => { 'BADOP' => 'x' } })
	} qr/Unknown operator/, '_build_where_conditions: unknown op → croak';

	# P4-13: non-HASH ref value → croak (1 assertion)
	throws_ok {
		$bwc->({ col => [1, 2, 3] })
	} qr/expected scalar or operator hashref/, '_build_where_conditions: arrayref value → croak';
}

# ============================================================
# Section 5: _build_where — 6 assertion paths
# ============================================================

note('_build_where');

{
	# P5-1: empty params → empty WHERE body (2 assertions)
	my ($sql, $args) = $db->_build_where({});
	is($sql, '', '_build_where: empty params → empty string');
	is(scalar @{$args}, 0, '_build_where: empty params → no bind args');

	# P5-2: -or with conditions (1 assertion)
	($sql, $args) = $db->_build_where({ '-or' => [
		{ col1 => 'a' },
		{ col2 => 'b' },
	]});
	like($sql, qr/OR/, '_build_where: -or → OR clause in SQL');

	# P5-3: -and with conditions (1 assertion)
	($sql, $args) = $db->_build_where({ '-and' => [
		{ col1 => 'a' },
		{ col2 => 'b' },
	]});
	like($sql, qr/AND/, '_build_where: -and → AND clause in SQL');

	# P5-4: -or with EMPTY list → no clause pushed (loop runs 0 times) (1 assertion)
	($sql, $args) = $db->_build_where({ '-or' => [] });
	is($sql, '', '_build_where: -or with empty list → empty SQL (loop body never executes)');

	# P5-5: -or + plain column → both combined (1 assertion)
	($sql, $args) = $db->_build_where({
		'-or' => [{ col1 => 'a' }, { col1 => 'b' }],
		col2   => 'c',
	});
	like($sql, qr/OR.*AND|AND.*OR/s, '_build_where: -or + plain col → combined AND/OR');
}

# ============================================================
# Section 6: _build_joins — 8 paths
# ============================================================

note('_build_joins');

{
	# P6-1: single hashref → one JOIN clause
	my $clause = $db->_build_joins({ table => 'dept', on => 'a.id = dept.id', type => 'LEFT' });
	like($clause, qr/LEFT JOIN dept ON/, '_build_joins: single spec → one JOIN');

	# P6-2: arrayref of two specs → two JOINs
	$clause = $db->_build_joins([
		{ table => 'dept',    on => 'a.id = dept.id' },
		{ table => 'country', on => 'a.cid = country.id' },
	]);
	like($clause, qr/JOIN dept.*JOIN country/s, '_build_joins: two-spec array → two JOINs');

	# P6-3: no type → defaults to INNER
	$clause = $db->_build_joins({ table => 'dept', on => 'a.id = dept.id' });
	like($clause, qr/INNER JOIN/, '_build_joins: missing type → defaults to INNER');

	# P6-4: lowercase type is normalised to uppercase
	$clause = $db->_build_joins({ table => 'dept', on => 'a.id = dept.id', type => 'left' });
	like($clause, qr/LEFT JOIN/, '_build_joins: lowercase type normalised to LEFT');

	# P6-5: missing 'table' → croak
	throws_ok {
		$db->_build_joins({ on => 'a.id = b.id' })
	} qr/missing "table"/, '_build_joins: missing table → croak';

	# P6-6: unsafe table name → croak
	throws_ok {
		$db->_build_joins({ table => 'dept;drop', on => 'a=b' })
	} qr/unsafe table name/, '_build_joins: unsafe table → croak';

	# P6-7: missing 'on' → croak
	throws_ok {
		$db->_build_joins({ table => 'dept' })
	} qr/missing "on"/, '_build_joins: missing on → croak';

	# P6-8: invalid type → croak
	throws_ok {
		$db->_build_joins({ table => 'dept', on => 'a=b', type => 'NOSUCH' })
	} qr/Invalid JOIN type/, '_build_joins: invalid type → croak';
}

# ============================================================
# Section 7: _is_local_host — 6 paths
# ============================================================

note('_is_local_host');

# P7-1: 'localhost' literal → 1
is($db->_is_local_host('localhost'), 1, '_is_local_host: "localhost" → 1');

# P7-2: '127.0.0.1' → 1
is($db->_is_local_host('127.0.0.1'), 1, '_is_local_host: "127.0.0.1" → 1');

# P7-3: '::1' → 1
is($db->_is_local_host('::1'), 1, '_is_local_host: "::1" → 1');

# P7-4: user@ prefix stripped, remainder is 'localhost' → 1
is($db->_is_local_host('user@localhost'), 1, '_is_local_host: user@localhost → 1 (prefix stripped)');

# P7-5: genuinely remote host → false
ok(!$db->_is_local_host('remote.example.com'), '_is_local_host: remote host → false');

# P7-6: own hostname → 1 (Sys::Hostname path)
{
	require Sys::Hostname;
	my $me = lc(Sys::Hostname::hostname());
	is($db->_is_local_host($me), 1, '_is_local_host: own hostname → 1');
}

# ============================================================
# Section 8: _fixate — 3 paths (tested via slurp state)
# ============================================================

note('_fixate paths (tested via slurp state)');

# P8-1: _fixate is :Private — calling from outside package dies (caught by eval inside lives_ok)
lives_ok {
	eval { Database::Abstraction::_fixate($db, undef) };
} '_fixate: calling :Private from outside package is caught cleanly';

# P8-2: defined hashref → fixate ran on the public API slurp path.
# Hash-key locking via Data::Reuse is version-dependent; instead verify that
# fixation preserved data integrity: the outer data ref is a HASH, the known
# entry 'one' is accessible via exists(), and its value matches a fresh fetch.
{
	my $data = $db->{'data'};
	ok(ref($data) eq 'HASH' && exists $data->{'one'},
	    '_fixate: slurped data is a HASH with expected keys after fixation');
}

# P8-3: undef struct → no-op (early return); public access via count() with empty table
# Slurp produces $self->{'data'} = undef for zero-row CSV.  _fixate early-returns.
lives_ok {
	my $tmpdir = File::Temp->newdir(CLEANUP => 1);
	my $csvfile = File::Spec->catfile("$tmpdir", 'test1.csv');
	open(my $fh, '>', $csvfile) or die "Cannot write $csvfile: $!";
	print $fh "entry,number\n";    # header only, no data rows
	close $fh;
	my $empty_db = Database::test1->new("$tmpdir");
	$empty_db->count();
} '_fixate: undef struct early-return path (empty CSV, no crash)';

# ============================================================
# Section 9: _quote_identifier — 2 paths
# ============================================================

note('_quote_identifier');

# P9-1: DBI handle present → driver's quoting (CSV/DBD returns double-quoted ANSI)
{
	my $quoted = $db->_quote_identifier('my_col');
	ok(defined $quoted && length($quoted) > 0, '_quote_identifier: with DBH → non-empty result');
}

# P9-2: no DBI handle (HTML or slurp-only) → ANSI double-quote fallback
{
	# Build a minimal blessed object with no DBI handle
	my $bare = bless { _table_name => 'test1' }, 'Database::test1';
	my $quoted = $bare->_quote_identifier('my_col');
	is($quoted, '"my_col"', '_quote_identifier: no DBH → ANSI double-quote fallback');
}

# ============================================================
# Section 10: _is_deep_db — 5 paths
# ============================================================

note('_is_deep_db');

# P10-1: nonexistent file → false
ok(!$db->_is_deep_db('/no/such/file/xyzzy'),
    '_is_deep_db: nonexistent file → false');

# P10-2: DPDB magic → 1
{
	my $tmp = File::Temp->new(UNLINK => 1, SUFFIX => '.db');
	print $tmp 'DPDB' . 'x' x 100;
	$tmp->flush();
	is($db->_is_deep_db($tmp->filename()), 1, '_is_deep_db: DPDB magic → 1');
}

# P10-3: DPDP magic → 1
{
	my $tmp = File::Temp->new(UNLINK => 1, SUFFIX => '.db');
	print $tmp 'DPDP' . 'x' x 100;
	$tmp->flush();
	is($db->_is_deep_db($tmp->filename()), 1, '_is_deep_db: DPDP magic → 1');
}

# P10-4: file shorter than 4 bytes → false
{
	my $tmp = File::Temp->new(UNLINK => 1, SUFFIX => '.db');
	print $tmp 'AB';    # only 2 bytes — read returns n < 4
	$tmp->flush();
	ok(!$db->_is_deep_db($tmp->filename()),
	    '_is_deep_db: short file (< 4 bytes) → false');
}

# P10-5: file with other content (not DBM::Deep magic) → false
{
	my $tmp = File::Temp->new(UNLINK => 1, SUFFIX => '.db');
	print $tmp 'ABCD' . 'x' x 100;
	$tmp->flush();
	ok(!$db->_is_deep_db($tmp->filename()),
	    '_is_deep_db: non-DBM::Deep content → false');
}

# ============================================================
# Section 11: _open_table — 5 paths
# ============================================================

note('_open_table');

# P11-1: explicit 'table' param overrides class-derived name
{
	my $db2 = Database::test1->new($DATA_DIR);
	my $t = $db2->_open_table({ table => 'Database::other' });
	is($t, 'other', '_open_table: explicit table param → strips prefix');
}

# P11-2: _table_name cache hit — same string returned without recomputing
{
	my $db2 = Database::test1->new($DATA_DIR);
	$db2->count();   # populate cache
	my $name1 = $db2->{'_table_name'};
	my $name2 = $db2->_open_table({});
	is($name2, $name1, '_open_table: cached _table_name returned on second call');
}

# P11-3: cold open — _table_name not yet set, _open() is triggered
{
	my $db3 = Database::test1->new($DATA_DIR);
	ok(!defined $db3->{'_table_name'}, '_open_table setup: _table_name starts undef');
	my $t = $db3->_open_table({});
	is($t, 'test1', '_open_table: cold open derives table name from class');
	ok(defined $db3->{'_table_name'}, '_open_table: _table_name populated after cold open');
}

# ============================================================
# Section 12: AUTOLOAD — 9 branching paths
# ============================================================
# NOTE: Do NOT call $db->DESTROY() on the shared object — real DESTROY clears
# directory and _table_name, breaking subsequent AUTOLOAD calls on $db.
# Use a temporary object for the DESTROY guard test.

note('AUTOLOAD paths');

# P12-1: DESTROY dispatches to the real DESTROY sub (not through AUTOLOAD).
# Use a fresh throwaway object so the shared $db is unaffected.
{
	my $tmp_db = Database::test1->new($DATA_DIR);
	lives_ok { $tmp_db->DESTROY() } 'AUTOLOAD: explicit DESTROY on fresh object → no error';
}

# P12-2: guard — auto_load => 0 → croak "AUTOLOAD disabled"
{
	my $no_al = Database::test1->new(directory => $DATA_DIR, auto_load => 0);
	local $SIG{__WARN__} = sub {};    # suppress _open() uninitialized-value warning
	throws_ok { $no_al->number(entry => 'one') }
		qr/AUTOLOAD disabled/, 'AUTOLOAD: auto_load=0 → croak';
}

# P12-3: keyed slurp, wantarray, no params → all column values returned
{
	my @nums = $db->number();
	cmp_ok(scalar @nums, '==', 4, 'AUTOLOAD: wantarray, no params → all values (4 rows)');
}

# P12-4: keyed slurp, scalar context, single entry param → correct scalar return
{
	my $n = $db->number(entry => 'one');
	is($n, 1, 'AUTOLOAD: scalar context, entry=one → returns 1');
}

# P12-5: keyed slurp, single entry param → correct value
{
	my $n = $db->number(entry => 'two');
	is($n, 2, 'AUTOLOAD: keyed, entry=two → number is 2');
}

# P12-6: keyed slurp, entry param, column does not exist → croak
{
	throws_ok { $db->nosuchcol(entry => 'one') }
		qr/There is no column nosuchcol in test1/,
		'AUTOLOAD: missing column in slurp → croak';
}

# P12-7: keyed slurp, filter on non-key column → scans rows
{
	my $e = $db->entry(number => 2);
	is($e, 'two', 'AUTOLOAD: non-entry param, keyed scan → correct row');
}

# P12-8: no_entry slurp, id-key lookup returns correct value
{
	my $noentry_db = Database::test4ne->new({ directory => $DATA_DIR });
	my $ord = $noentry_db->ordinal(cardinal => 'one');
	is($ord, 'first', 'AUTOLOAD: no_entry slurp, key found → correct value');
}

# P12-9: no_entry slurp, missing key → undef (no croak)
{
	my $noentry_db = Database::test4ne->new({ directory => $DATA_DIR });
	my $ord = $noentry_db->ordinal(cardinal => 'ninety');
	ok(!defined $ord, 'AUTOLOAD: no_entry slurp, key not found → undef');
}
