Config-Abstraction

 view release on metacpan or  search on metacpan

t/extended_tests.t  view on Meta::CPAN

		data        => _fresh_data(),
		config_dirs => [],
	);
	my $merged = $cfg->merge_defaults(section => 'database');
	ok(defined($merged), 'merge_defaults with only section does not crash');
};

# ===========================================================================
# ENV handling branch coverage
# ===========================================================================

# Exercise env_prefix with :: suffix (Perl package-style prefix)
subtest 'ENV - :: suffix in env_prefix stripped correctly' => sub {
	local %ENV = %ENV;
	$ENV{'MyApp::TIMEOUT'} = $EXPECTED_TIMEOUT;

	my $cfg = Config::Abstraction->new(
		data        => { MyApp => { timeout => 99 } },
		config_dirs => [],
		env_prefix  => 'MyApp::',
	);
	ok(defined($cfg), 'Perl-style :: env_prefix accepted');
};

# Exercise env_prefix with __ suffix
subtest 'ENV - __ suffix in env_prefix stripped correctly' => sub {
	local %ENV = %ENV;
	$ENV{"EXTAPP__RETRIES"} = '77';

	my $cfg = Config::Abstraction->new(
		data        => { EXTAPP => { retries => $EXPECTED_RETRIES } },
		config_dirs => [],
		env_prefix  => 'EXTAPP__',
	);
	ok(defined($cfg), 'double-underscore env_prefix accepted');
};

# Exercise the branch where ENV key has no sub-path (just prefix match)
subtest 'ENV - prefix-only match with no remaining path handled' => sub {
	local %ENV = %ENV;
	# Key is exactly the prefix with nothing after it
	$ENV{$ENV_PREFIX} = 'bare_prefix';

	my $cfg;
	eval {
		$cfg = Config::Abstraction->new(
			data        => { key => 'value' },
			config_dirs => [],
			env_prefix  => $ENV_PREFIX,
		);
	};
	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');
};

# ===========================================================================
# Logger branch coverage
# ===========================================================================

# Exercise the logger with a filename (Log::Abstraction wraps it)
subtest 'logger - filename logger accepted' => sub {
	test_needs 'Log::Abstraction';
	my $dir = tempdir(CLEANUP => 1);
	my $logfile = File::Spec->catfile($dir, 'test.log');

	my $cfg;
	eval {
		$cfg = Config::Abstraction->new(
			data        => _fresh_data(),
			config_dirs => [],
			logger      => $logfile,
		);
	};
	ok(!$@,        'filename logger does not crash');
	ok(defined($cfg), 'object created with filename logger');
};

# Exercise the level option with a logger
subtest 'logger - level option applied to logger when supported' => sub {
	test_needs 'Log::Abstraction';
	my @log;
	my $cfg = Config::Abstraction->new(
		data        => _fresh_data(),
		config_dirs => [],
		logger      => \@log,
		level       => 'debug',
	);
	ok(defined($cfg), 'object created with logger and level');
};

