Config-Abstraction

 view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

	local %ENV = %ENV;
	$ENV{"${ENV_PREFIX}DATABASE__USER"} = '';

	my $cfg = Config::Abstraction->new(
		data => {
			database => { user => $EXPECTED_USER, pass => 'x' },
		},
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	my $val = $cfg->get('database.user');
	# Empty string ENV value should override, not be ignored
	ok(defined($val), 'empty ENV value is defined');
	is($val, '', 'empty ENV value overrides data');
};

subtest 'ENV - prefix match is case-insensitive per POD' => sub {
	local %ENV = %ENV;
	$ENV{lc("${ENV_PREFIX}DATABASE__USER")} = 'lower_env';

	my $cfg = Config::Abstraction->new(
		data => {
			database => { user => $EXPECTED_USER, pass => 'x' },
		},
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	# POD says case-insensitive match
	is($cfg->get('database.user'), 'lower_env', 'lowercase ENV key matched case-insensitively');
};

subtest 'ENV - many double-underscore segments create deep nesting' => sub {
	local %ENV = %ENV;
	$ENV{"${ENV_PREFIX}A__B__C__D"} = 'deep';

	my $cfg = Config::Abstraction->new(
		data        => { a => { b => { c => { d => 'original' } } } },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('a.b.c.d'), 'deep', 'deep double-underscore ENV nesting works');
};

subtest 'ENV - prefix with no matching vars leaves data intact' => sub {
	local %ENV = %ENV;
	# Remove any accidentally matching vars
	delete $ENV{$_} for grep { /^$ENV_PREFIX/ } keys %ENV;

	my $cfg = Config::Abstraction->new(
		data        => { key => 'original' },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('key'), 'original', 'data intact when no ENV vars match prefix');
};

# ===========================================================================
# Pathological CLI argument edge cases
# ===========================================================================
subtest 'CLI - arg without = sign is ignored' => sub {
	local @ARGV = ("--${ENV_PREFIX}RETRIES");

	my $cfg = Config::Abstraction->new(
		data        => { retries => 3 },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('retries'), 3, 'CLI arg without = sign ignored');
};

subtest 'CLI - arg with empty value sets empty string' => sub {
	local @ARGV = ("--${ENV_PREFIX}RETRIES=");

	my $cfg = Config::Abstraction->new(
		data        => { retries => 3 },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	my $val = $cfg->get('retries');
	is($val, '', 'CLI arg with empty value sets empty string');
};

subtest 'CLI - arg with = in value captures full value' => sub {
	local @ARGV = ("--${ENV_PREFIX}DSN=host=localhost;port=5432");

	my $cfg = Config::Abstraction->new(
		data        => { dsn => 'original' },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('dsn'), 'host=localhost;port=5432', 'CLI value with embedded = preserved');
};

subtest 'CLI - non-matching prefix args ignored' => sub {
	local @ARGV = ('--OTHERAPP_KEY=value', '--notanoption', 'positional');

	my $cfg = Config::Abstraction->new(
		data        => { key => 'original' },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('key'), 'original', 'non-matching CLI args ignored');
};

# ===========================================================================
# merge_defaults() edge cases
# ===========================================================================
subtest 'merge_defaults() - undef defaults arg returns config' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { key => 'value' },
		config_dirs => [],
	);
	my $result = $cfg->merge_defaults(defaults => undef);
	ok(defined($result), 'undef defaults returns config hashref');
};

subtest 'merge_defaults() - section that does not exist in config' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { key => 'value' },
		config_dirs => [],
	);
	my $result = $cfg->merge_defaults(
		defaults => { extra => 'kept' },
		section  => 'nosuchsection',
	);
	# Section absent - full config merged with defaults
	ok(defined($result), 'absent section does not crash');
	is($result->{extra}, 'kept', 'default preserved when section absent');
};

subtest 'merge_defaults() - empty defaults hash' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { key => 'value' },
		config_dirs => [],
	);
	my $result = $cfg->merge_defaults(defaults => {});
	ok(defined($result),         'empty defaults hash accepted');
	is($result->{key}, 'value',  'config key present in result');
};

subtest 'merge_defaults() - deep option with no global section' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { key => 'value' },
		config_dirs => [],
	);
	my $result;
	eval {
		$result = $cfg->merge_defaults(
			defaults => { extra => 'kept' },
			deep     => 1,
		);
	};
	ok(!$@, 'deep option with no global section does not crash');
	is($result->{extra}, 'kept', 'default preserved');
};

