view release on metacpan or  search on metacpan

t/unit.t  view on Meta::CPAN

	is($cfg->retries(), $EXPECTED_RETRIES, 'AUTOLOAD top-level key with default sep_char');
	delete $ledger{'AUTOLOAD: default sep_char direct key access'};
};

# ===========================================================================
# Environment variable overrides
# POD: APP_DATABASE__USER becomes database.user
# ===========================================================================

subtest 'ENV double-underscore creates nested key' => sub {
	# POD: APP_DATABASE__USER becomes database.user (nested structure)
	local %ENV = %ENV;
	$ENV{"${ENV_PREFIX}DATABASE__USER"} = 'env_user';
	my $cfg = Config::Abstraction->new(
		data => {
			database => { user => $EXPECTED_USER, pass => $EXPECTED_PASS },
		},
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('database.user'), 'env_user', 'ENV double-underscore overrides nested key');
	delete $ledger{'ENV: double-underscore creates nested key'};
};

subtest 'ENV single segment stored under prefix namespace' => sub {
	# POD: APP_LOGLEVEL becomes APP.loglevel (flat under prefix namespace)
	local %ENV = %ENV;
	(my $prefix_bare = $ENV_PREFIX) =~ s/_$//;	# strip trailing underscore
	$ENV{"${ENV_PREFIX}RETRIES"} = '99';
	my $cfg = Config::Abstraction->new(
		data => {
			$prefix_bare => { retries => $EXPECTED_RETRIES },
			retries      => $EXPECTED_RETRIES,
		},
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get("${prefix_bare}.retries"), '99', 'single-segment ENV stored under prefix namespace');
	delete $ledger{'ENV: single segment stored under prefix namespace'};
};

subtest 'ENV mixed double-underscore and single underscore in key' => sub {
	# POD: APP_API__RATE_LIMIT becomes api.rate_limit
	local %ENV = %ENV;
	$ENV{"${ENV_PREFIX}API__RATE_LIMIT"} = '100';
	my $cfg = Config::Abstraction->new(
		data        => { api => { rate_limit => 50 } },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('api.rate_limit'), '100', 'mixed underscore/double-underscore ENV key handled');
	delete $ledger{'ENV: mixed underscore in key'};
};

# ===========================================================================
# Command-line argument overrides
# POD: --APP_DATABASE__USER=other_user_name overrides database.user
# ===========================================================================

subtest 'CLI arg overrides top-level key' => sub {
	local @ARGV = ("--${ENV_PREFIX}RETRIES=77");
	my $cfg = Config::Abstraction->new(
		data        => _fresh_data(),
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('retries'), '77', 'CLI arg overrides top-level key');
	delete $ledger{'CLI: overrides top-level key'};
};

subtest 'CLI double-underscore creates nested key' => sub {
	local @ARGV = ("--${ENV_PREFIX}DATABASE__USER=cli_user");
	my $cfg = Config::Abstraction->new(
		data => {
			database => { user => $EXPECTED_USER, pass => $EXPECTED_PASS },
			retries  => $EXPECTED_RETRIES,
		},
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('database.user'), 'cli_user', 'CLI double-underscore creates nested key');
	delete $ledger{'CLI: double-underscore creates nested key'};
};

subtest 'CLI arg without matching prefix is ignored' => sub {
	local @ARGV = ('--OTHERAPP_RETRIES=999');
	my $cfg = Config::Abstraction->new(
		data        => _fresh_data(),
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('retries'), $EXPECTED_RETRIES, 'non-matching prefix CLI arg ignored');
	delete $ledger{'CLI: non-matching prefix ignored'};
};

subtest 'CLI arg without = sign is ignored' => sub {
	# The module skips @ARGV entries that contain no '='
	local @ARGV = ("--${ENV_PREFIX}RETRIES");
	my $cfg = Config::Abstraction->new(
		data        => _fresh_data(),
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('retries'), $EXPECTED_RETRIES, 'CLI arg without = is ignored');
	delete $ledger{'CLI: arg without = ignored'};
};

# ===========================================================================
# Merge precedence
# POD: CLI args > Environment > Config file > Defaults (in-memory data)
# ===========================================================================