# Line 410 A-true-B-false: level param IS set but the logger has no 'level' method.
# The spy logger has trace/debug/info/notice/warn/error but NOT level →
# $params->{'level'} is truthy AND $self->{'logger'}->can('level') is FALSE.
subtest 'logger - level param set but logger lacks level method: line 410 A-true-B-false' => sub {
	my ($logger, $log_ref) = _make_spy_logger();
	# Spy logger does not have a 'level' method, so can('level') returns false
	ok(!$logger->can('level'), 'spy logger has no level method (precondition)');

	my $cfg;
	_silenced(sub {
		$cfg = Config::Abstraction->new(
			data        => _fresh_data(),
			config_dirs => [],
			logger      => $logger,
			level       => 'debug',    # A=true: level param IS set
			# B=false: logger->can('level') is FALSE

t/extended_tests.t  view on Meta::CPAN

	# Trigger _load_data_reuse via get() on a hashref-valued key
	my $result = $cfg->get('db');

	is($cfg->{reuse_failed}, 1, 'reuse_failed flag set when Data::Reuse unavailable');
	ok(defined($result),         'get() still returns value despite Data::Reuse absence');
	is(ref($result), 'HASH',     'returned value is still a hashref');

	Test::Without::Module->unimport('Data::Reuse');
};

# ===========================================================================
# _parse_config_string() XML branch via TestProxy
# ===========================================================================

# The XML elsif in _parse_config_string (line 1290-1298) has 0 coverage hits
# because function.t exercises YAML/JSON/INI but not XML via that method.
subtest '_parse_config_string() - XML content parsed via XML::Simple or XML::PP' => sub {
	my $proxy = Config::Abstraction::ExtTestProxy->new(
		data        => { dummy => 1 },
		config_dirs => [],
	);
	my $xml = "<?xml version=\"1.0\"?><config><server>prod</server><port>8080</port></config>";
	my $result = $proxy->test_parse_string($xml, 'remote.xml', 'remote-label');
	ok(defined($result),          'XML content in _parse_config_string returns defined');
	is(ref($result), 'HASH',      'XML result is a hashref');
	is($result->{server}, 'prod', 'XML string value correct');
	diag("xml result: server=$result->{server}") if $ENV{TEST_VERBOSE} && defined($result);
};

# ===========================================================================
# _load_driver() -- cached failure path (return 0 from negative cache)
# ===========================================================================

# After _load_driver fails for a module once, subsequent calls must return 0
# (the negative-cache path at line 995) rather than retrying the require.
# The FIRST failure returns undef; only the SECOND returns the explicit 0.
subtest '_load_driver() - returns 0 from negative cache on repeated failure' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { k => 'v' },
		config_dirs => [],
	);
	# First call: module does not exist → require fails → sets failed cache → returns undef
	my $first = $cfg->_load_driver('No::Such::Module::AtAll::XYZZY9876');
	ok(!defined($first) || !$first, 'first call returns false on load failure');
	is($cfg->{failed}{'No::Such::Module::AtAll::XYZZY9876'}, 1, 'failure cached');

	# Second call: negative cache hit → returns explicit 0 (not undef)
	my $second = $cfg->_load_driver('No::Such::Module::AtAll::XYZZY9876');
	is($second, 0, 'second call returns 0 from negative cache');
};

# ===========================================================================
# 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)
subtest 'new() - returns defined object when in-memory data is provided' => sub {
	# With data arg, config is always non-empty → line 422 TRUE → returns $self
	my $cfg = Config::Abstraction->new(
		data        => { alive => 1 },
		config_dirs => [],
	);
	ok(defined($cfg), 'constructor returns defined object with in-memory data');
	is($cfg->get('alive'), 1, 'in-memory data accessible');
};

# ===========================================================================
# _parse_remote_dir() -- branch coverage for $2 // '/' fallback (line 1154)
# ===========================================================================

# `_parse_remote_dir` is NOT access-guarded, so it can be called directly.
# When the path has no directory component after the hostname (e.g., /../host),
# capture group $2 is undef → `$2 // '/'` returns '/' (line 1154 fallback).
subtest '_parse_remote_dir() - hostname with no path uses / as default' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { dummy => 1 },
		config_dirs => [],
	);
	# With path after hostname: $2 is defined
	my ($host, $dir) = $cfg->_parse_remote_dir('/../remotehost/etc/myapp');
	is($host, 'remotehost',  'hostname extracted from remote dir spec');
	is($dir,  '/etc/myapp',  'path component extracted correctly');

	# Without path after hostname: $2 is undef → $2 // '/' fires
	my ($host2, $dir2) = $cfg->_parse_remote_dir('/../remotehost');
	is($host2, 'remotehost', 'hostname extracted with no path component');
	is($dir2,  '/',          '$2 // "/" fallback: dir defaults to / when absent');
};

subtest '_parse_remote_dir() - non-remote path returns empty list' => sub {
	my $cfg = Config::Abstraction->new(
		data        => { dummy => 1 },
		config_dirs => [],
	);
	my @result = $cfg->_parse_remote_dir('/etc/myapp');
	is(scalar(@result), 0, 'non-remote path returns empty list');

	my @result2 = $cfg->_parse_remote_dir(undef);
	is(scalar(@result2), 0, 'undef path returns empty list');
};

# ===========================================================================
# AUTOLOAD data || config fallback (line 1339)
# ===========================================================================

# Line 1339: `my $data = $self->{data} || $self->{'config'}`.



( run in 1.223 second using v1.01-cache-2.11-cpan-a49fcb8fa48 )