t/edge_cases.t  view on Meta::CPAN

	local %ENV = %ENV;
	$ENV{'XMARKER_CANARY'} = 'should_not_appear';

	my $cfg;
	_silenced(sub {
		eval {
			$cfg = Config::Abstraction->new(
				data        => { safe => 'value' },
				config_dirs => [],
				env_prefix  => '.',
			);
		};
	});
	# With the fix, '.' is literal so XMARKER_CANARY is not merged.
	# Confirm the canary value does not appear anywhere in the config.
	if(defined($cfg)) {
		my $all = $cfg->all() // {};
		my $dumped = join(' ', map { "$_ => $all->{$_}" } grep { defined $all->{$_} && !ref($all->{$_}) } keys %$all);
		unlike($dumped, qr/should_not_appear/, 'dot env_prefix does not ingest arbitrary env vars');
	} else {
		pass('constructor returned undef - no pollution possible');
	}
};

subtest 'SECURITY: env_prefix "APP+_" does not cause regex compile error' => sub {
	# Without \Q\E, /^APP+_/ is a valid but wrong regex (one or more Ps).
	# With \Q\E, /^\QAPP+_\E/ treats "+" literally.
	local %ENV = %ENV;
	$ENV{'APP+_KEY'} = 'plus_val';

	my $cfg;
	eval {
		$cfg = Config::Abstraction->new(
			data        => { key => 'original' },
			config_dirs => [],
			env_prefix  => 'APP+_',
		);
	};
	ok(!$@, 'env_prefix with "+" does not cause an unhandled regex compile error');
};

subtest 'SECURITY: env_prefix "(" does not cause fatal regex error' => sub {
	# Without \Q\E, /^APP(/ is an unbalanced group -> fatal Perl regex error.
	# With \Q\E, it is safe literal matching.
	local %ENV = %ENV;

	my $cfg;
	eval {
		$cfg = Config::Abstraction->new(
			data        => { key => 'original' },
			config_dirs => [],
			env_prefix  => 'APP(_',
		);
	};
	ok(!$@, 'env_prefix with unbalanced "(" does not die with regex error');
};

subtest 'SECURITY: env_prefix metachar does not match unintended CLI args' => sub {
	# Same quotemeta fix needed on the ARGV regex (line 775).
	# env_prefix = 'APP.' would make /^--APP.KEY=/ match --APP_KEY= (. = any char).
	local @ARGV = ('--APP_KEY=wrong', '--APPXKEY=also_wrong');

	my $cfg;
	eval {
		$cfg = Config::Abstraction->new(
			data        => { key => 'original' },
			config_dirs => [],
			env_prefix  => 'APP.',
		);
	};
	ok(!$@, 'ARGV regex with metachar env_prefix does not die');
	# With the fix, 'APP.' matches literally so APP_KEY and APPXKEY are skipped
	if(defined($cfg)) {
		isnt($cfg->get('key'), 'wrong',      'ARGV: unintended arg not merged via metachar prefix');
		isnt($cfg->get('key'), 'also_wrong', 'ARGV: second unintended arg not merged either');
	} else {
		pass('constructor returned undef - no injection possible');
	}
};

# ===========================================================================
# SECURITY: path traversal via config_file
# ---------------------------------------------------------------------------
# Config::Abstraction deliberately does NOT restrict which paths can be loaded
# (the module is a file loader by design), but traversal should not bypass the
# config_dirs constraint silently.  Document the behaviour.
# ===========================================================================

subtest 'SECURITY: path traversal in config_file loads relative path as-is' => sub {
	# The module does not sandbox paths; this test documents the design intent:
	# passing an absolute path to a nonexistent target returns undef (not a crash).
	my $cfg;
	_silenced(sub {
		eval {
			$cfg = Config::Abstraction->new(
				config_file => '/this/path/does/not/exist/ever.yaml',
				config_dirs => [''],
			);
		};
	});
	ok(!$@,        'nonexistent traversal path does not crash constructor');
	ok(!defined($cfg), 'nonexistent traversal path returns undef (no data loaded)');
};

# ===========================================================================
# Filesystem hostility
# ===========================================================================