subtest 'merge precedence: CLI overrides ENV overrides data' => sub {
	local %ENV = %ENV;
	local @ARGV = ("--${ENV_PREFIX}DATABASE__USER=cli_user");
	$ENV{"${ENV_PREFIX}DATABASE__USER"} = 'env_user';
	my $cfg = Config::Abstraction->new(
		data => {
			database => { user => $EXPECTED_USER, pass => $EXPECTED_PASS },
		},
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('database.user'), 'cli_user', 'CLI takes highest precedence');
	delete $ledger{'precedence: CLI > ENV > data'};
};

subtest 'merge precedence: ENV overrides data' => sub {
	local %ENV = %ENV;
	$ENV{"${ENV_PREFIX}DATABASE__USER"} = 'env_user';
	my $cfg = Config::Abstraction->new(
		data => {
			database => { user => $EXPECTED_USER, pass => $EXPECTED_PASS },
		},
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->get('database.user'), 'env_user', 'ENV overrides data defaults');
	delete $ledger{'precedence: ENV > data'};
};

subtest 'merge precedence: config file overrides data' => sub {
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, $YAML_FILENAME, "retries: 99\n");
	my $cfg = Config::Abstraction->new(
		data        => { retries => $EXPECTED_RETRIES },
		config_dirs => [$dir],
	);
	is($cfg->get('retries'), 99, 'config file overrides data defaults');
	delete $ledger{'precedence: file > data'};
};

# ===========================================================================
# Global state integrity
# Methods must not clobber $@, $!, or $_ after object construction
# ===========================================================================

subtest 'global state: get() does not clobber $@' => sub {
	my $cfg = _make_cfg();
	eval { die 'sentinel_error' };
	my $err_before = $@;
	$cfg->get('database.user');
	is($@, $err_before, 'get() does not clobber $@');
	delete $ledger{'global-state: get() does not clobber dollar-at'};
};

subtest 'global state: exists() does not clobber $@' => sub {
	my $cfg = _make_cfg();
	eval { die 'sentinel_error' };
	my $err_before = $@;
	$cfg->exists('database.user');
	is($@, $err_before, 'exists() does not clobber $@');
	delete $ledger{'global-state: exists() does not clobber dollar-at'};
};

t/unit.t  view on Meta::CPAN

	my $es  = $cfg->explain_sources();
	my $src = $es->{'database.user'}{sources};
	ok(defined($src),               'sources field defined');
	is(ref($src), 'ARRAY',          'sources is an arrayref');
	ok(scalar(@{$src}) >= 2,        'at least two sources (data + env)');
	is($src->[0]{type}, 'data',     'lowest source is data');
	is($src->[-1]{type}, 'env',     'highest (winning) source is env');
	delete $ledger{'explain_sources: sources arrayref ordered lowest first'};
};

subtest 'explain_sources() - data source has correct type and label' => sub {
	my $cfg = _make_cfg();
	my $es  = $cfg->explain_sources();
	my ($data_src) = grep { $_->{type} eq 'data' } @{$es->{retries}{sources}};
	ok(defined($data_src),                   'data source entry present');
	is($data_src->{type},  'data',           'type field is "data"');
	like($data_src->{label}, qr/constructor data argument/, 'label identifies data source');
	is($data_src->{value}, $EXPECTED_RETRIES,'data source value correct');
	delete $ledger{'explain_sources: data source has correct type and label'};
};

