Config-Abstraction
view release on metacpan or search on metacpan
use strict;
use warnings;
use Test::Most;
use File::Spec;
use File::Slurp qw(write_file);
use Test::TempDir::Tiny;
BEGIN { use_ok('Config::Abstraction') }
local @ARGV = ('--APP_foo=baz');
my $test_dir = tempdir();
write_file("$test_dir/base.yaml", <<'YAML');
---
foo: bar
YAML
my $config = Config::Abstraction->new(
config_dirs => [$test_dir],
env_prefix => 'APP_',
t/edge_cases.t view on Meta::CPAN
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');
};
# ===========================================================================
t/edge_cases.t view on Meta::CPAN
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');
t/edge_cases.t view on Meta::CPAN
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');
t/edge_cases.t view on Meta::CPAN
'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',
t/edge_cases.t view on Meta::CPAN
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');
t/edge_cases.t view on Meta::CPAN
# ===========================================================================
# 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
t/edge_cases.t view on Meta::CPAN
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,
);
t/edge_cases.t view on Meta::CPAN
};
# ===========================================================================
# 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');
t/extended_tests.t view on Meta::CPAN
};
ok(!$@, 'bare prefix ENV key does not crash');
};
# ===========================================================================
# CLI handling branch coverage
# ===========================================================================
# Exercise single-part CLI path (no double-underscore)
subtest 'CLI - single-part path sets top-level key' => sub {
local @ARGV = ("--${ENV_PREFIX}MODE=production");
my $cfg = Config::Abstraction->new(
data => { mode => 'development' },
config_dirs => [],
env_prefix => $ENV_PREFIX,
);
is($cfg->get('mode'), 'production', 'single-part CLI path sets key');
};
# Exercise multi-part CLI path (with double-underscore)
subtest 'CLI - three-part path creates two levels of nesting' => sub {
local @ARGV = ("--${ENV_PREFIX}DB__POOL__SIZE=20");
my $cfg = Config::Abstraction->new(
data => {
db => { pool => { size => 5 } },
},
config_dirs => [],
env_prefix => $ENV_PREFIX,
);
is($cfg->get('db.pool.size'), '20', 'three-part CLI path sets deeply nested key');
};
# Line 782 FALSE path: `$ref->{$_} //= {}` creates a new {} when the
# intermediate key did NOT pre-exist. Use a two-part ARGV key whose parent
# key is absent from the initial data → undef → {} created (FALSE path of //).
subtest 'CLI - multi-level key creates intermediate hash when absent (line 782 false)' => sub {
# Key BRAND_NEW__VALUE has no pre-existing 'brand_new' in data
local @ARGV = ("--${ENV_PREFIX}BRAND_NEW__VALUE=42");
my $cfg = Config::Abstraction->new(
data => { existing => 'yes' }, # 'brand_new' key is ABSENT
config_dirs => [],
env_prefix => $ENV_PREFIX,
);
ok(defined($cfg), 'object created with absent intermediate key');
# The intermediate 'brand_new' hash should have been created automatically
my $brand_new = $cfg->get('brand_new');
ok(defined($brand_new) && ref($brand_new) eq 'HASH', 'intermediate hash auto-created')
or diag('brand_new: ', defined($brand_new) ? "$brand_new" : 'undef');
is($brand_new->{'value'}, '42', 'nested value accessible after auto-create');
};
# Exercise the branch where @ARGV has non-option entries mixed in
subtest 'CLI - non-option ARGV entries ignored' => sub {
local @ARGV = ('positional', "--${ENV_PREFIX}RETRIES=5", '--', 'another');
my $cfg = Config::Abstraction->new(
data => { retries => $EXPECTED_RETRIES },
config_dirs => [],
env_prefix => $ENV_PREFIX,
);
is($cfg->get('retries'), '5', 'option processed among non-option ARGV entries');
};
# ===========================================================================
t/extended_tests.t view on Meta::CPAN
# ===========================================================================
# Constructor returns undef when no configuration is loaded (line 422 false)
# ===========================================================================
# When no data is passed AND config_dirs is empty (no files to load),
# the merged config is empty → `scalar(keys %{config})` == 0 →
# the condition at line 422 is FALSE → the constructor returns undef.
subtest 'new() - returns undef when no config data found' => sub {
# Isolate @ARGV and %ENV to prevent any accidental config injection
local @ARGV;
local %ENV = (PATH => $ENV{PATH}); # keep PATH, strip APP_* and others
# No data arg, no config files; config_dirs = [] so no files are searched
my $cfg = Config::Abstraction->new(config_dirs => []);
ok(!defined($cfg), 'constructor returns undef when no configuration data found');
};
# Similarly: constructor returns undef when only config_dirs is absent key=
# (calling new without any arguments at all uses default dirs, but if those
# dirs don't exist on this machine, config will be empty)
t/function.t view on Meta::CPAN
config_dirs => [],
env_prefix => $ENV_PREFIX,
);
is($cfg->get('database.user'), 'env_user', 'double-underscore ENV creates nested key');
};
# ===========================================================================
# Command-line argument merging (via _load_config internals)
# ===========================================================================
subtest 'CLI args override data values' => sub {
local @ARGV = ("--TESTAPP_RETRIES=77");
my $cfg = Config::Abstraction->new(
data => { retries => $EXPECTED_RETRIES },
config_dirs => [],
env_prefix => $ENV_PREFIX,
);
is($cfg->get('retries'), '77', 'CLI arg overrides data value');
};
subtest 'CLI args with double-underscore create nested keys' => sub {
# \%NESTED_DATA must not be used here - the CLI merge path modifies nested
# hashrefs in-place via shared references from the shallow copy of 'data',
# which would attempt to modify the Readonly nested hashrefs and die.
# Use a fresh anonymous hash instead so the merge can write freely.
local @ARGV = ('--TESTAPP_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');
t/function.t view on Meta::CPAN
subtest '_value_from_type() - (1, value) for data-sourced key' => sub {
my $cfg = _make_cfg();
my ($found, $val) = $cfg->_value_from_type('data', 'retries');
is($found, 1, 'found=1');
is($val, $EXPECTED_RETRIES, 'correct value');
};
subtest '_value_from_type() - (0, undef) when type did not contribute' => sub {
# No CLI args in @ARGV, so argv layer should not have contributed
local @ARGV = ();
my $cfg = _make_cfg();
my ($found, $val) = $cfg->_value_from_type('argv', 'retries');
ok(!$found, 'found is false when argv did not set the key');
ok(!defined($val), 'val=undef when argv did not contribute');
};
subtest '_value_from_type() - normalises sep_char to dot before lookup' => sub {
# Source records always use '.' regardless of sep_char.
# _value_from_type must translate sep_char-separated keys before searching.
my $cfg = Config::Abstraction->new(
t/function.t view on Meta::CPAN
config_dirs => [$dir],
);
is($cfg->prefer_data('only_in_file'), 'yes',
'prefer_data falls back to get() for key not in data layer');
};
subtest 'prefer_env() - returns env value, not higher-priority argv override' => sub {
local %ENV = %ENV;
delete $ENV{APP_DATABASE__HOST};
$ENV{APP_DATABASE__HOST} = 'env-host';
local @ARGV = ('--APP_DATABASE__HOST=argv-host');
my $cfg = Config::Abstraction->new(
data => { database => { host => 'default' } },
config_dirs => [],
env_prefix => 'APP_',
);
is($cfg->prefer_env('database.host'), 'env-host',
'prefer_env returns env value, bypassing argv');
is($cfg->get('database.host'), 'argv-host',
'get() confirms argv wins in merged config');
t/function.t view on Meta::CPAN
subtest 'prefer_env() - falls back to get() when no env contributed' => sub {
local %ENV = %ENV;
delete $ENV{APP_RETRIES};
my $cfg = _make_cfg();
is($cfg->prefer_env('retries'), $EXPECTED_RETRIES,
'prefer_env falls back to get() when env did not contribute');
};
subtest 'prefer_argv() - returns argv value when CLI arg provided' => sub {
local @ARGV = ('--APP_DATABASE__HOST=argv-host');
local %ENV = %ENV;
delete $ENV{APP_DATABASE__HOST};
my $cfg = Config::Abstraction->new(
data => { database => { host => 'default' } },
config_dirs => [],
env_prefix => 'APP_',
);
is($cfg->prefer_argv('database.host'), 'argv-host',
'prefer_argv returns argv-layer value');
};
subtest 'prefer_argv() - falls back to get() when no argv contributed' => sub {
local @ARGV = ();
my $cfg = _make_cfg();
is($cfg->prefer_argv('retries'), $EXPECTED_RETRIES,
'prefer_argv falls back to get() when @ARGV did not contribute');
};
subtest 'prefer_file() - returns file value when a file set the key' => sub {
plan skip_all => 'requires filesystem' if $^O eq 'MSWin32';
require File::Temp;
my $dir = File::Temp::tempdir(CLEANUP => 1);
open my $fh, '>', "$dir/base.yaml" or die;
t/integration.t view on Meta::CPAN
is($cfg->get('database.user'), $OVERRIDE_USER, 'INI database.user loaded');
is($cfg->get('database.port'), $OVERRIDE_PORT, 'INI database.port loaded');
};
# ===========================================================================
# Full merge precedence stack: data < file < ENV < CLI
# ===========================================================================
subtest 'end-to-end: full merge precedence stack' => sub {
local %ENV = %ENV;
local @ARGV = ("--${ENV_PREFIX}DATABASE__USER=cli_user");
$ENV{"${ENV_PREFIX}DATABASE__PORT"} = $OVERRIDE_PORT;
my $dir = tempdir(CLEANUP => 1);
_write_file($dir, $YAML_BASE,
"database:\n user: file_user\n port: $EXPECTED_PORT\n host: $EXPECTED_HOST\n");
my $cfg = new_ok($MODULE => [
data => _fresh_data(),
config_dirs => [$dir],
env_prefix => $ENV_PREFIX,
t/integration.t view on Meta::CPAN
# explain_sources() integration: full multi-layer audit trail
#
# Three or more sources contribute to the same key. The method must return
# each layer in the correct order (lowest to highest precedence) with the
# mandatory type, label, and value fields on every record.
# ===========================================================================
subtest 'end-to-end: explain_sources() tracks all source layers for a key' => sub {
# data (lowest) < file < env < argv (highest) all set database.user
local %ENV = %ENV;
local @ARGV = ("--${ENV_PREFIX}DATABASE__USER=cli_user");
$ENV{"${ENV_PREFIX}DATABASE__USER"} = 'env_user';
my $dir = tempdir(CLEANUP => 1);
_write_file($dir, $YAML_BASE, "database:\n user: file_user\n host: $EXPECTED_HOST\n");
my $cfg = new_ok($MODULE => [
data => { database => { user => $EXPECTED_USER } },
config_dirs => [$dir],
env_prefix => $ENV_PREFIX,
]);
t/integration.t view on Meta::CPAN
# ===========================================================================
# prefer_*() methods: bypass higher-priority sources
#
# All four sources contribute to database.user; each prefer_* must return
# the value from its own layer, falling back to get() when absent.
# ===========================================================================
subtest 'end-to-end: prefer_*() returns layer-specific value for a fully-stacked key' => sub {
local %ENV = %ENV;
local @ARGV = ("--${ENV_PREFIX}DATABASE__USER=cli_user");
$ENV{"${ENV_PREFIX}DATABASE__USER"} = 'env_user';
my $dir = tempdir(CLEANUP => 1);
_write_file($dir, $YAML_BASE, "database:\n user: file_user\n");
my $cfg = Config::Abstraction->new(
data => { database => { user => $EXPECTED_USER } },
config_dirs => [$dir],
env_prefix => $ENV_PREFIX,
);
t/integration.t view on Meta::CPAN
is($cfg->prefer_file('database.user'), 'file_user', 'prefer_file() bypasses env and argv');
is($cfg->prefer_data('database.user'), $EXPECTED_USER, 'prefer_data() bypasses all layers');
is($cfg->prefer_argv('database.user'), 'cli_user', 'prefer_argv() returns CLI value');
};
subtest 'end-to-end: prefer_*() falls back to get() when source did not contribute' => sub {
my $dir = tempdir(CLEANUP => 1);
_write_file($dir, $YAML_BASE, "level: $EXPECTED_LEVEL\n");
local %ENV = %ENV;
local @ARGV = ();
my $cfg = Config::Abstraction->new(
data => { other => 'value' },
config_dirs => [$dir],
env_prefix => $ENV_PREFIX,
);
# level came only from file; prefer_env/data/argv all fall back to get()
is($cfg->prefer_env('level'), $EXPECTED_LEVEL, 'prefer_env falls back to get()');
is($cfg->prefer_data('level'), $EXPECTED_LEVEL, 'prefer_data falls back to get()');
is($cfg->prefer_argv('level'), $EXPECTED_LEVEL, 'prefer_argv falls back to get()');
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'};
# ===========================================================================
# 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'};
'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
# ===========================================================================
( run in 1.468 second using v1.01-cache-2.11-cpan-5c0b1e786e0 )