subtest 'filesystem: /dev/null as config file produces no data' => sub {
	plan skip_all => '/dev/null not available on this platform' unless -e '/dev/null';

	my $cfg;
	eval {
		$cfg = Config::Abstraction->new(
			config_file => '/dev/null',
			config_dirs => [''],
			data        => { fallback => 'devnull_test' },
		);
	};
	ok(!$@, '/dev/null as config_file does not crash constructor');
	if(defined($cfg)) {

t/edge_cases.t  view on Meta::CPAN

		is($sources->{$key}{'value'}, $cfg->get($key),
			"explain_sources value for '$key' matches get()");
	}
};

subtest 'explain_sources() - config_path key is excluded from output' => sub {
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml', "x: 1\n");

	my $cfg = Config::Abstraction->new(config_dirs => [$dir]);
	ok(!exists $cfg->explain_sources()->{'config_path'},
		'config_path excluded from explain_sources output');
};

subtest 'explain_sources() - data source entry has correct type, label and value' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { mykey => 'myval' },
		config_dirs => [],
	);
	my $sources = $cfg->explain_sources();
	ok(exists $sources->{'mykey'}, 'mykey present in explain_sources');
	my @data_src = grep { $_->{'type'} eq 'data' } @{$sources->{'mykey'}{'sources'}};
	ok(scalar(@data_src) >= 1, 'at least one data-type source record for mykey');
	is($data_src[0]{'label'}, 'constructor data argument',
		'data source label is "constructor data argument"');
	is($data_src[0]{'value'}, 'myval', 'data source value is correct');
};

subtest 'explain_sources() - file source entry has type=file and path as label' => sub {
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml', "filekey: fileval\n");

	my $cfg    = Config::Abstraction->new(config_dirs => [$dir]);
	my $sources = $cfg->explain_sources();
	ok(exists $sources->{'filekey'}, 'filekey present in explain_sources');
	my @file_src = grep { $_->{'type'} eq 'file' } @{$sources->{'filekey'}{'sources'}};
	ok(scalar(@file_src) >= 1, 'file-type source present for filekey');
	like($file_src[0]{'label'}, qr/base\.yaml$/, 'file source label ends with base.yaml');
	is($file_src[0]{'value'}, 'fileval', 'file source value correct');
};

subtest 'explain_sources() - env source entry has type=env and var name as label' => sub {
	local %ENV = %ENV;
	$ENV{"${ENV_PREFIX}DATABASE__HOST"} = 'envhost';

	my $cfg = Config::Abstraction->new(
		data        => { database => { host => 'datahost' } },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	my $sources = $cfg->explain_sources();
	my @env_src = grep { $_->{'type'} eq 'env' }
		@{$sources->{'database.host'}{'sources'}};
	ok(scalar(@env_src) >= 1, 'env-type source present for database.host');
	is($env_src[0]{'label'}, "${ENV_PREFIX}DATABASE__HOST",
		'env source label is the environment variable name');
	is($env_src[0]{'value'}, 'envhost', 'env source value matches the env var');
};

subtest 'explain_sources() - argv source entry has type=argv and arg string as label' => sub {
	local @ARGV = ("--${ENV_PREFIX}ARGKEY=argval");

	my $cfg = Config::Abstraction->new(
		data        => { argkey => 'original' },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	my $sources = $cfg->explain_sources();
	my @argv_src = grep { $_->{'type'} eq 'argv' }
		@{$sources->{'argkey'}{'sources'}};
	ok(scalar(@argv_src) >= 1, 'argv-type source present for argkey');
	like($argv_src[0]{'label'}, qr/ARGKEY/, 'argv source label contains the key name');
	is($argv_src[0]{'value'}, 'argval', 'argv source value correct');
};

subtest 'explain_sources() - sources ordered lowest-to-highest precedence' => sub {
	# data < file < env - verify the ordering guarantee of the POD.
	local %ENV = %ENV;
	$ENV{"${ENV_PREFIX}MULTI__KEY"} = 'env_val';

	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml', "multi:\n  key: file_val\n");

	my $cfg = Config::Abstraction->new(
		data        => { multi => { key => 'data_val' } },
		config_dirs => [$dir],
		env_prefix  => $ENV_PREFIX,
	);
	my $sources = $cfg->explain_sources();
	ok(exists $sources->{'multi.key'}, 'multi.key present in explain_sources');
	my @all_src = @{$sources->{'multi.key'}{'sources'}};
	ok(scalar(@all_src) >= 2, 'at least two source records for multi.key');
	is($all_src[0]{'type'}, 'data', 'first source is data (lowest precedence)');
	is($all_src[-1]{'type'}, 'env',  'last source is env (highest precedence)');
	is($sources->{'multi.key'}{'value'}, 'env_val',
		'final value is the env value (highest precedence wins)');
};

subtest 'explain_sources() - idempotent: repeated calls return equal structure' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { x => 1, y => 2 },
		config_dirs => [],
	);
	is_deeply($cfg->explain_sources(), $cfg->explain_sources(),
		'explain_sources() returns same structure on every call');
};