subtest 'explain_sources() - env source has correct type and label' => sub {
	# Use double-underscore so the env var maps directly to the dotted key database.user.
	local %ENV = %ENV;
	$ENV{"${ENV_PREFIX}DATABASE__USER"} = 'env_alice';
	my $cfg = Config::Abstraction->new(
		data        => { database => { user => $EXPECTED_USER } },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	my $es = $cfg->explain_sources();
	my ($env_src) = grep { $_->{type} eq 'env' } @{$es->{'database.user'}{sources}};
	ok(defined($env_src),                 'env source entry present');
	is($env_src->{type},  'env',          'type field is "env"');
	like($env_src->{label}, qr/DATABASE/, 'label contains the env var name');
	is($env_src->{value}, 'env_alice',    'env source value correct');
	delete $ledger{'explain_sources: env source has correct type and label'};
};

subtest 'explain_sources() - file source recorded with type "file"' => sub {
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, $YAML_FILENAME, "timeout: $EXPECTED_TIMEOUT\n");
	my $cfg = Config::Abstraction->new(config_dirs => [$dir]);
	my $es  = $cfg->explain_sources();
	my ($file_src) = grep { $_->{type} eq 'file' } @{$es->{timeout}{sources}};
	ok(defined($file_src),           'file source entry present');
	is($file_src->{type}, 'file',    'type field is "file"');
	diag('file label: ' . ($file_src->{label} // 'undef')) if $ENV{TEST_VERBOSE};
	delete $ledger{'explain_sources: file source has correct type'};
};

# ===========================================================================
# prefer_env(key)
# POD: returns env-layer value, or get(key) if no env var contributed
# ===========================================================================

subtest 'prefer_env() - returns env-layer value when env variable contributed' => sub {
	# Use double-underscore so the env var maps directly to database.user.
	# Also set a CLI arg at higher precedence; prefer_env must bypass it.
	local %ENV = %ENV;
	local @ARGV = ("--${ENV_PREFIX}DATABASE__USER=cli_user");
	$ENV{"${ENV_PREFIX}DATABASE__USER"} = 'env_user';
	my $cfg = Config::Abstraction->new(
		data        => { database => { user => $EXPECTED_USER } },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	# get() returns cli_user (highest precedence), prefer_env must return env_user.
	is($cfg->prefer_env('database.user'), 'env_user',
		'prefer_env returns env-layer value bypassing argv');
	delete $ledger{'prefer_env: returns env value when env contributed'};
};

subtest 'prefer_env() - falls back to get() when no env variable set the key' => sub {
	local %ENV = %ENV;
	delete $ENV{"${ENV_PREFIX}DATABASE__USER"};
	my $cfg = Config::Abstraction->new(
		data        => { database => { user => $EXPECTED_USER } },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->prefer_env('database.user'), $EXPECTED_USER,
		'prefer_env falls back to get() when no env var contributed');
	delete $ledger{'prefer_env: falls back to get() when env absent'};
};

# ===========================================================================
# prefer_file(key)
# POD: returns file-layer value, or get(key) if no file contributed
# ===========================================================================

subtest 'prefer_file() - returns file-layer value when a file set the key' => sub {
	# Set up env and file both contributing; prefer_file must return the file value.
	local %ENV = %ENV;
	$ENV{"${ENV_PREFIX}TIMEOUT"} = 'env_val';
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, $YAML_FILENAME, "timeout: $EXPECTED_TIMEOUT\n");
	my $cfg = Config::Abstraction->new(
		config_dirs => [$dir],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->prefer_file('timeout'), $EXPECTED_TIMEOUT,
		'prefer_file returns file-layer value bypassing env');
	delete $ledger{'prefer_file: returns file value when file contributed'};
};

subtest 'prefer_file() - falls back to get() when no file set the key' => sub {
	my $cfg = _make_cfg();    # config_dirs => [] means no files loaded
	# 'retries' came only from data; prefer_file falls back to get()
	is($cfg->prefer_file('retries'), $EXPECTED_RETRIES,
		'prefer_file falls back to get() when no file contributed');
	delete $ledger{'prefer_file: falls back to get() when no file'};
};

# ===========================================================================
# prefer_data(key)
# POD: returns data-constructor value, or get(key) if data did not set it
# ===========================================================================

subtest 'prefer_data() - returns data-constructor value bypassing env override' => sub {
	local %ENV = %ENV;
	$ENV{"${ENV_PREFIX}RETRIES"} = '99';
	my $cfg = Config::Abstraction->new(
		data        => { retries => $EXPECTED_RETRIES },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	# get() returns '99' (env wins), but prefer_data must return the original data value.
	is($cfg->prefer_data('retries'), $EXPECTED_RETRIES,
		'prefer_data returns data-constructor value despite env override');
	delete $ledger{'prefer_data: returns data value when data contributed'};
};

subtest 'prefer_data() - falls back to get() when data did not set the key' => sub {
	my $dir = tempdir(CLEANUP => 1);
	_write_file($dir, $YAML_FILENAME, "fileonly: from_file\n");
	my $cfg = Config::Abstraction->new(
		data        => { other => 'x' },
		config_dirs => [$dir],
	);
	# 'fileonly' was never in the data arg; prefer_data falls back to get()
	is($cfg->prefer_data('fileonly'), 'from_file',
		'prefer_data falls back to get() when data did not set the key');
	delete $ledger{'prefer_data: falls back to get() when data absent'};
};

# ===========================================================================
# prefer_argv(key)
# POD: returns argv-layer value, or get(key) when no CLI arg set the key
# ===========================================================================

subtest 'prefer_argv() - returns argv-layer value when CLI arg contributed' => sub {
	local @ARGV = ("--${ENV_PREFIX}RETRIES=argv_val");
	my $cfg = Config::Abstraction->new(
		data        => { retries => $EXPECTED_RETRIES },
		config_dirs => [],
		env_prefix  => $ENV_PREFIX,
	);
	is($cfg->prefer_argv('retries'), 'argv_val',
		'prefer_argv returns the argv-layer value');
	delete $ledger{'prefer_argv: returns argv value when argv contributed'};
};

subtest 'prefer_argv() - falls back to get() when no CLI arg set the key' => sub {
	local @ARGV = ();
	my $cfg = _make_cfg();
	is($cfg->prefer_argv('retries'), $EXPECTED_RETRIES,
		'prefer_argv falls back to get() when no CLI arg contributed');
	delete $ledger{'prefer_argv: falls back to get() when no argv'};
};

# ===========================================================================
# encrypt_value($plaintext)
# POD: requires CryptX; croaks when no key configured; returns ENC[AES256GCM,...] token
# ===========================================================================

Readonly::Scalar my $HEX_KEY => 'a' x 64;    # 64 hex chars = 32-byte AES-256 key

subtest 'encrypt_value() - croaks when no encryption key is configured' => sub {
	# POD: "<class>: no encryption key configured ..." croak
	my $cfg = _make_cfg();
	throws_ok { $cfg->encrypt_value('secret') }
		qr/no encryption key configured/,
		'encrypt_value croaks with no key configured';
	delete $ledger{'encrypt_value: croaks with no encryption key configured'};
};

SKIP: {
	skip 'CryptX (Crypt::AuthEnc::GCM) not installed', 1
		unless eval { require Crypt::AuthEnc::GCM; 1 };

	subtest 'encrypt_value() - returns a well-formed ENC[AES256GCM,...] token' => sub {
		# POD: "return ENC[AES256GCM,<base64url(nonce+ciphertext+tag)>]"
		my $cfg = Config::Abstraction->new(
			data           => {},
			config_dirs    => [],
			encryption_key => $HEX_KEY,
			lazy           => 1,
		);
		my $token = $cfg->encrypt_value('plaintext_secret');
		like($token, qr/^ENC\[AES256GCM,[A-Za-z0-9_-]+\]$/,
			'token has expected ENC[AES256GCM,...] format');
		# Each call uses a fresh nonce, so the same plaintext produces different tokens.
		my $token2 = $cfg->encrypt_value('plaintext_secret');
		isnt($token, $token2, 'consecutive calls produce distinct tokens (fresh nonce)');
	};
}
# Ledger delete is outside the SKIP block: the entry is removed whether or not
# CryptX is installed, so the ledger assertion never fails on machines without it.
delete $ledger{'encrypt_value: returns ENC[AES256GCM,...] token'};

# ===========================================================================
# Ledger assertion - every documented POD state must have been exercised
# ===========================================================================

my @uncovered = sort keys %ledger;
if(@uncovered) {
	fail('Untested POD-documented states remain in ledger: ' . scalar(@uncovered));
	diag("  UNCOVERED: $_") for @uncovered;
} else {
	pass('All documented POD API states covered by ledger');
}

done_testing();