subtest 'explain_sources() - undef data value appears with undef in sources.value' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { nulkey => undef },
		config_dirs => [],
	);
	my $sources = $cfg->explain_sources();
	ok(exists $sources->{'nulkey'}, 'undef-valued key appears in explain_sources output');
	my @data_src = grep { $_->{'type'} eq 'data' }
		@{$sources->{'nulkey'}{'sources'}};
	ok(scalar(@data_src) >= 1, 'data source recorded for undef-valued key');
	ok(!defined($data_src[0]{'value'}),
		'source value is undef for a key the data arg set to undef');
};

t/edge_cases.t  view on Meta::CPAN

subtest 'prefer_file() - last file wins when multiple files contributed to same key' => sub {
	# base.yaml < local.yaml in precedence; prefer_file should return local.yaml value.
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml',  "multifile: base_val\n");
	_write_file($dir, 'local.yaml', "multifile: local_val\n");

	my $cfg = Config::Abstraction->new(config_dirs => [$dir]);
	is($cfg->prefer_file('multifile'), 'local_val',
		'prefer_file returns value from last-loaded file (local.yaml > base.yaml)');
};

# ===========================================================================
# prefer_data() - boundary conditions
# ===========================================================================

subtest 'prefer_data() returns data value even when a file overrode it' => sub {
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml', "host: from_file\n");

	my $cfg = Config::Abstraction->new(
		data        => { host => 'from_data' },
		config_dirs => [$dir],
	);
	is($cfg->get('host'),         'from_file', 'get() returns file-overridden value');
	is($cfg->prefer_data('host'), 'from_data', 'prefer_data bypasses file override');
};

subtest 'prefer_data() falls back to get() when data arg did not contribute to key' => sub {
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml', "file_only: from_file\n");

	my $cfg = Config::Abstraction->new(
		data        => { other => 'val' },
		config_dirs => [$dir],
	);
	is($cfg->prefer_data('file_only'), 'from_file',
		'prefer_data falls back to get() when data arg never set the key');
};

subtest 'prefer_data() with undef data value: $found gates return, not $val' => sub {
	# If data set key => undef, the source record exists (flat_data has the key).
	# So $found = 1 and $val = undef.  Returning "$found ? $val" is undef (correct),
	# NOT falling through to get() which might also return undef for other reasons.
	my $cfg = Config::Abstraction->new(
		data        => { nuldata => undef },
		config_dirs => [],
	);
	# Sanity: the key is visible in explain_sources, proving the source record exists.
	ok(exists $cfg->explain_sources()->{'nuldata'},
		'nuldata appears in explain_sources despite undef value');
	ok(!defined($cfg->prefer_data('nuldata')),
		'prefer_data returns undef for a key the data arg set to undef');
};

# ===========================================================================
# prefer_argv() - boundary conditions
# ===========================================================================

subtest 'prefer_argv() returns argv value when CLI arg contributed to key' => sub {
	local @ARGV = ("--${ENV_PREFIX}ARGVKEY=argv_val");

	my $cfg = Config::Abstraction->new(
		data        => { argvkey => 'data_val' },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->prefer_argv('argvkey'), 'argv_val',
		'prefer_argv returns the argv-provided value');
};

subtest 'prefer_argv() falls back to get() when no CLI arg contributed' => sub {
	local @ARGV = ();

	my $cfg = Config::Abstraction->new(
		data        => { noargv => 'data_only' },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->prefer_argv('noargv'), 'data_only',
		'prefer_argv falls back to get() when no CLI arg set the key');
};

subtest 'prefer_argv() equals get() since argv is the highest-precedence source' => sub {
	# When argv contributed, it already won the merge; get() and prefer_argv() agree.
	local @ARGV = ("--${ENV_PREFIX}TOPKEY=top_val");
	local %ENV  = %ENV;
	$ENV{"${ENV_PREFIX}DATABASE__TOPKEY"} = 'env_val';

	my $cfg = Config::Abstraction->new(
		data        => { topkey => 'data_val' },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('topkey'),         'top_val', 'get() returns argv value (highest precedence)');
	is($cfg->prefer_argv('topkey'), 'top_val',
		'prefer_argv matches get() when argv is the winning source');
};

# ===========================================================================
# prefer_*() hostile inputs shared across all four methods
# ===========================================================================

subtest 'prefer_env() with undef key does not crash' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { x => 1 },
		config_dirs => [],
	);
	eval { $cfg->prefer_env(undef) };
	ok(!$@, 'prefer_env(undef) does not die');
};

subtest 'prefer_file() with undef key does not crash' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { x => 1 },
		config_dirs => [],
	);
	eval { $cfg->prefer_file(undef) };
	ok(!$@, 'prefer_file(undef) does not die');
};

subtest 'prefer_data() with empty string key does not crash' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { x => 1 },
		config_dirs => [],
	);
	eval { $cfg->prefer_data('') };
	ok(!$@, 'prefer_data("") does not die');
};

subtest 'prefer_argv() with very long key does not crash' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { x => 1 },
		config_dirs => [],
	);
	eval { $cfg->prefer_argv('k' x $LONG_STRING_LEN) };
	ok(!$@, 'prefer_argv with very long key does not die');
};

subtest 'all four prefer_*() methods agree when only data set the key' => sub {
	# When only the data arg contributed, all prefer_* fall back to get(),
	# and prefer_data returns the data value directly.  All four should agree.
	local @ARGV  = ();
	local %ENV   = %ENV;
	delete $ENV{$_} for grep { /^\Q$ENV_PREFIX\E/ } keys %ENV;

	my $cfg = Config::Abstraction->new(
		data        => { only_data => 'data_val' },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->prefer_env('only_data'),  'data_val', 'prefer_env  returns data value');
	is($cfg->prefer_file('only_data'), 'data_val', 'prefer_file returns data value');
	is($cfg->prefer_data('only_data'), 'data_val', 'prefer_data returns data value');
	is($cfg->prefer_argv('only_data'), 'data_val', 'prefer_argv returns data value');
};

# ===========================================================================
# SECURITY: prefer_*() source injection via _source_records manipulation
# ---------------------------------------------------------------------------
# The _source_records structure is private.  Verify that mutating the hashref
# returned by all() (which is the live config ref) does NOT inject entries into
# the source records that then corrupt prefer_*() results.
# ===========================================================================

subtest 'SECURITY: mutating all() result does not corrupt prefer_data() output' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { safe => 'safe_val' },
		config_dirs => [],
	);
	# Inject a new key directly into the live config hashref (abuse of all())
	$cfg->all()->{'injected'} = 'evil';

	# injected key has no source record - prefer_data falls back to get()
	is($cfg->prefer_data('injected'), 'evil',
		'injected key falls back to get() (no source record exists for it)');

	# The safe key is unaffected
	is($cfg->prefer_data('safe'), 'safe_val', 'original safe key unaffected');
};

subtest 'SECURITY: explain_sources() does not expose keys injected via all() ref' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { real => 'real_val' },
		config_dirs => [],
	);
	$cfg->all()->{'injected_key'} = 'injected_val';

	my $sources = $cfg->explain_sources();
	# injected_key may appear in explain_sources (it's in the live config hash),
	# but it must have an empty sources list - it has no provenance record.
	if(exists $sources->{'injected_key'}) {
		my @src = @{$sources->{'injected_key'}{'sources'}};
		is(scalar(@src), 0,
			'injected key has no source records in explain_sources');
	} else {
		pass('injected key not exposed by explain_sources (acceptable if _flatten_keys skips it)');
	}
};

# ===========================================================================
# NO SOURCES PROVIDED
# ---------------------------------------------------------------------------
# The POD states: "Constructor returns undef (not a blessed object) when no
# configuration data is found."  Verify the contract when every source layer
# is empty or absent.
# ===========================================================================

subtest 'no sources: new() with no data and empty config_dirs returns undef' => sub {
	local @ARGV = ();
	local %ENV  = %ENV;
	delete $ENV{$_} for grep { /^\QAPP_\E/i } keys %ENV;

	my $cfg = Config::Abstraction->new(config_dirs => []);
	ok(!defined($cfg), 'new() with no data and config_dirs=[] returns undef');
};

subtest 'no sources: new() with data=>undef and empty config_dirs returns undef' => sub {
	local @ARGV = ();
	local %ENV  = %ENV;
	delete $ENV{$_} for grep { /^\QAPP_\E/i } keys %ENV;

	# data => undef is explicitly ignored (carp warning emitted); no keys loaded.
	my $cfg;
	_silenced(sub {
		$cfg = Config::Abstraction->new(data => undef, config_dirs => []);
	});
	ok(!defined($cfg), 'data=>undef with no files and no env/argv returns undef');
};

subtest 'no sources: new() returns undef even when config_dirs has nonexistent paths' => sub {
	local @ARGV = ();
	local %ENV  = %ENV;
	delete $ENV{$_} for grep { /^\QAPP_\E/i } keys %ENV;

	my $cfg = Config::Abstraction->new(
		config_dirs => ['/no/such/dir/a', '/no/such/dir/b'],
	);
	ok(!defined($cfg), 'all-nonexistent config_dirs with no data returns undef');
};

subtest 'no sources: explain_sources() is never called on a undef object (contract check)' => sub {
	# The POD says "Always check the return value before using the object."
	# This test documents that calling methods on a undef constructor result
	# would die with "Can't call method on undef".  We verify the return value
	# is indeed undef and do not call any method on it.
	local @ARGV = ();
	local %ENV  = %ENV;
	delete $ENV{$_} for grep { /^\QAPP_\E/i } keys %ENV;

	my $cfg = Config::Abstraction->new(config_dirs => []);
	ok(!defined($cfg), 'constructor returned undef as documented');
	dies_ok { $cfg->get('any') } 'calling get() on undef object dies (correct API contract)';
};

# ===========================================================================
# CONFLICTING SOURCES: EXPLICIT PRECEDENCE VERIFICATION
# ---------------------------------------------------------------------------
# The merge order is: data < file < env < argv.
# Each tier must override the tier below it for the same key.
# The tests use a common key 'database.host' and layer it progressively.
# ===========================================================================

Readonly::Scalar my $CONFLICT_PREFIX  => 'CONFLICT_';
Readonly::Scalar my $CONFLICT_DATA    => 'data_host';
Readonly::Scalar my $CONFLICT_FILE    => 'file_host';
Readonly::Scalar my $CONFLICT_ENV     => 'env_host';
Readonly::Scalar my $CONFLICT_ARGV    => 'argv_host';

subtest 'conflict: file overrides data for the same key (data < file)' => sub {
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml', "database:\n  host: $CONFLICT_FILE\n");

	my $cfg = Config::Abstraction->new(
		data        => { database => { host => $CONFLICT_DATA } },
		config_dirs => [$dir],
	);
	is($cfg->get('database.host'), $CONFLICT_FILE,
		"file value '$CONFLICT_FILE' overrides data value '$CONFLICT_DATA'");
	# Verify source provenance matches the winner
	my @file_src = grep { $_->{'type'} eq 'file' }
		@{$cfg->explain_sources()->{'database.host'}{'sources'}};
	ok(scalar(@file_src) >= 1, 'explain_sources records a file-type source for the winning value');
};

subtest 'conflict: env overrides file for the same key (file < env)' => sub {
	local %ENV = %ENV;
	$ENV{"${CONFLICT_PREFIX}DATABASE__HOST"} = $CONFLICT_ENV;

	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml', "database:\n  host: $CONFLICT_FILE\n");

	my $cfg = Config::Abstraction->new(
		config_dirs => [$dir],
		env_prefix  => $CONFLICT_PREFIX,
	);
	is($cfg->get('database.host'), $CONFLICT_ENV,
		"env value '$CONFLICT_ENV' overrides file value '$CONFLICT_FILE'");
};

subtest 'conflict: argv overrides env for the same key (env < argv)' => sub {
	local %ENV  = %ENV;
	local @ARGV = ("--${CONFLICT_PREFIX}DATABASE__HOST=$CONFLICT_ARGV");
	$ENV{"${CONFLICT_PREFIX}DATABASE__HOST"} = $CONFLICT_ENV;

	my $cfg = Config::Abstraction->new(
		data        => { database => { host => $CONFLICT_DATA } },
		config_dirs => [],
		env_prefix  => $CONFLICT_PREFIX,
	);
	is($cfg->get('database.host'), $CONFLICT_ARGV,
		"argv value '$CONFLICT_ARGV' overrides env value '$CONFLICT_ENV'");
};

subtest 'conflict: full four-way stack - argv wins over data/file/env' => sub {
	local %ENV  = %ENV;
	local @ARGV = ("--${CONFLICT_PREFIX}DATABASE__HOST=$CONFLICT_ARGV");
	$ENV{"${CONFLICT_PREFIX}DATABASE__HOST"} = $CONFLICT_ENV;

	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml', "database:\n  host: $CONFLICT_FILE\n");

	my $cfg = Config::Abstraction->new(
		data        => { database => { host => $CONFLICT_DATA } },
		config_dirs => [$dir],
		env_prefix  => $CONFLICT_PREFIX,
	);
	is($cfg->get('database.host'), $CONFLICT_ARGV,
		"argv is the definitive winner in a four-way data/file/env/argv conflict");

	# Confirm explain_sources records all four tiers and value matches argv
	my $explain = $cfg->explain_sources()->{'database.host'};
	is($explain->{'value'}, $CONFLICT_ARGV, 'explain_sources final value is argv value');
	my %by_type = map { $_->{'type'} => 1 } @{$explain->{'sources'}};
	ok($by_type{'data'}, 'data source recorded');
	ok($by_type{'file'}, 'file source recorded');
	ok($by_type{'env'},  'env source recorded');
	ok($by_type{'argv'}, 'argv source recorded');
};

subtest 'conflict: local.yaml overrides base.yaml for the same key (within file tier)' => sub {
	# Within the file tier, local.* files have higher precedence than base.*.
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml',  "tier: base_val\n");
	_write_file($dir, 'local.yaml', "tier: local_val\n");

	my $cfg = Config::Abstraction->new(config_dirs => [$dir]);
	is($cfg->get('tier'), 'local_val',
		'local.yaml overrides base.yaml for the same key');
};

subtest 'conflict: same key from two formats in file tier - YAML wins over INI' => sub {
	# The load order is base.yaml, base.yml, base.json, base.xml, base.ini, …
	# base.ini is loaded after base.yaml so it has higher file-tier precedence.
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml', "[database]\nhost = yaml_host\n");
	_write_file($dir, 'base.ini',  "[database]\nhost = ini_host\n");

	my $cfg;
	_silenced(sub {
		$cfg = Config::Abstraction->new(config_dirs => [$dir]);
	});
	ok(defined($cfg), 'both base.yaml and base.ini loaded without crash');
	# base.ini is loaded after base.yaml, so INI value wins within the file tier
	is($cfg->get('database.host'), 'ini_host',
		'base.ini (loaded later) overrides base.yaml within the file tier');
};

# ===========================================================================
# REGRESSION TESTS
# ---------------------------------------------------------------------------
# Named regression tests for bugs found in the wild.  Each test is labelled
# with the ticket or commit that introduced the fix so that git-blame can
# trace lineage and the test suite immediately identifies a reintroduced bug.
# ===========================================================================

subtest 'REGRESSION merge_defaults mutation: global section preserved across calls (fix: 0.40)' => sub {

t/edge_cases.t  view on Meta::CPAN

# flatten mode: AUTOLOAD, explain_sources, and dotted key get() in flat mode
# ===========================================================================

subtest 'flatten: get() with dotted key traverses the flat hash correctly' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { db => { user => 'alice', pass => 'secret' } },
		config_dirs => [],
		flatten     => 1,
	);
	# In flatten mode, the config is stored as { 'db.user' => 'alice', 'db.pass' => 'secret' }
	is($cfg->get('db.user'), 'alice',  'flatten: dotted key lookup for db.user');
	is($cfg->get('db.pass'), 'secret', 'flatten: dotted key lookup for db.pass');
	ok(!defined($cfg->get('db')),      'flatten: bare parent key returns undef in flat hash');
};

subtest 'flatten: AUTOLOAD translates sep_char to dot form for flat hash lookup' => sub {
	# When sep_char='_' and flatten=1, AUTOLOAD translates db_user -> db.user before lookup.
	my $cfg = Config::Abstraction->new(
		data        => { db => { user => 'alice' } },
		config_dirs => [],
		flatten     => 1,
		sep_char    => $SEP_US,
	);
	my $val;
	lives_ok { $val = $cfg->db_user() }
		'AUTOLOAD in flatten mode with sep_char=_ does not crash';
	is($val, 'alice', 'AUTOLOAD in flatten mode returns correct value');
};

subtest 'flatten: explain_sources() works correctly in flat mode' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { db => { user => 'alice' } },
		config_dirs => [],
		flatten     => 1,
	);
	my $es;
	lives_ok { $es = $cfg->explain_sources() }
		'explain_sources() does not crash in flatten mode';
	ok(ref($es) eq 'HASH', 'explain_sources() returns hashref in flatten mode');
	ok(exists $es->{'db.user'}, 'dotted key present in explain_sources in flat mode');
};

subtest 'flatten: exists() returns 1 for a flat dotted key' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { a => { b => 'val' } },
		config_dirs => [],
		flatten     => 1,
	);
	is($cfg->exists('a.b'), 1, 'flatten: exists() returns 1 for present dotted key');
	is($cfg->exists('a'),   0, 'flatten: exists() returns 0 for bare parent in flat hash');
};

# ===========================================================================
# env_prefix edge cases
# ===========================================================================

subtest 'env_prefix: empty string does not crash constructor' => sub {
	# An empty prefix means the regex pattern matches all env vars.
	# This is an extreme use case; we verify it does not crash.
	local %ENV = %ENV;
	local @ARGV = ();

	my $cfg;
	eval {
		$cfg = Config::Abstraction->new(
			data        => { specific => 'value' },
			config_dirs => [],
			env_prefix  => '',
		);
	};
	ok(!$@, 'empty string env_prefix does not die in constructor');
};

subtest 'env_prefix: very long prefix string does not crash' => sub {
	my $long_prefix = 'A' x 1000 . '_';
	local %ENV = %ENV;
	local @ARGV = ();

	my $cfg;
	eval {
		$cfg = Config::Abstraction->new(
			data        => { x => 1 },
			config_dirs => [],
			env_prefix  => $long_prefix,
		);
	};
	ok(!$@, 'very long env_prefix does not crash constructor');
};

# ===========================================================================
# CONFIG_DIR environment variable
# ===========================================================================

subtest 'CONFIG_DIR env var overrides default config directory discovery' => sub {
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.yaml', "config_dir_env_canary: found_via_CONFIG_DIR\n");

	local %ENV = (%ENV, CONFIG_DIR => $dir);
	my $cfg;
	eval {
		$cfg = Config::Abstraction->new();
	};
	ok(!$@, 'CONFIG_DIR env var does not crash constructor');
	if(defined($cfg)) {
		is($cfg->get('config_dir_env_canary'), 'found_via_CONFIG_DIR',
			'config loaded from directory specified by CONFIG_DIR env var');
	} else {
		pass('constructor returned undef - CONFIG_DIR may have been overridden by other local config');
	}
};

# ===========================================================================
# INI format: multi-section and global-key edge cases
# ===========================================================================

subtest 'INI: multi-section file: each section becomes a nested hash' => sub {
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.ini',
		"[section1]\nkey1 = val1\n\n[section2]\nkey2 = val2\nshared = s2_val\n");

	my $cfg = Config::Abstraction->new(
		data        => {},
		config_dirs => [$dir],
	);
	ok(defined($cfg), 'multi-section INI file loaded successfully');
	is($cfg->get('section1.key1'), 'val1', 'section1.key1 accessible via dotted notation');
	is($cfg->get('section2.key2'), 'val2', 'section2.key2 accessible via dotted notation');
	is($cfg->get('section2.shared'), 's2_val', 'section2.shared accessible');
};

subtest 'INI: file with no sections (key=value only) does not crash' => sub {
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, 'base.ini', "global_key = global_val\n");

	my $cfg;
	_silenced(sub {
		eval {