File Coverage

File:blib/lib/Config/Abstraction.pm
Coverage:89.1%

linestmtbrancondsubtimecode
1package Config::Abstraction;
2
3
18
18
18
2073243
16
201
use strict;
4
18
18
18
23
18
333
use warnings;
5
6
18
18
18
29
12
455
use Carp;
7
18
18
18
26
18
473
use JSON::MaybeXS 'decode_json';        # Doesn't behave well with require
8
18
18
18
2123
59142
449
use File::Slurp qw(read_file);
9
18
18
18
32
15
185
use File::Spec;
10
18
18
18
3046
54893
523
use Hash::Merge qw(merge);
11
18
18
18
2996
188375
430
use Params::Get 0.15;
12
18
18
18
4493
229645
381
use Params::Validate::Strict 0.37;
13
18
18
18
41
16
211
use Scalar::Util;
14
18
18
18
26
12
74956
use Readonly;
15
16# AES-256-GCM constants — do not change without updating _decrypt_enc_value and encrypt_value
17Readonly::Scalar my $_AES_NONCE_SIZE  => 12; # GCM standard nonce length in bytes
18Readonly::Scalar my $_AES_TAG_SIZE    => 16; # GCM authentication tag length in bytes
19Readonly::Scalar my $_AES_KEY_SIZE    => 32; # AES-256 key length in bytes
20Readonly::Scalar my $_ENC_PAYLOAD_MIN => 28; # shortest valid payload: nonce(12) + tag(16)
21Readonly::Scalar my $_HEX_KEY_LEN     => 64; # 32 bytes expressed as hexadecimal
22Readonly::Scalar my $_B64_KEY_MIN     => 43; # minimum base64/base64url chars for 32 bytes
23Readonly::Scalar my $_B64_KEY_MAX     => 44; # maximum base64/base64url chars for 32 bytes
24
25
26 - 34
=head1 NAME

Config::Abstraction - Merge and manage configuration data from different sources

=head1 VERSION

Version 0.40

=cut
35
36our $VERSION = '0.40';
37
38 - 672
=head1 SYNOPSIS

=head2 Pattern 1: Environment overrides file overrides in-code defaults

The most common pattern for twelve-factor-style apps.
The C<data> argument supplies defaults, a YAML file supplies site configuration,
and environment variables allow per-deployment overrides without touching any file.

  # config/base.yaml
  #   database:
  #     host: db.example.com
  #     port: 5432
  #     user: app

  use Config::Abstraction;

  my $config = Config::Abstraction->new(
      data        => { database => { host => 'localhost', port => 5432 } },
      config_dirs => ['config'],
      env_prefix  => 'APP_',
  );

  # In production, set APP_DATABASE__HOST=db.prod.example.com in the environment.
  # That silently overrides the file value, which in turn overrides the default.
  my $host = $config->get('database.host');
  my $port = $config->get('database.port');

=head2 Pattern 2: Command-line arguments override everything

Useful for CLI tools where operator flags must win over every other source.

  # Run as: myscript.pl --APP_LOGLEVEL=debug --APP_DATABASE__HOST=localhost

  use Config::Abstraction;

  my $config = Config::Abstraction->new(
      config_dirs => ['config'],
      env_prefix  => 'APP_',
  );

  # @ARGV is consumed and stripped during new(); the resulting config already
  # has cli-layer values at the highest precedence.
  my $loglevel = $config->get('loglevel');       # 'debug'  (from --APP_LOGLEVEL)
  my $db_host  = $config->get('database.host');  # 'localhost' (from --APP_DATABASE__HOST)

=head2 Pattern 3: Multi-file layering (base + local override)

Separates shared defaults from machine-specific tweaks.
Every developer has a C<base.yaml>; only the production server has C<local.yaml>.

  # config/base.yaml   -- checked into version control
  #   database:
  #     host: localhost
  #     user: dev
  #
  # config/local.yaml  -- NOT checked in; production only
  #   database:
  #     host: db.prod.example.com
  #     user: produser
  #     password: s3cr3t

  use Config::Abstraction;

  my $config = Config::Abstraction->new(
      config_dirs => ['config'],   # loads base.yaml then local.yaml
      env_prefix  => 'APP_',
  );

  # On a dev machine (no local.yaml): host='localhost', user='dev'
  # On the prod server:               host='db.prod.example.com', user='produser'
  my $db = $config->get('database.host');
  my $user = $config->get('database.user');

=head1 DESCRIPTION

C<Config::Abstraction> is a flexible configuration management layer that sits above C<Config::*> modules.
It provides a simple way to layer multiple configuration sources with predictable merge order.
It lets you define sources such as:

=over 4

=item * Perl hashes (in-memory defaults or dynamic values)

=item * Environment variables (with optional prefixes)

=item * Configuration files (YAML, JSON, INI, or plain key=value)

=item * Command-line arguments

=back

Sources are applied in the order they are provided. Later sources override
earlier ones unless a key is explicitly set to C<undef> in the later source.

In addition to using drivers to load configuration data from multiple file
formats (YAML, JSON, XML, and INI),
it also allows levels of configuration, each of which overrides the lower levels.
So, it also integrates environment variable
overrides and command line arguments for runtime configuration adjustments.
This module is designed to help developers manage layered configurations that can be loaded from files and overridden at run-time for debugging,
offering a modern, robust and dynamic approach
to configuration management.

=head2 Merge Precedence

Sources are applied in the order shown below.  Each row wins over every row
above it.  When the same key appears in multiple sources, the highest-priority
source always determines the final value - including when that value is C<undef>.

  Priority   Source                         Set with
  --------   ------                         --------
     1 (lo)  data constructor argument      data => { key => 'default' }
     2        base.*  config files          config/base.yaml, base.json, ...
     3        base.{env}.* config files     config/base.prod.yaml, ...
     4        local.* config files          config/local.yaml, local.json, ...
     5        local.{env}.* config files    config/local.prod.yaml, ...
     6        default / script-name files   config/default.yaml, myapp.yaml, ...
     7        config_file / config_files    config_file => '/etc/myapp.yaml'
     8        Environment variables         APP_DATABASE__HOST=db.prod.example.com
     9 (hi)  CLI arguments (@ARGV)          --APP_DATABASE__HOST=db.prod.example.com

The active environment is set by the C<environment> constructor option, or
auto-detected from C<{env_prefix}ENV> (e.g. C<APP_ENV>), C<PLACK_ENV>, or
C<NODE_ENV>.  When no environment is configured, rows 3 and 5 are skipped.

Within the file tier (rows 2-7), later files override earlier files using
C<Hash::Merge> LEFT_PRECEDENT: every key in the later file wins over the same
key in an earlier file, even when the later value is C<undef> (YAML C<~>).
Nested hashes are merged recursively, so a C<local.yaml> that only sets
C<database.host> will not erase C<database.port> from C<base.yaml>.

  Example - what wins for the key C<database.host> when APP_ENV=prod:

  data              =>  'localhost'              (overridden by base.yaml)
  base.yaml         =>  'db.example.com'         (overridden by base.prod.yaml)
  base.prod.yaml    =>  'db.prod.example.com'    (overridden by local.yaml)
  local.yaml        =>  'db.local.example.com'   (overridden by local.prod.yaml)
  local.prod.yaml   =>  'db.prod-local.example.com'  (overridden by $APP_DATABASE__HOST)
  $APP_DATABASE__HOST  =>  'db.override.example.com'    <-- this wins

=head2 KEY FEATURES

=over 4

=item * Multi-Format Support

Supports configuration files in YAML, JSON, XML, and INI formats.
Automatically merges configuration data from these different formats,
allowing hierarchical configuration management.

=item * Environment Variable Overrides

Allows environment variables to override values in the configuration files.
By setting environment variables with a specific prefix (default: C<APP_>),
values in the configuration files can be dynamically adjusted without modifying
the file contents.

=item * Flattened Configuration Option

Optionally supports flattening the configuration structure. This converts deeply
nested configuration keys into a flat key-value format (e.g., C<database.user>
instead of C<database-E<gt>{user}>). This makes accessing values easier for
applications that prefer flat structures or need compatibility with flat
key-value stores.

=item * Layered Configuration

Supports merging multiple layers of configuration files. For example, you can
have a C<base.yaml> configuration file that provides default values, and a
C<local.yaml> (or C<local.json>, C<local.xml>, etc.) file that overrides
specific values. This allows for environment-specific configurations while
keeping defaults intact.

=item * Merge Strategy

The module merges the configuration data intelligently, allowing values in more
specific files (like C<local.yaml>, C<local.json>, C<local.xml>, C<local.ini>)
to override values in base files. This enables a flexible and layered configuration
system where you can set defaults and override them for specific environments.

=item * Error Handling

Includes error handling for loading configuration files.
If any file fails to
load (e.g., due to syntax issues), the module will throw descriptive error
messages to help with debugging.

=item * Centralized Configuration Management

Supports remote configuration management files,
so that configuration on remote machines can be centrally managed.

=back

=head2 SUPPORTED FILE FORMATS

=over 4

=item * YAML (C<*.yaml>, C<*.yml>)

Loaded with C<YAML::XS>.

=item * JSON (C<*.json>)

Loaded with C<JSON::MaybeXS>.

=item * XML (C<*.xml>)

Loaded with C<XML::Simple> (preferred) or C<XML::PP> (fallback).

=item * INI (C<*.ini>)

Loaded with C<Config::IniFiles>.

=item * TOML (C<*.toml>)

Loaded with C<TOML::Tiny>, which implements TOML 1.0.  TOML is a good choice
for human-editable configuration because its syntax is unambiguous: all values
are typed, strings must be quoted, and nesting uses C<[section]> headers or
dotted keys rather than indentation.

  # Example: config/base.toml
  [database]
  host   = "db.example.com"
  port   = 5432
  user   = "app"

  [cache]
  ttl    = 300
  debug  = false

C<base.toml> and C<local.toml> are discovered automatically in C<config_dirs>;
C<local.toml> has higher precedence than C<base.toml>, following the same
layering rules as all other formats.  TOML is also tried as a fallback parser
in the all-parsers chain used for extensionless C<config_file> entries.

If C<TOML::Tiny> is not installed, TOML files are silently skipped with a
C<carp> warning.

=back

=head2 ENVIRONMENT VARIABLE HANDLING

Configuration values can be overridden via environment variables. Environment variables use double underscores (__) to denote nested configuration keys and single underscores remain as part of the key name under the prefix namespace.

For example:

  APP_DATABASE__USER becomes database.user (nested structure)

    $ export APP_DATABASE__USER="env_user"

will override any value set for `database.user` in the configuration files.

  APP_LOGLEVEL becomes APP.loglevel (flat under prefix namespace)

  APP_API__RATE_LIMIT becomes api.rate_limit (mixed usage)

This allows you to override both top-level and nested configuration values using environment variables.

Configuration values can be overridden via the command line (C<@ARGV>).
For instance, if you have a key in the configuration such as C<database.user>,
you can override it by adding C<"--APP_DATABASE__USER=other_user_name"> to the command line arguments.
This will override any value set for C<database.user> in the configuration files.

=head2 EXAMPLE CONFIGURATION FLOW

=over 4

=item 1. Data Argument

The data passed into the constructor via the C<data> argument is the starting point.
Essentially,
this contains the default values.

=item 2. Loading Files

The module then looks for configuration files in the specified directories.
It loads the following files in order of preference:
C<base.yaml>, C<local.yaml>, C<base.json>, C<local.json>, C<base.xml>,
C<local.xml>, C<base.ini>, and C<local.ini>.

If C<config_file> or C<config_files> is set, those files are loaded last.

If no C<config_dirs> is given, try hard to find the files in various places.

The value of C<config_dirs> can be overridden at runtime by the environment variable CONFIG_DIR
(note that is just one directory, hence it's CONFIG_DIR not CONFIG_DIRS).

=item 3. Merging and Resolving

The module merges the contents of these files, with more specific configurations
(e.g., C<local.*>) overriding general ones (e.g., C<base.*>).

=item 4. Environment Overrides

After loading and merging the configuration files,
the environment variables are
checked and used to override any conflicting settings.

=item 5. Command Line

Next, the command line arguments are checked and used to override any conflicting settings.

=item 6. Accessing Values

Values in the configuration can be accessed using a dotted notation
(e.g., C<'database.user'>), regardless of the file format used.

=back

=head1 METHODS

=head2 new

Constructor for creating a new configuration object.

Options:

=over 4

=item * C<config_dirs>

An arrayref of directories to look for configuration files
(default: C<$CONFIG_DIR>, C<$HOME/.conf>, C<$HOME/config>, C<$HOME/conf>, C<$DOCUMENT_ROOT/conf>, C<$DOCUMENT_ROOT/../conf>, C<conf>).

For centralised configuration management,
entries beginning with C</../> are treated as remote specifications using the
Newcastle Connection convention -- see L</Remote configuration directories (Newcastle Connection)>.

=item * C<config_file>

Points to a configuration file of any format.

=item * C<config_files>

An arrayref of files to look for in the configuration directories.
Put the more important files later,
since later files override earlier ones.

Considers the files C<default> and C<$script_name> before looking at C<config_file> and C<config_files>.

=item * C<data>

A hash ref of default data to prime the configuration with.
These are applied before loading
other sources and can be overridden by later sources or by explicitly passing
options directly to C<new>.

  $config = Config::Abstraction->new(
      data => {
          log_level => 'info',
          retries => 3,
      }
  );

=item * C<defaults>

A hash reference that provides default values for the object's own attributes (such as C<config_dirs>, C<logger>, C<flatten>, etc.).
If this option is supplied,
the object is initialized using the keys in this hash as the base;
any other options passed directly to C<new()> (aside from C<env_prefix>) are ignored.
This allows you to pre-define a standard configuration profile for the object itself.
Note that C<defaults> is distinct from the C<data> option - C<data> supplies the initial configuration values that will be merged with files, environment, and command line,
while C<defaults> sets the object's internal parameters.
The C<env_prefix> value,
if provided as a top-level argument,
still takes precedence over any C<env_prefix> that might exist inside the C<defaults> hash.

=item * C<encryption_key>

A 256-bit (32-byte) AES key used to transparently decrypt C<ENC[...]> values found in any
configuration source after the full merge.  The key may be supplied as:

=over 4

=item 32 raw bytes

=item 64 lowercase or uppercase hex characters

=item 44 Base64 or Base64url characters (standard or URL-safe alphabet, with or without trailing C<=>)

=back

If no key is configured (and neither C<encryption_key_file> nor the corresponding
environment variables are set), C<ENC[...]> tokens are left as literal strings.
Decryption requires L<CryptX> (C<Crypt::AuthEnc::GCM>); if that module is absent a
C<croak> is raised when an encrypted value is encountered.

See L</ENCRYPTED VALUES> for the full workflow.

=item * C<encryption_key_file>

Path to a file whose first line contains the encryption key in any of the formats accepted
by C<encryption_key>.  Takes precedence over the C<ENCRYPTION_KEY_FILE> and
C<{env_prefix}ENCRYPTION_KEY_FILE> environment variables, but is overridden by a key
supplied directly via C<encryption_key>.

=item * C<env_prefix>

A prefix for environment variable keys and comment line options, e.g. C<MYAPP_DATABASE__USER>,
(default: C<'APP_'>).

=item * C<environment>

The name of the active deployment environment (e.g. C<'dev'>, C<'staging'>, C<'prod'>).
When set, config files named C<base.{env}.*> are loaded immediately after their C<base.*>
equivalents, and C<local.{env}.*> files are loaded immediately after C<local.*> files,
giving two additional override tiers at no cost to the base configuration.

  my $cfg = Config::Abstraction->new(
      config_dirs => ['config'],
      environment => 'prod',          # loads base.prod.yaml, local.prod.yaml, ...
  );

If C<environment> is not given, the value is auto-detected in this order:

=over 4

=item 1. C<{env_prefix}ENV> environment variable (e.g. C<APP_ENV>)

=item 2. C<PLACK_ENV>

=item 3. C<NODE_ENV>

=back

When none of these is set, the environment-specific tiers are silently skipped.
The environment name must contain only ASCII letters, digits, hyphens, and underscores
(matched against C</^[A-Za-z0-9_\-]+$/>); any other value causes a C<croak>.

=item * C<file>

Synonym for C<config_file>

=item * C<flatten>

If true, returns a flat hash structure like C<{database.user}> (default: C<0>) instead of C<{database}{user}>.
`
=item * C<level>

Level for logging.

=item * C<logger>

Used for warnings and traces.
It can be an object that understands warn() and trace() messages,
such as a L<Log::Log4perl> or L<Log::Any> object,
a reference to code,
a reference to an array,
or a filename.

=item * C<path>

A synonym of C<config_dirs>.

=item * C<sep_char>

The separator in keys.
The default is a C<'.'>,
as in dotted notation,
such as C<'database.user'>.

=item * C<schema>

A L<Params::Validate::Strict> compatible schema to validate the configuration file against.

=item * C<validators>

A hashref mapping dotted config keys to validation rules.  Each rule is applied to the
corresponding value in the merged configuration immediately after all sources have been
merged (or on first access when C<lazy> is set).  A validation failure croaks.

Each rule may be one of:

=over 4

=item A type name string

  validators => {
      'database.port' => 'integer',
      'app.name'      => 'string',
      'price'         => 'number',
      'enabled'       => 'boolean',
      'tags'          => 'array',
      'settings'      => 'hash',
  }

Supported types: C<integer> (matches C</^-?\d+$/> -- no decimal point),
C<number> or C<float> (C<Scalar::Util::looks_like_number>), C<boolean>
(C<0>, C<1>, C<true>, C<false>, C<yes>, C<no> -- case-insensitive),
C<string> (any defined non-reference scalar), C<array> (arrayref),
C<hash> (hashref).

=item A compiled regular expression

  validators => {
      'log.level' => qr/^(?:debug|info|warn|error|fatal)$/i,
      'app.name'  => qr/^\w[\w\-]{1,63}$/,
  }

The value must be defined and must match the regex.

=item A coderef

  validators => {
      'database.port' => sub { my $v = shift; defined($v) && $v >= 1 && $v <= 65535 },
  }

Called with the value as its only argument.  Must return a true value; otherwise the
constructor croaks.

=item A hashref combining multiple constraints

  validators => {
      'database.port' => {
          type     => 'integer',
          min      => 1,
          max      => 65535,
          required => 1,
      },
      'api.key' => {
          pattern  => qr/^[A-Za-z0-9]{32}$/,
          required => 1,
      },
  }

Keys: C<type> (type-name string as above), C<pattern> (compiled regex), C<min> (numeric
lower bound, inclusive), C<max> (numeric upper bound, inclusive), C<required> (if true,
the key must exist and its value must be defined).

=back

All constraint types may be freely combined: specifying both C<type> and C<pattern>
requires the value to satisfy both.

=item * C<checker>

A prototype string (YAML) or hashref passed to L<Config::Checker> for template-based
structural validation.  C<Config::Checker> must be installed; if it is absent a C<carp>
warning is emitted and validation is skipped.

The prototype mirrors the expected config structure.  Keys and values can carry type
annotations (C<[INTEGER]>, C<[PATH]>, C<[HOSTNAME]>, ...), custom code checks
(C<{...}>), and quantity specifiers (C<?>: optional, C<+>: one or more, C<*>: zero or
more):

  my $config = Config::Abstraction->new(
      config_dirs => ['config'],
      checker     => <<'END_PROTOTYPE',
  database:
    host: hostname of the database server[HOSTNAME]
    port: '?<5432>port number[INTEGER]'
    user: database username
  END_PROTOTYPE
  );

See L<Config::Checker> for the full prototype syntax.

=item * C<lazy>

When set to a true value, all source discovery and file I/O are deferred until the first
call to C<get()>, C<exists()>, C<all()>, C<explain_sources()>, C<prefer_*()>,
C<merge_defaults()>, or any AUTOLOAD accessor.  This can reduce startup time in
applications that construct a C<Config::Abstraction> object before they know whether
they will access it.

B<Differences from the default (eager) behaviour, and the debugging problems they cause:>

=over 4

=item 1. C<new()> always succeeds, even when no configuration exists.

In eager mode, C<new()> returns C<undef> immediately when no files are found and no
C<data> was supplied, so a missing config is caught at the point of construction.
In lazy mode, C<new()> always returns a blessed object.  If the configuration
directories do not exist, the files are missing, or the prefix is wrong, you will
not find out until the first accessor call - which may be deep inside your business
logic, far from where the object was created.

  # Problem: the typo in config_dirs goes unnoticed until runtime
  my $cfg = Config::Abstraction->new(
      config_dirs => ['/etc/myapp/conifg'],   # typo - directory does not exist
      lazy => 1,
  );
  # ... many lines later ...
  my $host = $cfg->get('database.host');      # silently returns undef here

=item 2. Schema validation errors appear at the wrong place in the call stack.

When a C<schema> is supplied, eager mode validates the merged configuration inside
C<new()> and throws immediately if the config does not match.  In lazy mode,
validation is deferred to the first accessor call.  A schema violation therefore
surfaces as an exception thrown by C<get()> or C<all()>, not by C<new()>, and the
stack trace points to the accessor call rather than the construction site.  If the
object is created in one module and accessed in another, the error message can be
very misleading.

=item 3. Environment variables and C<@ARGV> are captured at access time, not construction time.

The module reads C<%ENV> and C<@ARGV> during C<_load_config()>.  In eager mode that
happens in C<new()>, so the configuration reflects the environment at the moment the
object is built.  In lazy mode, any change to C<%ENV> or C<@ARGV> between C<new()>
and the first accessor call is silently picked up.  This makes test isolation harder:
setting an environment variable I<after> constructing a lazy object will affect the
values it returns, which is not the case with an eager object.

=item 4. File system state may change between construction and first use.

Because lazy mode defers all I/O, the files that are read are those that exist at the
moment of first access, not at the moment C<new()> is called.  If a config file is
written, deleted, or replaced between those two points (for example, by another
process or test fixture), the object will silently use the new state.  An eager object
is immune to this race.

=item 5. Errors from format parsers appear at accessor call sites.

Malformed YAML, JSON, XML, or INI files emit a C<carp> warning and are skipped during
loading.  In eager mode those warnings appear near the program's startup.  In lazy mode
they appear during the first accessor call, which can make it look as though a routine
in your business logic is generating configuration warnings.

=back

B<When to use lazy loading:> It is most useful when a C<Config::Abstraction> object is
created speculatively at module-load time and may never be accessed (for example, in a
web framework where the config object is built for every request but some request paths
never read it).  Avoid it when startup correctness is important, when you rely on
C<new()> returning C<undef> to detect missing configuration, or when you use schema
validation and need errors to point at the construction site.

=back

If just one argument is given, it is assumed to be the name of a file.

=cut
673
674sub new
675{
676
875
1747182
        my $class = shift;
677
875
684
        my $params;
678
679
875
940
        if(scalar(@_) == 1) {
680                # Just one parameter - the name of a file
681
4
7
                $params = Params::Get::get_params('file', \@_);
682        } else {
683
871
1262
                $params = Params::Get::get_params(undef, \@_) || {};
684        }
685
686
875
11971
        $params->{'config_dirs'} //= $params->{'path'};   # Compatibility with Config::Auto
687
688
875
999
        $params->{config_dirs} = [ $ENV{CONFIG_DIR} ] if(defined($ENV{CONFIG_DIR}));
689
690
875
859
        $params->{'config_file'} //= $params->{'file'} if($params->{'file'});
691
692
875
799
        if(!defined($params->{'config_dirs'})) {
693
24
88
                if($params->{'config_file'} && File::Spec->file_name_is_absolute($params->{'config_file'})) {
694
10
13
                        $params->{'config_dirs'} = [''];
695                } else {
696                        # Set up the default value for config_dirs
697
14
24
                        if($^O ne 'MSWin32') {
698
14
20
                                $params->{'config_dirs'} = [ '/etc', '/usr/local/etc' ];
699                        } else {
700
0
0
                                $params->{'config_dirs'} = [''];
701                        }
702
14
25
                        if($ENV{'HOME'}) {
703
10
77
                                push @{$params->{'config_dirs'}},
704                                        File::Spec->catdir($ENV{'HOME'}, '.conf'),
705                                        File::Spec->catdir($ENV{'HOME'}, '.config'),
706
10
9
                                        File::Spec->catdir($ENV{'HOME'}, 'conf'),
707                        } elsif($ENV{'DOCUMENT_ROOT'}) {
708
2
22
                                push @{$params->{'config_dirs'}},
709                                        File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, File::Spec->updir(), 'conf'),
710                                        File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, 'conf'),
711
2
1
                                        File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, 'config');
712                        }
713
14
25
                        if(my $dir = $ENV{'CONFIG_DIR'}) {
714
0
0
0
0
                                push @{$params->{'config_dirs'}}, $dir;
715                        } else {
716
14
14
11
19
                                push @{$params->{'config_dirs'}}, 'conf', 'config';
717                        }
718                }
719        }
720
721        my $self = bless {
722                sep_char => '.',
723
875
2704
                %{$params->{defaults} ? $params->{defaults} : $params},
724
875
588
                env_prefix => $params->{env_prefix} || 'APP_',
725                config => {},
726        }, $class;
727
728        # Cache the compiled sep_char regex once so get() and exists() do not
729        # recompile it on every key lookup.
730
875
2452
        $self->{'_sep_re'} = qr/\Q$self->{'sep_char'}\E/;
731
732
875
945
        if(my $logger = $self->{'logger'}) {
733
18
36
                if(!Scalar::Util::blessed($logger)) {
734                        # Don't call $self->_load_driver('Log::Abstraction') as it can make a call to logger, which is yet to be set up
735
4
122
                        eval "require Log::Abstraction";
736
4
427
                        if($@) {
737
4
40
                                carp(ref($self), ": Log::Abstraction failed to load: $@, disabling logging");
738
4
453
                                if(ref($logger) eq 'ARRAY') {
739
3
3
18
6
                                        push @{$logger}, "Log::Abstraction failed to load: $@, disabling logging";
740                                }
741
4
4
                                $self->{'logger'} = undef;   # disable: unblessed ref would fatal on method calls
742                        } else {
743
0
0
                                Log::Abstraction->import();
744
0
0
                                $self->{'logger'} = Log::Abstraction->new($logger);
745
0
0
                                if($params->{'level'} && $self->{'logger'}->can('level')) {
746
0
0
                                        $self->{'logger'}->level($params->{'level'});
747                                }
748                        }
749                }
750        }
751        # Fail early when an explicitly-specified key file is missing rather than
752        # silently falling back to unencrypted operation (env-var key files are optional).
753
875
856
        if(defined $self->{'encryption_key_file'}) {
754
4
4
                my $kf = $self->{'encryption_key_file'};
755
4
34
                Carp::croak(ref($self) . ": encryption_key_file '$kf' does not exist") unless -f $kf;
756        }
757
758
874
750
        if($self->{'lazy'}) {
759                # Defer all source scanning to the first accessor call.
760                # Stash validators/checker/schema for later (after _load_config runs).
761
43
50
                $self->{'_lazy_schema'}     = delete $self->{'schema'}     if $self->{'schema'};
762
43
47
                $self->{'_lazy_validators'} = delete $self->{'validators'} if $self->{'validators'};
763
43
41
                $self->{'_lazy_checker'}    = delete $self->{'checker'}    if $self->{'checker'};
764
43
83
                return $self;
765        }
766
767
831
1005
        $self->_load_config();
768
769
810
841
        if(my $schema = $params->{'schema'}) {
770
10
25
                $self->{'config'} = Params::Validate::Strict::validate_strict(schema => $schema, input => $self->{'config'});
771        }
772
806
1120
        if(my $validators = $params->{'validators'}) {
773
67
77
                $self->_run_validators($validators);
774        }
775
774
688
        if(my $checker = $params->{'checker'}) {
776
2
3
                $self->_run_checker($checker);
777        }
778
779
774
774
796
972
        if(defined($self->{'config'}) && scalar(keys %{$self->{'config'}})) {
780
757
1668
                return $self;
781        }
782
17
58
        return undef;
783}
784
785# Trigger deferred loading when the object was constructed with lazy => 1.
786# Safe to call unconditionally: it is a no-op once loading has completed.
787sub _ensure_loaded
788{
789
950
783
        my $self = shift;
790
950
1002
        return unless $self->{'lazy'};    # fast-path: not a lazy object
791
39
36
        delete $self->{'lazy'};           # prevent re-entry on recursive calls
792
39
46
        $self->_load_config();
793
39
55
        if(my $schema = delete $self->{'_lazy_schema'}) {
794
1
3
                $self->{'config'} = Params::Validate::Strict::validate_strict(schema => $schema, input => $self->{'config'});
795        }
796
38
46
        if(my $validators = delete $self->{'_lazy_validators'}) {
797
3
7
                $self->_run_validators($validators);
798        }
799
36
47
        if(my $checker = delete $self->{'_lazy_checker'}) {
800
0
0
                $self->_run_checker($checker);
801        }
802}
803
804# Resolve the active deployment environment name.
805# Checked in order: 'environment' constructor option, {prefix}ENV env var,
806# PLACK_ENV, NODE_ENV.  Returns undef when none is set.
807# The value must match /^[A-Za-z0-9_\-]+$/ or a croak is raised.
808sub _get_environment
809{
810
881
1717
        my $self = shift;
811
812
881
572
        my $env;
813
814
881
782
        if(defined($self->{'environment'})) {
815
47
35
                $env = $self->{'environment'};
816        } else {
817
834
790
                my $prefix = $self->{'env_prefix'} // 'APP_';
818                $env = $ENV{$prefix . 'ENV'}
819                        // $ENV{'PLACK_ENV'}
820
834
1902
                        // $ENV{'NODE_ENV'};
821        }
822
823
881
979
        return undef unless defined $env;
824
60
66
        return undef if $env eq '';
825
826
58
115
        unless($env =~ /^[A-Za-z0-9_-]+$/) {
827
10
77
                Carp::croak(ref($self) . ": invalid environment name '$env': must contain only alphanumerics, hyphens, or underscores");
828        }
829
830
48
57
        return $env;
831}
832
833# _sanitize_yaml_values: Recursively replace CODE and GLOB refs with undef.
834# YAML::XS can produce CODE refs from !!perl/code tags regardless of DisableCode.
835# Applying this after LoadFile prevents executable references from reaching callers.
836sub _sanitize_yaml_values
837{
838
677
530
        my ($self, $val) = @_;
839
677
508
        my $r = ref($val);
840
677
853
        return undef if $r eq 'CODE' || $r eq 'GLOB';
841
674
514
        if($r eq 'HASH') {
842
355
435
398
433
                return { map { $_ => $self->_sanitize_yaml_values($val->{$_}) } keys %$val };
843        }
844
319
265
        if($r eq 'ARRAY') {
845
6
13
6
15
                return [ map { $self->_sanitize_yaml_values($_) } @$val ];
846        }
847
313
726
        return $val;
848}
849
850# Resolve the AES-256 encryption key from constructor option, env vars, or key file.
851# Returns 32 raw bytes, or undef when no key is configured.
852sub _get_encryption_key
853{
854
905
622
        my $self = shift;
855
856
905
699
        my $raw = $self->{'encryption_key'};
857
858
905
804
        if(!defined($raw)) {
859
814
749
                my $prefix = $self->{'env_prefix'} // 'APP_';
860
814
1402
                $raw = $ENV{$prefix . 'ENCRYPTION_KEY'} // $ENV{'ENCRYPTION_KEY'};
861        }
862
863
905
744
        if(!defined($raw)) {
864
805
666
                my $prefix = $self->{'env_prefix'} // 'APP_';
865                my $kf = $self->{'encryption_key_file'}
866                        // $ENV{$prefix . 'ENCRYPTION_KEY_FILE'}
867
805
1574
                        // $ENV{'ENCRYPTION_KEY_FILE'};
868
805
838
                if(defined($kf) && -f $kf) {
869
5
51
                        open my $fh, '<', $kf
870                                or Carp::croak(ref($self) . ": cannot open encryption_key_file '$kf': $!");
871
5
26
                        $raw = <$fh>;
872
5
16
                        close $fh;
873
5
10
                        chomp $raw if defined $raw;
874                }
875        }
876
877
905
2013
        return undef unless defined $raw;
878
105
100
        return $self->_decode_encryption_key($raw);
879}
880
881# Accept a key as 32 raw bytes, 64 hex chars, or 43-44 base64/base64url chars.
882# Returns 32 raw bytes or croaks.
883sub _decode_encryption_key
884{
885
112
1033
        my ($self, $raw) = @_;
886
887
112
148
        return $raw if length($raw) == $_AES_KEY_SIZE;
888
889
62
212
        if(length($raw) == $_HEX_KEY_LEN && $raw =~ /^[0-9A-Fa-f]{$_HEX_KEY_LEN}$/) {
890
50
121
                return pack('H*', $raw);
891        }
892
893
12
37
        if(length($raw) >= $_B64_KEY_MIN && length($raw) <= $_B64_KEY_MAX) {
894
6
222
                require MIME::Base64;
895
6
319
                (my $b64 = $raw) =~ tr/-_/+\//;   # base64url → base64
896
6
9
                $b64 .= '=' x ((4 - length($b64) % 4) % 4);
897
6
8
                my $bytes = MIME::Base64::decode_base64($b64);
898
6
14
                return $bytes if length($bytes) == $_AES_KEY_SIZE;
899        }
900
901
6
44
        Carp::croak(ref($self) . ': encryption_key must be ' . $_AES_KEY_SIZE . ' raw bytes, ' . $_HEX_KEY_LEN . ' hex chars, or ' . $_B64_KEY_MAX . ' base64 chars (got length ' . length($raw) . ')');
902}
903
904# Recursively walk $href and decrypt any leaf value matching ENC[...].
905# $seen guards against circular references (possible when Hash::Merge
906# no-clone mode is active and sub-hashes are shared across the merge tree).
907sub _decrypt_config_values
908{
909
68
94
        my ($self, $href, $key, $seen) = @_;
910
68
133
        $seen //= {};
911
68
162
        return if $seen->{Scalar::Util::refaddr($href)}++;
912
913
67
67
40
109
        for my $k (keys %{$href}) {
914
49
45
                next if $k eq 'config_path';
915
47
38
                my $v = $href->{$k};
916
47
157
                if(ref($v) eq 'HASH') {
917
7
13
                        $self->_decrypt_config_values($v, $key, $seen);
918                } elsif(ref($v) eq 'ARRAY') {
919
2
2
2
4
                        for my $i (0..$#{$v}) {
920
4
19
                                if(!ref($v->[$i]) && defined($v->[$i]) && $v->[$i] =~ /^ENC\[/) {
921
2
3
                                        $v->[$i] = $self->_decrypt_enc_value($v->[$i], $key);
922                                }
923                        }
924                } elsif(!ref($v) && defined($v) && $v =~ /^ENC\[/) {
925
21
24
                        $href->{$k} = $self->_decrypt_enc_value($v, $key);
926                }
927        }
928}
929
930# Decrypt a single ENC[AES256GCM,<base64url>] token.
931# Returns the plaintext string or croaks on failure.
932sub _decrypt_enc_value
933{
934
28
112
        my ($self, $token, $key) = @_;
935
936
28
57
        unless($token =~ /^
937                ENC\[
938                ([A-Za-z0-9]+)          # algorithm name  (e.g. AES256GCM)
939                ,
940                ([A-Za-z0-9_-]+)        # base64url payload (RFC 4648 §5 alphabet)
941                \]
942        $/x) {
943
2
10
                Carp::croak(ref($self) . ": malformed ENC token: $token");
944        }
945
26
38
        my ($algo, $b64) = ($1, $2);
946
947
26
33
        unless(lc($algo) eq 'aes256gcm') {
948
2
11
                Carp::croak(ref($self) . ": unsupported encryption algorithm '$algo' in ENC token");
949        }
950
951        # Decode and validate payload length before requiring CryptX: a structurally
952        # invalid token should be rejected regardless of whether the crypto library
953        # is installed.  MIME::Base64 is a core module and always available.
954
24
30
        require MIME::Base64;
955
24
29
        my $raw = MIME::Base64::decode_base64url($b64);
956
957
24
143
        if(length($raw) < $_ENC_PAYLOAD_MIN) {
958
2
10
                Carp::croak(ref($self) . ": ENC token payload is too short to be valid");
959        }
960
961
22
20
        unless($self->_load_driver('Crypt::AuthEnc::GCM')) {
962
1
3
                Carp::croak(ref($self) . ': CryptX (Crypt::AuthEnc::GCM) is required to decrypt ENC[] values; install it with: cpanm CryptX');
963        }
964
965
21
53
        my $nonce = substr($raw,  0, $_AES_NONCE_SIZE);
966
21
21
        my $tag   = substr($raw, -$_AES_TAG_SIZE);
967
21
24
        my $ct    = substr($raw, $_AES_NONCE_SIZE, length($raw) - $_ENC_PAYLOAD_MIN);
968
969
21
54
        my $gcm = Crypt::AuthEnc::GCM->new('AES', $key);
970
21
30
        $gcm->iv_add($nonce);
971
21
34
        my $pt = $gcm->decrypt_add($ct);
972
973
21
21
18
39
        my $ok = eval { $gcm->decrypt_done($tag) };
974
21
547
        unless($ok && !$@) {
975
4
28
                Carp::croak(ref($self) . ": decryption failed (wrong key or tampered data)");
976        }
977
978
17
88
        return $pt;
979}
980
981# Apply the validators hash supplied as a constructor option.
982# Each key is a dotted config key; each value is a coderef, regex, type string, or spec hashref.
983sub _run_validators
984{
985
70
59
        my ($self, $validators) = @_;
986
987
70
70
46
94
        for my $key (sort keys %{$validators}) {
988
72
60
                my $spec  = $validators->{$key};
989
72
86
                my $value = $self->get($key);
990
991
72
159
                if(ref($spec) eq 'CODE') {
992
9
12
                        unless($spec->($value)) {
993
4
34
                                Carp::croak(ref($self) . ": validation failed for '$key': custom validator returned false");
994                        }
995                } elsif(ref($spec) eq 'Regexp') {
996
9
40
                        unless(defined($value) && $value =~ $spec) {
997
5
49
                                Carp::croak(ref($self) . ": '$key' value " .
998                                        (defined($value) ? "'$value'" : '(undef)') . " does not match required pattern");
999                        }
1000                } elsif(ref($spec) eq 'HASH') {
1001
15
18
                        $self->_validate_value_spec($key, $value, $spec);
1002                } elsif(!ref($spec)) {
1003
37
40
                        _validate_type($key, $value, $spec);
1004                } else {
1005
2
15
                        Carp::croak(ref($self) . ": invalid validator for '$key': must be a type string, regex, coderef, or hashref");
1006                }
1007        }
1008}
1009
1010# Apply a hashref spec (type / pattern / min / max / required) to a single value.
1011sub _validate_value_spec
1012{
1013
15
18
        my ($self, $key, $value, $spec) = @_;
1014
1015
15
31
        if($spec->{'required'} && (!$self->exists($key) || !defined($value))) {
1016
4
24
                Carp::croak(ref($self) . ": required key '$key' is missing or undefined");
1017        }
1018
11
14
        if(my $type = $spec->{'type'}) {
1019
7
10
                _validate_type($key, $value, $type);
1020        }
1021
11
44
        if(my $pattern = $spec->{'pattern'}) {
1022
2
11
                unless(defined($value) && $value =~ $pattern) {
1023
1
11
                        Carp::croak(ref($self) . ": '$key' value " .
1024                                (defined($value) ? "'$value'" : '(undef)') . " does not match required pattern");
1025                }
1026        }
1027
10
16
        if(defined(my $min = $spec->{'min'})) {
1028
7
43
                Carp::croak(ref($self) . ": '$key' value '$value' is less than minimum $min")
1029                        if defined($value) && $value < $min;
1030        }
1031
7
11
        if(defined(my $max = $spec->{'max'})) {
1032
6
28
                Carp::croak(ref($self) . ": '$key' value '$value' exceeds maximum $max")
1033                        if defined($value) && $value > $max;
1034        }
1035}
1036
1037# Validate a single value against a named type.
1038# Not a method — takes (key, value, type_string).
1039sub _validate_type
1040{
1041
80
17405
        my ($key, $value, $type) = @_;
1042
80
64
        my $ltype = lc($type);
1043
1044
80
144
        if($ltype eq 'integer') {
1045
28
201
                Carp::croak("Config::Abstraction: '$key' must be an integer (got " .
1046                        (defined $value ? "'$value'" : 'undef') . ')')
1047                        unless defined($value) && $value =~ /^-?[0-9]+$/;
1048        } elsif($ltype eq 'number' || $ltype eq 'float') {
1049
10
48
                Carp::croak("Config::Abstraction: '$key' must be a number (got " .
1050                        (defined $value ? "'$value'" : 'undef') . ')')
1051                        unless defined($value) && Scalar::Util::looks_like_number($value);
1052        } elsif($ltype eq 'boolean') {
1053
24
87
                Carp::croak("Config::Abstraction: '$key' must be a boolean (0/1/true/false/yes/no), got " .
1054                        (defined $value ? "'$value'" : 'undef'))
1055                        unless defined($value) && $value =~ /^(?:1|0|true|false|yes|no)$/i;
1056        } elsif($ltype eq 'string') {
1057
6
23
                Carp::croak("Config::Abstraction: '$key' must be a defined string (got undef)")
1058                        unless defined($value) && !ref($value);
1059        } elsif($ltype eq 'array') {
1060
6
33
                Carp::croak("Config::Abstraction: '$key' must be an array reference")
1061                        unless ref($value) eq 'ARRAY';
1062        } elsif($ltype eq 'hash') {
1063
4
14
                Carp::croak("Config::Abstraction: '$key' must be a hash reference")
1064                        unless ref($value) eq 'HASH';
1065        } else {
1066
2
11
                Carp::croak("Config::Abstraction: unknown type '$type' in validators for '$key'");
1067        }
1068}
1069
1070# Invoke Config::Checker with the merged config and caller-supplied prototype.
1071# prototype may be a YAML string or a hashref.
1072sub _run_checker
1073{
1074
3
115
        my ($self, $prototype) = @_;
1075
1076
3
3
        unless($self->_load_driver('Config::Checker')) {
1077
3
12
                Carp::carp(ref($self) . ': Config::Checker not available; skipping checker validation');
1078
3
217
                return;
1079        }
1080
1081        # config_checker_source() returns Perl source text (a sub { ... } literal)
1082        # that must be eval'd so it can import into our namespace.
1083
0
0
        my $checker = eval Config::Checker::config_checker_source();    ## no critic (ProhibitStringyEval)
1084
0
0
        Carp::croak(ref($self) . ": failed to compile Config::Checker: $@") if $@;
1085
1086
0
0
0
0
        eval { $checker->($self->{'config'}, $prototype) };
1087
0
0
        Carp::croak(ref($self) . ": checker validation failed: $@") if $@;
1088}
1089
1090# Determine if a value is a plain, unblessed, non-reference scalar
1091# safe to use in regex/string operations.
1092# Args:   value to test
1093# Returns: 1 if plain scalar, 0 otherwise
1094sub _is_plain_scalar
1095{
1096
68
6938
        my $val = $_[0];
1097
1098
68
61
        return 0 if !defined($val);
1099
67
77
        return 0 if Scalar::Util::blessed($val);
1100
66
67
        return 0 if ref($val);
1101
61
54
        return 1;
1102}
1103
1104# Recursively flatten a nested hashref to dotted keys (always uses '.' as separator).
1105# Skips the meta-key 'config_path'. Used by explain_sources() and source tracking.
1106# $seen guards against circular references (e.g. those possible when
1107# Hash::Merge::set_clone_behavior(0) is active).
1108#
1109# _flatten_into writes into a caller-supplied hashref accumulator so that
1110# each leaf key is written exactly once -- O(N) total writes vs the previous
1111# O(N^2) pattern of %flat = (%flat, _flatten_keys(...)) at each recursion level.
1112sub _flatten_into
1113{
1114
1802
1469
        my ($acc, $hash, $prefix, $seen) = @_;
1115
1802
1880
        return unless ref($hash) eq 'HASH';
1116
1802
1526
        my $addr = Scalar::Util::refaddr($hash);
1117
1802
2296
        return if $seen->{$addr}++;
1118
1797
1769
        for my $k (keys %$hash) {
1119
3832
4798
                next if $k eq 'config_path';
1120
3819
2910
                my $full = length($prefix) ? "$prefix.$k" : $k;
1121
3819
3038
                if(ref($hash->{$k}) eq 'HASH') {
1122
761
1100
                        _flatten_into($acc, $hash->{$k}, $full, $seen);
1123                } else {
1124
3058
3870
                        $acc->{$full} = $hash->{$k};
1125                }
1126        }
1127}
1128
1129sub _flatten_keys
1130{
1131
1041
8109
        my ($hash, $prefix, $seen) = @_;
1132
1041
665
        my %flat;
1133
1041
2463
        _flatten_into(\%flat, $hash, $prefix // '', $seen // {});
1134
1041
3843
        return %flat;
1135}
1136
1137sub _load_config
1138{
1139
871
1078
        if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) {
1140
2
30
                Carp::croak('Illegal Operation: This method can only be called by a subclass');
1141        }
1142
1143
869
7345
        my $self = shift;
1144
1145        # Disable Hash::Merge cloning for the duration of this method.
1146        # Storable::dclone (used when clone=1) cannot handle coderefs or blessed
1147        # objects that may appear in the 'data' argument; sharing references is
1148        # safe here because %merged is a fresh, method-local accumulator.
1149
869
986
        my $saved_clone = Hash::Merge::get_clone_behavior();
1150
869
5349
        Hash::Merge::set_clone_behavior(0);
1151
1152
869
4185
        my %merged;
1153
1154
869
876
        if($self->{'data'}) {
1155                # The data argument given to 'new' contains defaults that this routine will override
1156
698
730
                if(ref($self->{'data'}) eq 'HASH') {
1157
695
695
443
1019
                        %merged = %{$self->{'data'}};
1158
695
933
                        push @{$self->{'_source_records'}}, {
1159                                type      => 'data',
1160                                label     => 'constructor data argument',
1161
695
1746
                                flat_data => { _flatten_keys($self->{'data'}) },
1162                        };
1163                } else {
1164
3
27
                        Carp::carp(ref($self) . ': data argument must be a hashref; ignoring non-hashref value');
1165                }
1166        }
1167
1168
869
1112
        my $logger = $self->{'logger'};
1169
869
740
        if($logger) {
1170
14
21
                $logger->trace(ref($self), ' ', __LINE__, ': Entered _load_config');
1171        }
1172
1173
869
937
        my $environment = $self->_get_environment();
1174
859
960
        my @_formats    = qw(yaml yml json xml ini toml);
1175        my @_file_list  = (
1176
5154
4351
                (map { "base.$_"              } @_formats),
1177
228
175
                ($environment ? (map { "base.$environment.$_"  } @_formats) : ()),
1178
5154
3867
                (map { "local.$_"             } @_formats),
1179
859
228
741
170
                ($environment ? (map { "local.$environment.$_" } @_formats) : ()),
1180        );
1181
1182
859
859
588
799
        my @dirs = @{$self->{'config_dirs'}};
1183
859
998
        if($self->{'config_file'} && (scalar(@dirs) > 1)) {
1184
3
10
                if(File::Spec->file_name_is_absolute($self->{'config_file'})) {
1185                        # Handle absolute paths
1186
1
2
                        @dirs = ('');
1187                } else {
1188                        # Look in the current directory
1189
2
4
                        push @dirs, File::Spec->curdir();
1190                }
1191        }
1192
859
713
        for my $dir (@dirs) {
1193
341
317
                next if(!defined($dir));
1194
1195                # Newcastle Connection: /../hostname/path means read from a remote host.
1196                # /../ is unreachable on any real filesystem, so this is unambiguous.
1197                # When the hostname resolves to the local machine (localhost, 127.0.0.1,
1198                # ::1, or the system hostname) the /../host/ wrapper is unwrapped and the
1199                # enclosed path is processed through the normal local pipeline instead.
1200
340
240
                my $effective_dir = $dir;
1201
340
362
                if(my ($host, $remote_dir) = $self->_parse_remote_dir($dir)) {
1202
5
7
                        if($self->_is_local_host($host)) {
1203
4
5
                                $effective_dir = $remote_dir;
1204                        } else {
1205
1
3
                                $self->_load_remote_dir($host, $remote_dir, \%merged, \@_file_list);
1206
1
2
                                next;
1207                        }
1208                }
1209
1210
339
1501
                if(length($effective_dir) && !-d $effective_dir) {
1211
39
35
                        next;
1212                }
1213
1214
300
234
                for my $file (@_file_list) {
1215
3936
7690
                        my $path = File::Spec->catfile($effective_dir, $file);
1216
3936
3478
                        if($logger) {
1217
96
92
                                $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path");
1218                        }
1219
3936
16431
                        next unless -f $path;
1220
259
1086
                        next unless -r $path;
1221
1222
258
254
                        if($logger) {
1223
4
7
                                $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path");
1224                        }
1225
1226
258
164
                        my $data;
1227                        # Only load config modules when they are needed
1228
258
653
                        if ($file =~ /\.ya?ml$/) {
1229
194
280
                                $self->_load_driver('YAML::XS', ['LoadFile']);
1230
194
194
161
220
                                $data = eval { LoadFile($path) };
1231
194
8990
                                if($@) {
1232
7
8
                                        if($logger) {
1233
1
2
                                                $logger->notice("Failed to load YAML from $path: $@");
1234                                        } else {
1235
6
46
                                                Carp::carp("Failed to load YAML from $path: $@");
1236                                        }
1237
7
713
                                        next;
1238                                }
1239
187
463
                                $data = $self->_sanitize_yaml_values($data) if defined($data) && ref($data);
1240                        } elsif ($file =~ /\.json$/) {
1241
14
14
13
23
                                $data = eval { decode_json(read_file($path)) };
1242
14
608
                                        if($@) {
1243
2
4
                                                if($logger) {
1244
0
0
                                                        $logger->notice("Failed to load JSON from $path: $@");
1245                                                } else {
1246
2
16
                                                        Carp::carp("Failed to load JSON from $path: $@");
1247                                                }
1248
2
247
                                                next;
1249                                        }
1250                        } elsif($file =~ /\.xml$/) {
1251
22
16
                                my $rc;
1252
22
51
                                if($self->_load_driver('XML::Simple', ['XMLin'])) {
1253
0
0
0
0
                                        my $xml_raw = eval { read_file($path) };
1254
0
0
                                        if(defined($xml_raw) && $xml_raw =~ /<!ENTITY\s+\w+\s+(?:SYSTEM|PUBLIC)\b/i) {
1255
0
0
                                                Carp::carp(ref($self) . ": skipping $path: XML external entity declarations not permitted");
1256                                        } elsif(defined($xml_raw)) {
1257
0
0
0
0
                                                eval { $rc = XMLin(\$xml_raw, ForceArray => 0, KeyAttr => []) };
1258
0
0
                                                if($@) {
1259
0
0
                                                        if($logger) {
1260
0
0
                                                                $logger->notice("Failed to load XML from $path: $@");
1261                                                        } else {
1262
0
0
                                                                Carp::carp("Failed to load XML from $path: $@");
1263                                                        }
1264
0
0
                                                        undef $rc;
1265                                                } elsif($rc) {
1266
0
0
                                                        $data = $rc;
1267                                                }
1268                                        }
1269                                }
1270
22
45
                                if((!defined($rc)) && $self->_load_driver('XML::PP')) {
1271
21
36
                                        my $xml_pp = XML::PP->new();
1272
21
350
                                        $data = read_file($path);
1273
21
864
                                        if(my $tree = $xml_pp->parse(\$data)) {
1274
20
9172
                                                if($data = $xml_pp->collapse_structure($tree)) {
1275
20
466
                                                        $self->{'type'} = 'XML';
1276
20
29
                                                        if($data->{'config'}) {
1277
16
29
                                                                $data = $data->{'config'};
1278                                                        }
1279                                                }
1280                                        }
1281                                }
1282                        } elsif ($file =~ /\.ini$/) {
1283
18
40
                                $self->_load_driver('Config::IniFiles');
1284
18
37
                                if(my $ini = Config::IniFiles->new(-file => $path)) {
1285                                        $data = { map {
1286
15
17
7668
100
                                                my $section = $_;
1287
17
26
54
265
                                                $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) }
1288                                        } $ini->Sections() };
1289                                } else {
1290
3
736
                                        if($logger) {
1291
0
0
                                                $logger->notice("Failed to load INI from $path: $@");
1292                                        } else {
1293
3
37
                                                Carp::carp("Failed to load INI from $path: $@");
1294                                        }
1295                                }
1296                        } elsif ($file =~ /\.toml$/) {
1297
10
43
                                if($self->_load_driver('TOML::Tiny', ['from_toml'])) {
1298                                        # scalar() forces read_file into scalar context; without it
1299                                        # read_file returns a list of lines and from_toml (no prototype)
1300                                        # only sees the first line.
1301
9
16
                                        my ($toml_data, $toml_err) = from_toml(scalar(read_file($path)));
1302
9
6428
                                        if($toml_err) {
1303
1
2
                                                if($logger) {
1304
0
0
                                                        $logger->notice("Failed to load TOML from $path: $toml_err");
1305                                                } else {
1306
1
9
                                                        Carp::carp("Failed to load TOML from $path: $toml_err");
1307                                                }
1308                                        } elsif(ref($toml_data) eq 'HASH' && scalar(keys %$toml_data)) {
1309
8
6
                                                $data = $toml_data;
1310                                        }
1311                                }
1312                        }
1313
249
1140
                        if($data) {
1314
241
226
                                if(!ref($data)) {
1315
3
3
                                        if($logger) {
1316
1
3
                                                $logger->debug(ref($self), ' ', __LINE__, ": ignoring data from $path ($data)");
1317                                        }
1318
3
8
                                        next;
1319                                }
1320
238
257
                                if(ref($data) ne 'HASH') {
1321
4
5
                                        if($logger) {
1322
1
2
                                                $logger->debug(ref($self), ' ', __LINE__, ": ignoring data from $path (not a hashref)");
1323                                        }
1324
4
10
                                        next;
1325                                }
1326
234
202
                                if($logger) {
1327
1
2
                                        $logger->debug(ref($self), ' ', __LINE__, ": Loaded data from $path");
1328                                }
1329
234
234
153
314
                                push @{$self->{'_source_records'}}, {
1330                                        type      => 'file',
1331                                        label     => $path,
1332                                        flat_data => { _flatten_keys($data) },
1333                                };
1334
234
234
196
259
                                %merged = %{ merge( $data, \%merged ) };
1335
234
234
6388
373
                                push @{$merged{'config_path'}}, $path;
1336                        }
1337                }
1338
1339                # Put $self->{config_file} through all parsers, ignoring all errors, then merge that in
1340
300
346
                if(!$self->{'script_name'}) {
1341
279
723
                        require File::Basename && File::Basename->import() unless File::Basename->can('basename');
1342
1343                        # Determine script name
1344
279
5016
                        $self->{'script_name'} = File::Basename::basename($ENV{'SCRIPT_NAME'} || $0);
1345                }
1346
1347
300
253
                my $script_name = $self->{'script_name'};
1348
300
300
381
370
                for my $config_file ('default', $script_name, "$script_name.cfg", "$script_name.conf", "$script_name.config", $self->{'config_file'}, @{$self->{'config_files'}}) {
1349
1814
1496
                        next unless defined($config_file);
1350                        # Note that loading $script_name in the current directory could mean loading the script as its own config.
1351                        # This test is not foolproof, buyer beware
1352
1582
1782
                        next if(($config_file eq $script_name) && ((length($effective_dir) == 0) || ($effective_dir eq File::Spec->curdir())));
1353
1544
2885
                        my $path = length($effective_dir) ? File::Spec->catfile($effective_dir, $config_file) : $config_file;
1354
1544
1354
                        if($logger) {
1355
44
47
                                $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path");
1356                        }
1357
1544
6863
                        if((-f $path) && (-r $path)) {
1358
72
107
                                my $data = read_file($path);
1359
72
2988
                                my $raw_content = $data;
1360
72
79
                                if($logger) {
1361
4
4
                                        $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path");
1362                                }
1363
72
68
                                eval {
1364
72
238
                                        if(($data =~ /^\s*<\?xml/) || ($data =~ /<\/[^>]+>/)) {
1365
13
25
                                                if($self->_load_driver('XML::Simple', ['XMLin'])) {
1366
0
0
                                                        if($data =~ /<!ENTITY\s+\w+\s+(?:SYSTEM|PUBLIC)\b/i) {
1367
0
0
                                                                Carp::carp(ref($self) . ": skipping $path: XML external entity declarations not permitted");
1368
0
0
                                                                undef $data;
1369                                                        } elsif(my $xml_data = XMLin(\$data, ForceArray => 0, KeyAttr => [])) {
1370
0
0
                                                                $data = $xml_data;
1371
0
0
                                                                $self->{'type'} = 'XML';
1372                                                        }
1373                                                } elsif($self->_load_driver('XML::PP')) {
1374
13
21
                                                        my $xml_pp = XML::PP->new();
1375
13
209
                                                        if(my $tree = $xml_pp->parse(\$data)) {
1376
12
3422
                                                                if($data = $xml_pp->collapse_structure($tree)) {
1377
12
162
                                                                        $self->{'type'} = 'XML';
1378
12
18
                                                                        if($data->{'config'}) {
1379
9
16
                                                                                $data = $data->{'config'};
1380                                                                        }
1381                                                                }
1382                                                        }
1383                                                }
1384                                        } elsif($data =~ /
1385                                                \{              # opening brace
1386                                                .+              # key material; dot matches newlines because of the s modifier
1387                                                :               # colon separator
1388                                                .               # one value character
1389                                                \}              # closing brace
1390                                        /xs) {
1391
5
8
                                                $self->_load_driver('JSON::Parse');
1392                                                # CPanel::JSON is very noisy, so be careful before attempting to use it
1393
5
3
                                                my $is_json;
1394
5
5
5
24
                                                eval { $is_json = JSON::Parse::parse_json($data) };
1395
5
8
                                                if($is_json) {
1396
4
4
4
26
                                                        eval { $data = decode_json($data) };
1397
4
6
                                                        if($@) {
1398
1
1
                                                                undef $data;
1399                                                        }
1400                                                } else {
1401
1
1
                                                        undef $data;
1402                                                }
1403
5
8
                                                if($data) {
1404
3
6
                                                        $self->{'type'} = 'JSON';
1405                                                }
1406                                        } else {
1407
54
63
                                                undef $data;
1408                                        }
1409
72
184
                                        if(!$data && $raw_content !~ /<!ENTITY\s+\w+\s+(?:SYSTEM|PUBLIC)\b/i) {
1410
55
119
                                                $self->_load_driver('YAML::XS', ['LoadFile']);
1411
55
55
52
85
                                                if((eval { $data = LoadFile($path) }) && (ref($data) eq 'HASH')) {
1412
40
1808
                                                        $data = $self->_sanitize_yaml_values($data);
1413                                                        # Could be colon file, could be YAML, whichever it is break the configuration fields
1414                                                        # foreach my($k, $v) (%{$data}) {
1415
40
40
32
56
                                                        foreach my $k (keys %{$data}) {
1416
63
70
                                                                my $v = $data->{$k};
1417
63
63
                                                                if(!defined($v)) {
1418                                                                        # e.g. a simple line
1419                                                                        #       foo:
1420                                                                        # with nothing under it
1421
2
2
                                                                        $data->{$k} = undef;
1422
2
2
                                                                        next;
1423                                                                }
1424                                                                # Do not inspect or modify coderefs, blessed objects, or any reference
1425
61
62
                                                                next unless _is_plain_scalar($v);
1426
1427
59
65
                                                                next if($v =~ /^"[^"]+"$/);      # Single-quoted field — skip comma-splitting
1428
58
70
                                                                if($v =~ /,/) {
1429
5
13
                                                                        my @vals = split(/\s*,\s*/, $v);
1430
5
5
                                                                        delete $data->{$k};
1431
5
5
                                                                        foreach my $val (@vals) {
1432
11
16
                                                                                if($val =~ /([^=]+)=(.+)/) {
1433
8
14
                                                                                        $data->{$k}{$1} = $2;
1434                                                                                } else {
1435
3
4
                                                                                        $data->{$k}{$val} = 1;
1436                                                                                }
1437                                                                        }
1438                                                                }
1439                                                        }
1440
40
46
                                                        if($data) {
1441
40
47
                                                                $self->{'type'} = 'YAML';
1442                                                        }
1443                                                }
1444
55
791
                                                if((!$data) || (ref($data) ne 'HASH')) {
1445
15
44
                                                        if($self->_load_driver('TOML::Tiny', ['from_toml'])) {
1446                                                                # scalar() forces read_file into scalar context; without it
1447                                                                # read_file returns a list of lines and from_toml (no prototype)
1448                                                                # only sees the first line.
1449
15
15
16
21
                                                                my ($toml_data, $toml_err) = eval { from_toml(scalar(read_file($path))) };
1450
15
6092
                                                                if(!$toml_err && ref($toml_data) eq 'HASH' && scalar(keys %$toml_data)) {
1451
1
1
                                                                        $data = $toml_data;
1452
1
2
                                                                        $self->{'type'} = 'TOML';
1453                                                                }
1454                                                        }
1455                                                }
1456
55
115
                                                if((!$data) || (ref($data) ne 'HASH')) {
1457
14
21
                                                        $self->_load_driver('Config::IniFiles');
1458
14
28
                                                        if(my $ini = Config::IniFiles->new(-file => $path)) {
1459                                                                $data = { map {
1460
4
5
2688
36
                                                                        my $section = $_;
1461
5
10
7
112
                                                                        $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) }
1462                                                                } $ini->Sections() };
1463
4
46
                                                                if($data) {
1464
4
6
                                                                        $self->{'type'} = 'INI';
1465                                                                }
1466                                                        }
1467
14
2051
                                                        if((!$data) || (ref($data) ne 'HASH')) {
1468                                                                # Maybe XML without the leading XML header
1469
10
13
                                                                if($self->_load_driver('XML::Simple', ['XMLin'])) {
1470
0
0
0
0
                                                                        my $xml_raw = eval { read_file($path) };
1471
0
0
                                                                        if(defined($xml_raw) && $xml_raw !~ /<!ENTITY\s+\w+\s+(?:SYSTEM|PUBLIC)\b/i) {
1472
0
0
0
0
                                                                                eval { $data = XMLin(\$xml_raw, ForceArray => 0, KeyAttr => []) };
1473                                                                        }
1474                                                                }
1475
10
32
                                                                if((!$data) || (ref($data) ne 'HASH')) {
1476
10
8
                                                                        if($self->_load_driver('Config::Abstract')) {
1477                                                                                # Handle RT#164587
1478
0
0
                                                                                open my $oldSTDERR, '>&STDERR';
1479
0
0
                                                                                close STDERR;
1480
0
0
0
0
                                                                                eval { $data = Config::Abstract->new($path) };
1481
0
0
                                                                                my $err = $@;
1482
0
0
                                                                                open STDERR, '>&', $oldSTDERR;
1483
0
0
                                                                                if($err) {
1484
0
0
                                                                                        undef $data;
1485                                                                                } elsif($data) {
1486
0
0
                                                                                        $data = $data->get_all_settings();
1487
0
0
0
0
                                                                                        if(scalar(keys %{$data}) == 0) {
1488
0
0
                                                                                                undef $data;
1489                                                                                        }
1490                                                                                }
1491
0
0
                                                                                $self->{'type'} = 'Perl';
1492                                                                        }
1493                                                                }
1494
10
18
                                                                if((!$data) || (ref($data) ne 'HASH')) {
1495
10
14
                                                                        $self->_load_driver('Config::Auto');
1496
10
19
                                                                        my $ca = Config::Auto->new(source => $path);
1497
10
136
                                                                        if($data = $ca->parse()) {
1498
5
2181
                                                                                $self->{'type'} = $ca->format();
1499                                                                        }
1500                                                                }
1501                                                        }
1502                                                }
1503                                        }
1504                                };
1505
72
2478
                                if($logger) {
1506
4
6
                                        if($@) {
1507
1
3
                                                $logger->warn(ref($self), ' ', __LINE__, ": $@");
1508
1
5
                                                undef $data;
1509                                        } else {
1510
3
6
                                                $logger->debug(ref($self), ' ', __LINE__, ': Loaded data from', $self->{'type'}, "file $path");
1511                                        }
1512                                }
1513
72
152
                                if($data && ref($data) eq 'HASH') {
1514
65
65
41
137
                                        push @{$self->{'_source_records'}}, {
1515                                                type      => 'file',
1516                                                label     => $path,
1517                                                flat_data => { _flatten_keys($data) },
1518                                        };
1519                                }
1520
72
158
                                if(scalar(keys %merged)) {
1521
24
32
                                        if($data) {
1522
23
23
16
28
                                                %merged = %{ merge($data, \%merged) };
1523                                        }
1524                                } elsif($data && (ref($data) eq 'HASH')) {
1525
42
42
30
60
                                        %merged = %{$data};
1526                                } elsif((!$@) && $logger) {
1527
1
2
                                        $logger->debug(ref($self), ' ', __LINE__, ': No configuration file loaded');
1528                                }
1529
1530
72
72
637
149
                                push @{$merged{'config_path'}}, $path;
1531                        }
1532                }
1533        }
1534
1535        # Merge ENV vars
1536
859
729
        my $prefix = $self->{env_prefix};
1537
859
734
        $prefix =~ s/__$//;
1538
859
1330
        $prefix =~ s/_$//;
1539
859
676
        $prefix =~ s/::$//;
1540
859
5562
        for my $key (keys %ENV) {
1541
115245
120747
                next unless $key =~ /^\Q$self->{env_prefix}\E(.*)$/i;
1542
68
93
                my $path = lc($1);
1543
68
95
                if($path =~ /__/) {
1544
44
57
                        my @parts = split /__/, $path;
1545
44
51
                        my $ref = \%merged;
1546
44
114
                        $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1];
1547
44
74
                        $ref->{ $parts[-1] } = $ENV{$key};
1548
44
141
                        push @{$self->{'_source_records'}}, {
1549                                type      => 'env',
1550                                label     => $key,
1551
44
25
                                flat_data => { join('.', @parts) => $ENV{$key} },
1552                        };
1553                } else {
1554
24
40
                        $merged{$prefix}->{$path} = $ENV{$key};
1555
24
78
                        push @{$self->{'_source_records'}}, {
1556                                type      => 'env',
1557                                label     => $key,
1558
24
22
                                flat_data => { "$prefix.$path" => $ENV{$key} },
1559                        };
1560                }
1561        }
1562
1563        # Merge command line options
1564
859
2697
        foreach my $arg(@ARGV) {
1565
35
54
                next unless($arg =~ /=/);
1566
28
47
                my ($key, $value) = split(/=/, $arg, 2);
1567
28
144
                next unless $key =~ /^--\Q$self->{env_prefix}\E(.*)$/;
1568
1569
24
35
                my $path = lc($1);
1570
24
31
                my @parts = split(/__/, $path);
1571
24
34
                if(scalar(@parts) > 0) {
1572
24
21
                        my $ref = \%merged;
1573
24
27
                        if(scalar(@parts) > 1) {
1574
13
34
                                $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1];
1575                        }
1576
24
56
                        $ref->{$parts[-1]} = $value;
1577
24
24
16
98
                        push @{$self->{'_source_records'}}, {
1578                                type      => 'argv',
1579                                label     => $arg,
1580                                flat_data => { join('.', @parts) => $value },
1581                        };
1582                }
1583        }
1584
1585
859
809
        if($self->{'flatten'}) {
1586
30
57
                $self->_load_driver('Hash::Flatten', ['flatten']);
1587        } else {
1588
829
1044
                $self->_load_driver('Hash::Flatten', ['unflatten']);
1589        }
1590        # $self->{config} = $self->{flatten} ? flatten(\%merged) : unflatten(\%merged);
1591        # Don't unflatten because of RT#166761
1592
859
1280
        $self->{config} = $self->{flatten} ? flatten(\%merged) : \%merged;
1593
1594
859
6747
        Hash::Merge::set_clone_behavior($saved_clone);
1595
1596
859
4684
        if(my $enc_key = $self->_get_encryption_key()) {
1597
59
66
                $self->_decrypt_config_values($self->{'config'}, $enc_key);
1598        }
1599}
1600
1601 - 1646
=head2 get(key)

Retrieve a configuration value using dotted key notation (e.g.,
C<'database.user'>). Returns C<undef> if the key doesn't exist or if
C<key> is C<undef>.

=head3 EXAMPLE

  my $cfg = Config::Abstraction->new(
      data        => { database => { host => 'localhost', port => 5432 } },
      config_dirs => [],
  );

  my $host = $cfg->get('database.host');   # 'localhost'
  my $port = $cfg->get('database.port');   # 5432
  my $miss = $cfg->get('database.user');   # undef  -- key absent

=head3 API SPECIFICATION

=head4 Input

  key  -- SCALAR  -- dotted key path (e.g. 'database.host').
                     C<undef> is allowed and returns C<undef> silently.

=head4 Output

  SCALAR or reference -- the value stored under C<key>, or C<undef> if absent.

=head3 MESSAGES

  (none) -- missing keys return undef, no warning is raised.

=head3 PSEUDOCODE

  if key is undef: return undef
  call _ensure_loaded
  if flatten mode: return config[key] (direct lookup)
  parts = split sep_char from key
  ref = config hashref
  for each part:
    if ref is not a HASH: return undef
    if part not in ref:   return undef
    ref = ref[part]
  return ref

=cut
1647
1648sub get
1649{
1650
649
42059
        my ($self, $key) = @_;
1651
1652
649
657
        return undef unless defined $key;
1653
1654
644
820
        $self->_ensure_loaded();
1655
1656
641
616
        if($self->{flatten}) {
1657
17
39
                return $self->{config}{$key};
1658        }
1659
624
450
        my $ref = $self->{'config'};
1660
624
1371
        for my $part (split $self->{'_sep_re'}, $key) {
1661
804
759
                return undef unless ref $ref eq 'HASH';
1662
800
838
                return unless exists $ref->{$part};
1663
768
674
                $ref = $ref->{$part};
1664        }
1665
588
1145
        if((defined($ref) && (ref($ref) eq 'HASH') && !$self->{'no_fixate'})) {
1666
35
65
                if($self->_load_data_reuse()) {
1667
0
0
                        if(ref($ref) eq 'HASH') {
1668
0
0
                                if(!tied %$ref) {
1669                                        # Pass the hashref directly (not dereferenced) so fixate receives
1670                                        # a named scalar it can make read-only without flattening the hash
1671                                        # FIXME:
1672                                        # What works on MacOS doesn't work
1673                                        # on Linux and vice versa.
1674                                        # Something is wrong.
1675                                        # Data::Reuse::fixate(%{$ref}) if scalar(keys %{$ref});
1676                                        # Data::Reuse::fixate($ref) if scalar(keys %{$ref});
1677                                }
1678                        } elsif(ref($ref) eq 'ARRAY') {
1679                                # RT#171980
1680                                # Data::Reuse::fixate(@{$ref});
1681                        }
1682                }
1683        }
1684
588
1153
        return $ref;
1685}
1686
1687sub _load_data_reuse
1688{
1689
42
37
        my $self = $_[0];
1690
1691        # Skip fixation entirely if caller has opted out
1692
42
49
        return 0 if($self->{'no_fixate'});
1693
1694        # Return cached result to avoid repeated require attempts
1695
39
41
        return 1 if($self->{reuse_loaded});
1696
38
48
        return 0 if($self->{reuse_failed});
1697
1698
26
17
        eval {
1699
26
1184
                require Data::Reuse;
1700
0
0
                Data::Reuse->import();
1701        };
1702
26
769
        if($@) {
1703                # Cache the failure so we do not attempt to load again
1704
26
28
                $self->{reuse_failed} = 1;
1705
26
30
                return 0;
1706        }
1707
0
0
        $self->{reuse_loaded} = 1;
1708
0
0
        return 1;
1709}
1710
1711 - 1743
=head2 exists(key)

Test whether a configuration key is present, using dotted key notation
(e.g., C<'database.user'>).  Returns C<1> when the key exists (even if its
value is C<undef>), C<0> otherwise.  Returns C<0> when C<key> is C<undef>.

=head3 EXAMPLE

  my $cfg = Config::Abstraction->new(
      data        => { timeout => undef, retries => 3 },
      config_dirs => [],
  );

  $cfg->exists('timeout');   # 1 -- key present even though value is undef
  $cfg->exists('retries');   # 1
  $cfg->exists('missing');   # 0
  $cfg->exists(undef);       # 0

=head3 API SPECIFICATION

=head4 Input

  key  -- SCALAR  -- dotted key path.  C<undef> returns C<0>.

=head4 Output

  boolean

=head3 MESSAGES

  (none)

=cut
1744
1745sub exists
1746{
1747
53
1428
        my ($self, $key) = @_;
1748
1749
53
65
        return 0 unless defined $key;
1750
1751
50
70
        $self->_ensure_loaded();
1752
1753
50
62
        if($self->{flatten}) {
1754
10
25
                return exists($self->{config}{$key}) ? 1 : 0;
1755        }
1756
40
32
        my $ref = $self->{'config'};
1757
40
98
        for my $part (split $self->{'_sep_re'}, $key) {
1758
52
62
                return 0 unless ref $ref eq 'HASH';
1759
49
65
                return 0 if(!exists($ref->{$part}));
1760
38
42
                $ref = $ref->{$part};
1761        }
1762
26
62
        return 1;
1763}
1764
1765 - 1800
=head2 all()

Returns the entire merged configuration as a hashref, or C<undef> when no
configuration data was found.  When C<flatten =E<gt> 1> was given to the
constructor the keys are dotted strings (e.g. C<'database.host'>); otherwise
the hash is nested.

The special key C<config_path> within the returned hashref is an arrayref
listing every file that was loaded, in load order.

=head3 EXAMPLE

  my $cfg = Config::Abstraction->new(
      data        => { host => 'localhost', port => 5432 },
      config_dirs => [],
  );

  my $all = $cfg->all();
  # { host => 'localhost', port => 5432, config_path => [] }

=head3 API SPECIFICATION

=head4 Input

  (none)

=head4 Output

  HASHREF  -- the full merged config (includes C<config_path> key).
  undef    -- when the merged config is empty and no data was supplied.

=head3 MESSAGES

  (none) -- returns undef silently when empty.

=cut
1801
1802sub all
1803{
1804
85
1304
        my $self = shift;
1805
1806
85
106
        $self->_ensure_loaded();
1807
1808
85
107
        return if(!$self->{config});
1809
1810        # This is good for debugging, but not much more and it breaks inheritance, so disabled
1811        # if($self->_load_data_reuse()) {
1812                # Data::Reuse::fixate($self->{config});
1813        # }
1814
1815
84
84
52
154
        return(scalar(keys %{$self->{'config'}})) ? $self->{'config'} : undef;
1816}
1817
1818 - 1907
=head2 explain_sources()

Returns a hashref describing where each configuration key came from and in
what order the sources that set it were applied.

Each key of the returned hashref is a dotted key name (e.g. C<'database.user'>).
The corresponding value is a hashref with two fields:

=over 4

=item * C<value>

The final merged value for that key after all sources have been applied.

=item * C<sources>

An arrayref of hashrefs, ordered from lowest to highest precedence (i.e. the
last element is always the winning source). Each entry has:

=over 4

=item * C<type> -- one of C<'data'>, C<'file'>, C<'env'>, or C<'argv'>

=item * C<label> -- a human-readable identifier: a file path, an environment
variable name (e.g. C<'APP_DATABASE__USER'>), a CLI argument string, or
C<'constructor data argument'>

=item * C<value> -- what this source set the key to (may differ from C<value>
at the top level if a later source overrode it)

=back

=back

Keys set by exactly one source have a single-element C<sources> list.
Keys whose value was never overridden will show the same C<value> in both the
top-level field and the sole C<sources> entry.

=head3 USAGE EXAMPLE

  use Config::Abstraction;

  local $ENV{APP_HOST} = 'prod.example.com';

  my $cfg = Config::Abstraction->new(
      data        => { host => 'localhost', port => 5432 },
      config_dirs => ['/etc/myapp'],
  );

  use Data::Dumper;
  print Dumper( $cfg->explain_sources() );
  # {
  #   'host' => {
  #     value   => 'prod.example.com',
  #     sources => [
  #       { type => 'data', label => 'constructor data argument', value => 'localhost' },
  #       { type => 'env',  label => 'APP_HOST',                  value => 'prod.example.com' },
  #     ],
  #   },
  #   'port' => {
  #     value   => 5432,
  #     sources => [
  #       { type => 'data', label => 'constructor data argument', value => 5432 },
  #     ],
  #   },
  # }

=head3 API SPECIFICATION

=head4 Input

None (instance method; takes no arguments beyond C<$self>).

=head4 Output

HASHREF where each key is a dotted config key and each value is:

  {
      value   => SCALAR,
      sources => [
          {
              type  => 'data'|'file'|'env'|'argv',
              label => SCALAR,
              value => SCALAR,
          },
          ...
      ],
  }

=cut
1908
1909sub explain_sources
1910{
1911
39
475
        my $self = shift;
1912
1913
39
54
        $self->_ensure_loaded();
1914
1915
39
42
        my %final_flat = _flatten_keys($self->{'config'});
1916
39
37
        my %result;
1917
1918
39
44
        for my $key (keys %final_flat) {
1919
83
49
                my @key_sources;
1920
83
83
58
88
                for my $layer (@{$self->{'_source_records'} // []}) {
1921
105
95
                        if(exists $layer->{'flat_data'}{$key}) {
1922                                push @key_sources, {
1923                                        type  => $layer->{'type'},
1924                                        label => $layer->{'label'},
1925
98
141
                                        value => $layer->{'flat_data'}{$key},
1926                                };
1927                        }
1928                }
1929                $result{$key} = {
1930
83
116
                        value   => $final_flat{$key},
1931                        sources => \@key_sources,
1932                };
1933        }
1934
39
69
        return \%result;
1935}
1936
1937# ---------------------------------------------------------------------------
1938# _value_from_type -- scan _source_records for the last record of the given
1939# type that provided a value for $key.  Source records always use '.' as the
1940# key separator regardless of sep_char, so we normalise $key before the lookup.
1941#
1942# Returns ($found, $value): $found is true when the source type contributed to
1943# the key, letting callers distinguish "source set key to undef" from "source
1944# never set it".
1945# ---------------------------------------------------------------------------
1946sub _value_from_type
1947{
1948
57
57
        my ($self, $type, $key) = @_;
1949
1950
57
60
        return (0, undef) unless defined $key;
1951
1952
54
65
        $self->_ensure_loaded();
1953
1954
54
44
        my $sep = $self->{'sep_char'};
1955
54
82
        my $flat_key = ($sep eq '.') ? $key : join('.', split /\Q$sep\E/, $key);
1956
1957
54
39
        my ($found, $val);
1958
54
54
31
70
        for my $layer (@{$self->{'_source_records'} // []}) {
1959
93
107
                next unless $layer->{'type'} eq $type;
1960
35
43
                if(exists $layer->{'flat_data'}{$flat_key}) {
1961
28
21
                        $found = 1;
1962
28
28
                        $val   = $layer->{'flat_data'}{$flat_key};
1963                }
1964        }
1965
54
69
        return ($found, $val);
1966}
1967
1968 - 1991
=head2 prefer_env(key)

Return the value that an environment variable provided for C<key>, bypassing
any later sources (e.g. CLI arguments) that may have overridden it.
Falls back to the normal merged value from C<get(key)> when no environment
variable contributed to C<key>.

=head3 EXAMPLE

  local $ENV{APP_DATABASE__HOST} = 'env-host';
  my $host = $cfg->prefer_env('database.host');
  # Returns 'env-host' even if --APP_DATABASE__HOST=cli-host was also passed.

=head3 API SPECIFICATION

=head4 Input

  key -- SCALAR -- dotted key path.

=head4 Output

  SCALAR  -- the env-layer value, or C<get(key)> when no env var set it.

=cut
1992
1993sub prefer_env
1994{
1995
15
34
        my ($self, $key) = @_;
1996
15
19
        my ($found, $val) = $self->_value_from_type('env', $key);
1997
15
38
        return $found ? $val : $self->get($key);
1998}
1999
2000 - 2022
=head2 prefer_file(key)

Return the value that a configuration file provided for C<key>, bypassing
environment variables and CLI arguments that may have overridden it.
Falls back to the normal merged value from C<get(key)> when no file
contributed to C<key>.

=head3 EXAMPLE

  my $host = $cfg->prefer_file('database.host');
  # Returns the file-sourced value even if APP_DATABASE__HOST is set.

=head3 API SPECIFICATION

=head4 Input

  key -- SCALAR -- dotted key path.

=head4 Output

  SCALAR  -- the file-layer value, or C<get(key)> when no file set it.

=cut
2023
2024sub prefer_file
2025{
2026
11
22
        my ($self, $key) = @_;
2027
11
14
        my ($found, $val) = $self->_value_from_type('file', $key);
2028
11
24
        return $found ? $val : $self->get($key);
2029}
2030
2031 - 2057
=head2 prefer_data(key)

Return the value that the C<data> constructor argument provided for C<key>,
bypassing files, environment variables, and CLI arguments that may have
overridden it.
Falls back to the normal merged value from C<get(key)> when C<data> did not
contribute to C<key>.

=head3 EXAMPLE

  my $cfg = Config::Abstraction->new(
      data        => { timeout => 30 },
      config_dirs => ['/etc/myapp'],
  );
  my $t = $cfg->prefer_data('timeout');   # always 30, regardless of files/env

=head3 API SPECIFICATION

=head4 Input

  key -- SCALAR -- dotted key path.

=head4 Output

  SCALAR  -- the data-layer value, or C<get(key)> when C<data> did not set it.

=cut
2058
2059sub prefer_data
2060{
2061
15
29
        my ($self, $key) = @_;
2062
15
18
        my ($found, $val) = $self->_value_from_type('data', $key);
2063
15
31
        return $found ? $val : $self->get($key);
2064}
2065
2066 - 2092
=head2 prefer_argv(key)

Return the value that a CLI argument provided for C<key>.
Falls back to the normal merged value from C<get(key)> when no CLI argument
contributed to C<key>.

Because CLI arguments are the highest-precedence source, this method is
primarily useful for writing self-documenting code or for detecting whether
a key was explicitly supplied on the command line.

=head3 EXAMPLE

  my $level = $cfg->prefer_argv('log.level');
  # Equivalent to $cfg->get('log.level') unless you specifically need to
  # confirm the value came from @ARGV.

=head3 API SPECIFICATION

=head4 Input

  key -- SCALAR -- dotted key path.

=head4 Output

  SCALAR  -- the argv-layer value, or C<get(key)> when no CLI arg set it.

=cut
2093
2094sub prefer_argv
2095{
2096
12
75
        my ($self, $key) = @_;
2097
12
15
        my ($found, $val) = $self->_value_from_type('argv', $key);
2098
12
25
        return $found ? $val : $self->get($key);
2099}
2100
2101 - 2153
=head2 encrypt_value($plaintext)

Encrypt a plaintext string using the configured AES-256-GCM key and return an
C<ENC[AES256GCM,...]> token suitable for storing in a configuration file.

Each call generates a fresh random nonce, so the same plaintext produces a
different token every time.  The token is authenticated (GCM tag); any
modification causes decryption to croak.

Requires L<CryptX> (C<Crypt::AuthEnc::GCM>, C<Crypt::PRNG>).

=head3 EXAMPLE

  # Generate a token to paste into base.yaml:
  my $cfg = Config::Abstraction->new(
      encryption_key => $hex_key,
      config_dirs    => [],
      lazy           => 1,
  );
  my $token = $cfg->encrypt_value('s3cr3t_password');
  # ENC[AES256GCM,QkJCQkJCQkJCQkJCO6Gfb0o5jwqB1R...]

  # Or use config-dump from the command line:
  #   config-dump --encrypt-value 's3cr3t_password' --encryption-key $KEY

=head3 API SPECIFICATION

=head4 Input

  plaintext  -- SCALAR  -- the string to encrypt.  May be empty.

=head4 Output

  SCALAR  -- the ENC[AES256GCM,...] token (always a printable ASCII string).

=head3 MESSAGES

  "<class>: no encryption key configured ..." -- croak when no key is available.
  "<class>: CryptX (Crypt::AuthEnc::GCM) is required ..." -- croak when CryptX absent.

=head3 PSEUDOCODE

  call _ensure_loaded
  key = _get_encryption_key() -- croak if undef
  load Crypt::AuthEnc::GCM and Crypt::PRNG -- croak if absent
  nonce = 12 random bytes
  gcm = new GCM('AES', key)
  gcm.iv_add(nonce)
  ciphertext = gcm.encrypt_add(plaintext)
  tag = gcm.encrypt_done()
  return "ENC[AES256GCM," + base64url(nonce + ciphertext + tag) + "]"

=cut
2154
2155sub encrypt_value
2156{
2157
37
600
        my ($self, $plaintext) = @_;
2158
2159
37
53
        $self->_ensure_loaded();
2160
2161
37
33
        my $key = $self->_get_encryption_key()
2162                or Carp::croak(ref($self) . ': no encryption key configured (set encryption_key, encryption_key_file, or ENCRYPTION_KEY env var)');
2163
2164
34
37
        unless($self->_load_driver('Crypt::AuthEnc::GCM')) {
2165
2
8
                Carp::croak(ref($self) . ': CryptX (Crypt::AuthEnc::GCM) is required; install it with: cpanm CryptX');
2166        }
2167
32
41
        unless($self->_load_driver('Crypt::PRNG', ['random_bytes'])) {
2168
1
3
                Carp::croak(ref($self) . ': CryptX (Crypt::PRNG) is required; install it with: cpanm CryptX');
2169        }
2170
2171
31
234
        require MIME::Base64;
2172
2173
31
1297
        my $nonce = random_bytes($_AES_NONCE_SIZE);
2174
31
565
        my $gcm   = Crypt::AuthEnc::GCM->new('AES', $key);
2175
31
50
        $gcm->iv_add($nonce);
2176
31
55
        my $ct  = $gcm->encrypt_add($plaintext);
2177
31
61
        my $tag = $gcm->encrypt_done();
2178
2179
31
56
        return 'ENC[AES256GCM,' . MIME::Base64::encode_base64url($nonce . $ct . $tag, '') . ']';
2180}
2181
2182 - 2224
=head2 merge_defaults

Merge the configuration hash into the given hash.

  package MyPackage;
  use Params::Get;
  use Config::Abstraction;

  sub new
  {
    my $class = shift;

    my $params = Params::Get::get_params(undef, \@_) || {};

    if(my $config = Config::Abstraction->new(env_prefix => "${class}::")) {
      $params = $config->merge_defaults(defaults => $params, merge => 1, section => $class);
    }

    return bless $params, $class;
  }

Options:

=over 4

=item * merge

Usually,
what's in the object will overwrite what's in the defaults hash,
if given,
the result will be a combination of the hashes.

=item * section

Merge in that section from the configuration file.

=item * deep

Try harder to merge all configurations from the global section of the configuration file.

=back

=cut
2225
2226sub merge_defaults
2227{
2228
39
1521
        my $self = shift;
2229
39
52
        my $config = $self->all();
2230
2231
39
48
        return $config if(scalar(@_) == 0);
2232
2233
36
50
        my $params = Params::Get::get_params('defaults', @_);
2234
36
448
        my $defaults = $params->{'defaults'};
2235
36
43
        return $config if(!defined($defaults));
2236
30
29
        my $section = $params->{'section'};
2237
2238        # Work on a shallow copy so we never mutate $self->{'config'} directly.
2239        # Without this, 'delete $config->{global}' below would permanently alter
2240        # the live internal hash on every call.
2241
30
30
23
49
        my %config_copy = %{$config};
2242
30
31
        $config = \%config_copy;
2243
2244        # Save and restore Hash::Merge's clone behaviour so we don't leak the
2245        # no-clone global state into unrelated merge() calls (e.g. inside
2246        # _load_config when a new object is constructed after this method runs).
2247
30
33
        my $saved_clone = Hash::Merge::get_clone_behavior();
2248
30
132
        Hash::Merge::set_clone_behavior(0);
2249
2250
30
153
        if(exists $config->{'global'}) {
2251
10
15
                if($params->{'deep'}) {
2252
3
14
                        $defaults = merge($config->{'global'}, $defaults);
2253                } else {
2254
7
7
7
5
8
11
                        $defaults = { %{$defaults}, %{$config->{'global'}} };
2255                }
2256
10
171
                delete $config->{'global'};
2257        }
2258
30
50
        if($section && exists $config->{$section}) {
2259
7
9
                $config = $config->{$section};
2260        }
2261
30
24
        my $result;
2262
30
37
        if($params->{'merge'}) {
2263
7
12
                $result = merge($config, $defaults);
2264        } else {
2265
23
23
23
26
21
36
                $result = { %{$defaults}, %{$config} };
2266        }
2267
29
327
        Hash::Merge::set_clone_behavior($saved_clone);
2268
29
157
        return $result;
2269}
2270
2271# Helper routine to load a driver.
2272# NOTE: Log::Abstraction must NOT be loaded via this method - it is
2273# bootstrapped directly in new() to avoid a circular initialisation
2274# dependency where _load_driver would attempt to log via an as-yet
2275# uninitialised logger.
2276sub _load_driver
2277{
2278
1407
1775
        my($self, $driver, $imports) = @_;
2279
2280
1407
1636
        return 1 if($self->{'loaded'}{$driver});
2281
1334
1201
        return 0 if($self->{'failed'}{$driver});
2282
2283
1323
33912
        eval "require $driver";
2284
1323
248695
        if($@) {
2285
68
86
                if(my $logger = $self->{'logger'}) {
2286
7
17
                        $logger->warn(ref($self), ": $driver failed to load: $@");
2287                }
2288
68
100
                $self->{'failed'}{$driver} = 1;
2289
68
108
                return;
2290        }
2291
1255
1255
829
12677
        $driver->import(@{ $imports // [] });
2292
1255
1329
        $self->{'loaded'}{$driver} = 1;
2293
1255
1032
        return 1;
2294}
2295
2296 - 2425
=head2 Remote configuration directories (Newcastle Connection)

Any entry in C<config_dirs> whose path begins with C</../> is treated as a
remote specification rather than a local directory:

  /../hostname/path/to/dir

The hostname and directory are extracted, and the same standard files searched
locally (C<base.yaml>, C<local.yaml>, C<base.json>, etc.) are fetched from
the remote machine via L<File::Slurp::Remote> over SSH.

When the hostname resolves to the local machine -- C<localhost>, C<127.0.0.1>,
C<::1>, or the value returned by C<Sys::Hostname::hostname()> (checked as
both fully-qualified and short form, case-insensitively) -- the C</../host/>
wrapper is silently unwrapped and the enclosed path is processed through the
normal local file pipeline instead.  No SSH connection is made.  This means a
configuration written for a shared remote host degrades gracefully when run on
that host itself:

  # On any other machine: fetches /etc/myapp over SSH
  # On cfg-server itself: reads /etc/myapp from disk directly
  config_dirs => ['/../cfg-server/etc/myapp']

Remote directories participate in the normal merge pipeline and can be freely
mixed with local ones:

  my $cfg = Config::Abstraction->new(
      config_dirs => [
          '/etc/myapp',                        # local
          '/../deploy@cfg-server/etc/myapp',   # remote via SSH (local on cfg-server)
      ],
  );

SSH authentication is handled by the system SSH client.
No extra constructor options are required; use your SSH agent or
C<~/.ssh/config> for host-specific settings.

L<File::Slurp::Remote> must be installed for remote directories to work.
If it is absent the directory is silently skipped and a warning is emitted.

=head3 Why C</../> (the Newcastle Connection convention)

Several syntaxes were considered for marking a C<config_dirs> entry as remote.
Each alternative was rejected for a concrete reason:

=over 4

=item C<hostname/path> -- ambiguous

Indistinguishable from a relative local directory named C<hostname>.
The module cannot tell at parse time whether C<myserver/etc> is a two-level
local path or a remote specification.

=item C<hostname:/path> -- collides with Windows drive letters

The C<X:\> drive-letter convention on Windows uses exactly the same
C<letter:> prefix.  A single-letter hostname would be misidentified as a
drive, and path-normalisation code on Windows would mangle it.

=item C<file://hostname/path> -- wrong semantics

RFC 8089 defines C<file://> as a reference to a B<local> file.
C<file:///etc/passwd> (three slashes, empty host) is the canonical local form;
C<file://hostname/path> is reserved for the host component but is explicitly
discouraged for general use and is not understood by most tooling as meaning
SSH.

=item C<ssh://hostname/path> -- requires URI parsing

Introduces a dependency on URI parsing (or a bespoke prefix check) and
implies a specific transport.  C<File::Slurp::Remote> already abstracts
the transport; encoding C<ssh://> in the path would be misleading if a future
version of that module supports other transports such as C<rsync://>.

=item C</../hostname/path> -- the Newcastle Connection

The Newcastle Connection (Brownbridge, Dion, Elsworth, 1982) is a distributed
Unix convention in which the token C</../> at the start of a pathname means
"leave the local namespace and enter the named remote host".
It works because C</../> B<cannot exist> as a real filesystem path:
C<..> from the root directory resolves back to the root on every POSIX system,
so C</../> always denotes the root itself, never a child of the root.
No pathname-normalisation step, C<chdir>, or filesystem traversal will ever
produce a path that legitimately begins with C</../>, which means the prefix
is a permanent, collision-free sentinel that requires only a regex to detect.

=back

The Newcastle Connection prefix is therefore the only choice that is:

=over 4

=item * unambiguous on all platforms (POSIX and Windows)

=item * impossible to produce accidentally from a real local path

=item * detectable with a single C<m{^\Q/../\E}> regex, no URI parser needed

=item * transport-neutral (the hostname is passed to whatever remote driver is installed)

=back

=head2 AUTOLOAD

This module supports dynamic access to configuration keys via AUTOLOAD.
Nested keys are accessible using the separator,
so C<$config-E<gt>database_user()> resolves to C<< $config->{database}->{user} >>,
when C<sep_char> is set to '_'.

    $config = Config::Abstraction->new(
        data => {
            database => {
                user => 'alice',
                pass => 'secret'
            },
            log_level => 'debug'
        },
        flatten => 1,
        sep_char => '_'
    );

    my $user = $config->database_user();     # returns 'alice'

    # or
    $user = $config->database()->{'user'};        # returns 'alice'

    # Attempting to call a nonexistent key
    my $foo = $config->nonexistent_key();    # dies with error

=cut
2426
2427# ---------------------------------------------------------------------------
2428# _parse_remote_dir -- detect Newcastle Connection style paths.
2429#
2430# Returns ($host, $dir) when $dir begins with /../, empty list otherwise.
2431# The /../ prefix is syntactically impossible for a real local path so no
2432# real directory entry is ever misidentified.
2433# ---------------------------------------------------------------------------
2434sub _parse_remote_dir
2435{
2436
351
1162
        my ($self, $dir) = @_;
2437
2438
351
316
        return unless defined($dir);
2439
349
576
        return unless $dir =~ m{^\Q/../\E([^/]+)(/.+)?$};
2440
10
28
        return ($1, $2 // '/');
2441}
2442
2443# ---------------------------------------------------------------------------
2444# _is_local_host -- true when $host refers to the machine running this code.
2445#
2446# Strips any user@ prefix first, then checks the four common ways a caller
2447# might spell "here": the loopback name, the two loopback addresses, and the
2448# system hostname (both fully-qualified and short).  Comparison is
2449# case-insensitive because hostnames are case-insensitive by RFC 1034.
2450# ---------------------------------------------------------------------------
2451sub _is_local_host
2452{
2453
20
26
        my ($self, $host) = @_;
2454
2455
20
33
        return 0 unless defined($host) && length($host);
2456
2457
18
19
        (my $bare = $host) =~ s/^[^@]+@//;      # strip optional user@ prefix
2458
2459
18
30
        return 1 if lc($bare) eq 'localhost';
2460
11
12
        return 1 if $bare eq '127.0.0.1';
2461
8
9
        return 1 if $bare eq '::1';
2462
2463        # Cache the resolved hostname on the object so Sys::Hostname::hostname()
2464        # (a syscall) is only made once per Config::Abstraction instance.
2465
7
7
        unless(defined $self->{'_cached_hostname'}) {
2466
3
295
                require Sys::Hostname;
2467
3
1269
                $self->{'_cached_hostname'} = lc(Sys::Hostname::hostname());
2468
3
22
                ($self->{'_cached_short_hostname'} = $self->{'_cached_hostname'}) =~ s/\..*$//;
2469        }
2470
7
15
        return 1 if lc($bare) eq $self->{'_cached_hostname'};
2471
5
5
        return 1 if lc($bare) eq $self->{'_cached_short_hostname'};
2472
2473
4
7
        return 0;
2474}
2475
2476# ---------------------------------------------------------------------------
2477# _load_remote_dir -- fetch and merge standard config files from one remote
2478# host/directory pair.
2479#
2480# Silently skips files that do not exist; warns (or logs) on parse errors.
2481# Merges into %$merged_ref using the same Hash::Merge LEFT_PRECEDENT strategy
2482# as the local pipeline, so remote values override earlier local values.
2483# ---------------------------------------------------------------------------
2484sub _load_remote_dir
2485{
2486
14
692
        if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) {
2487
1
21
                Carp::croak('Illegal Operation: This method can only be called by a subclass');
2488        }
2489
2490
13
131
        my ($self, $host, $remote_dir, $merged_ref, $file_list) = @_;
2491
13
14
        my $logger = $self->{'logger'};
2492
2493
13
15
        unless($self->_load_driver('File::Slurp::Remote')) {
2494
3
5
                my $msg = ref($self) . ": File::Slurp::Remote required for /../$host$remote_dir but is not installed";
2495
3
14
                $logger ? $logger->warn($msg) : Carp::carp($msg);
2496
3
97
                return;
2497        }
2498
2499        # Use the same file list as the local pipeline (includes TOML and env-specific tiers).
2500        # Fall back to the legacy list if none was passed (e.g. from very old callers).
2501
10
1
22
2
        my @files = $file_list ? @{$file_list}
2502                : qw(base.yaml base.yml base.json base.xml base.ini base.toml
2503                     local.yaml local.yml local.json local.xml local.ini local.toml);
2504
2505
10
10
        for my $file (@files) {
2506
113
64
                my $remote_path = "/../$host$remote_dir/$file";
2507
2508
113
88
                if($logger) {
2509
48
51
                        $logger->debug(ref($self), ' ', __LINE__, ": Looking for remote config $remote_path");
2510                }
2511
2512
113
292
                my $raw = $self->_slurp_remote($host, "$remote_dir/$file");
2513
113
316
                next unless defined($raw);
2514
2515
6
6
                if($logger) {
2516
3
3
                        $logger->debug(ref($self), ' ', __LINE__, ": Loading remote config $remote_path");
2517                }
2518
2519
6
23
                my $data = $self->_parse_config_string($raw, $file, $remote_path);
2520
6
8
                next unless defined($data);
2521
2522
5
6
                if(ref($data) ne 'HASH') {
2523
3
4
                        my $msg = ref($self) . ": remote $remote_path did not yield a hash; skipping";
2524
3
18
                        $logger ? $logger->warn($msg) : Carp::carp($msg);
2525
3
125
                        next;
2526                }
2527
2528
2
2
2
6
                push @{$self->{'_source_records'}}, {
2529                        type      => 'file',
2530                        label     => $remote_path,
2531                        flat_data => { _flatten_keys($data) },
2532                };
2533
2
2
2
3
69
2
                %{$merged_ref} = %{ merge($data, $merged_ref) };
2534
2
2
2
4
                push @{$merged_ref->{'config_path'}}, $remote_path;
2535        }
2536}
2537
2538# ---------------------------------------------------------------------------
2539# _slurp_remote -- read a single file from a remote host via SSH.
2540#
2541# Wraps File::Slurp::Remote::read_file; returns the raw string on success
2542# or undef on any error (connection refused, file absent, permission denied).
2543# Errors are logged at debug level so missing files are not noisy.
2544# ---------------------------------------------------------------------------
2545sub _slurp_remote
2546{
2547
15
215
        my ($self, $host, $path) = @_;
2548
15
8
        my $logger = $self->{'logger'};
2549
2550        # NOTE: verify the calling convention of your installed File::Slurp::Remote.
2551        # Common forms: read_file("$host:$path") or read_file($host, $path).
2552
15
15
9
13
        my $content = eval { File::Slurp::Remote::read_file($host, $path) };
2553
2554
15
24
        if($@) {
2555
2
3
                if($logger) {
2556
1
2
                        $logger->debug(ref($self), ' ', __LINE__, ": Could not read $path from $host: $@");
2557                }
2558
2
7
                return undef;
2559        }
2560
13
11
        return $content;
2561}
2562
2563# ---------------------------------------------------------------------------
2564# _parse_config_string -- parse a raw config string by extension.
2565#
2566# Mirrors the format-detection logic used for local files.  INI content is
2567# written to a File::Temp scratch file because Config::IniFiles requires a
2568# real filesystem path; the temp file is removed as soon as parsing returns.
2569#
2570# Returns a hashref on success, undef on failure.
2571# ---------------------------------------------------------------------------
2572sub _parse_config_string
2573{
2574
19
410
        if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) {
2575
1
17
                Carp::croak('Illegal Operation: This method can only be called by a subclass');
2576        }
2577
2578
18
175
        my ($self, $raw, $filename, $label) = @_;
2579
18
16
        my $logger = $self->{'logger'};
2580
18
13
        my $data;
2581
2582
18
10
        eval {
2583
18
55
                if($filename =~ /\.ya?ml$/i) {
2584
9
14
                        $self->_load_driver('YAML::XS', ['Load']);
2585
9
138
                        $data = YAML::XS::Load($raw);
2586
6
527
                        $data = $self->_sanitize_yaml_values($data) if defined($data) && ref($data);
2587
2588                } elsif($filename =~ /\.json$/i) {
2589
1
7
                        $data = decode_json($raw);
2590
2591                } elsif($filename =~ /\.xml$/i) {
2592
5
10
                        if($self->_load_driver('XML::Simple', ['XMLin'])) {
2593
0
0
                                if($raw !~ /<!ENTITY\s+\w+\s+(?:SYSTEM|PUBLIC)\b/i) {
2594
0
0
                                        $data = XMLin(\$raw, ForceArray => 0, KeyAttr => []);
2595                                }
2596                        } elsif($self->_load_driver('XML::PP')) {
2597
5
8
                                my $pp = XML::PP->new();
2598
5
77
                                if(my $tree = $pp->parse(\$raw)) {
2599
4
1578
                                        $data = $pp->collapse_structure($tree);
2600
4
95
                                        $data = $data->{'config'} if ($data && $data->{'config'});
2601                                }
2602                        }
2603
2604                } elsif($filename =~ /\.ini$/i) {
2605
2
3
                        $self->_load_driver('Config::IniFiles');
2606
2
3
                        require File::Temp;
2607
2
8
                        my $tmp = File::Temp->new(SUFFIX => '.ini', UNLINK => 1);
2608
2
2
546
7
                        print {$tmp} $raw;
2609
2
38
                        $tmp->flush();
2610
2
5
                        if(my $ini = Config::IniFiles->new(-file => $tmp->filename())) {
2611                                $data = { map {
2612
1
1
579
6
                                        my $section = $_;
2613
1
2
2
22
                                        $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) }
2614                                } $ini->Sections() };
2615                        }
2616                }
2617        };
2618
2619
18
542
        if($@) {
2620
3
4
                my $err = $@;
2621
3
5
                my $msg = ref($self) . ": Failed to parse $label: $err";
2622
3
18
                $logger ? $logger->warn($msg) : Carp::carp($msg);
2623
3
206
                return undef;
2624        }
2625
2626
15
24
        return $data;
2627}
2628
2629sub AUTOLOAD
2630{
2631
917
255755
        our $AUTOLOAD;
2632
2633
917
649
        my $self = shift;
2634
917
727
        my $key = $AUTOLOAD;
2635
2636
917
1957
        $key =~ s/.*:://;       # remove package name
2637
917
14212
        return if $key eq 'DESTROY';
2638
2639
40
58
        $self->_ensure_loaded();
2640
2641        # my $val = $self->get($key);
2642        # return $val if(defined($val));
2643
2644        # Always use the merged config, not the raw pre-merge $self->{data}.
2645        # Using $self->{data} here would bypass file and env overrides entirely.
2646
40
36
        my $data = $self->{'config'};
2647
40
48
        my $sep  = $self->{'sep_char'};
2648
2649        # When flattening is ON, Hash::Flatten stores keys with '.' as separator.
2650        # Convert the sep_char-separated AUTOLOAD key to the dotted form first,
2651        # then fall back to the raw key in case sep_char happens to be '.'.
2652
40
58
        if($self->{flatten}) {
2653
10
10
10
13
30
10
                my $dot_key = ($sep ne '.') ? do { (my $k = $key) =~ s/\Q$sep\E/./g; $k } : $key;
2654
10
27
                return $data->{$dot_key} if exists $data->{$dot_key};
2655
2
5
                return $data->{$key}     if exists $data->{$key};
2656
1
7
                croak "No such config key '$key'";
2657        }
2658
2659        # Nested (non-flat) mode: walk the config tree one part at a time.
2660
30
23
        my $val = $data;
2661
30
110
        foreach my $part (split /\Q$sep\E/, $key) {
2662
45
88
                if((ref($val) eq 'HASH') && (exists $val->{$part})) {
2663
37
41
                        $val = $val->{$part};
2664                } else {
2665
8
65
                        croak "No such config key '$key'";
2666                }
2667        }
2668
22
50
        return $val;
2669}
2670
26711;
2672
2673 - 3109
=head1 ENCRYPTED VALUES

Config::Abstraction supports transparent AES-256-GCM encryption of individual
configuration values.  This lets you store secrets (passwords, API keys, tokens)
in config files without exposing them as plaintext, even when those files are
committed to version control.

=head2 Quick start

B<Step 1 -- generate a key:>

  # 32 random bytes, encoded as 64 hex chars
  perl -e 'use Crypt::PRNG qw(random_bytes); use MIME::Base64 qw(encode_base64url);
           print encode_base64url(random_bytes(32)), "\n"'

Store the result in an environment variable or a key file (outside version control):

  export ENCRYPTION_KEY=<the 44-char base64url output>

B<Step 2 -- encrypt a secret value:>

  perl -MConfig::Abstraction -e '
    my $cfg = Config::Abstraction->new(data => {});
    print $cfg->encrypt_value("my_secret_password"), "\n";
  '

This prints something like:

  ENC[AES256GCM,QkJCQkJCQkJCQkJCO6Gfb0o5...]

B<Step 3 -- paste the token into your config file:>

  # config/base.yaml
  database:
    host: db.example.com
    user: myapp
    password: 'ENC[AES256GCM,QkJCQkJCQkJCQkJCO6Gfb0o5...]'

B<Step 4 -- load and use normally:>

  my $cfg = Config::Abstraction->new(config_dirs => ['config']);
  # $cfg->get('database.password') returns 'my_secret_password' -- already decrypted

=head2 Key configuration

The encryption key is resolved in this order (first match wins):

=over 4

=item 1. C<encryption_key> constructor option (raw bytes, hex, or base64)

=item 2. C<{env_prefix}ENCRYPTION_KEY> environment variable (default: C<APP_ENCRYPTION_KEY>)

=item 3. C<ENCRYPTION_KEY> environment variable

=item 4. File at C<encryption_key_file> constructor option

=item 5. File at C<{env_prefix}ENCRYPTION_KEY_FILE> environment variable

=item 6. File at C<ENCRYPTION_KEY_FILE> environment variable

=back

The key file should contain the key on its first line in any supported format.
B<Never commit the key to version control.>

=head2 Token format

  ENC[AES256GCM,<base64url(nonce || ciphertext || tag)>]

=over 4

=item * C<AES256GCM> -- AES-256 in GCM mode (authenticated encryption)

=item * Nonce -- 12 random bytes (fresh per encryption, never reused)

=item * GCM authentication tag -- 16 bytes; any modification causes decryption to croak

=item * Base64url encoding -- URL-safe alphabet, no padding ambiguity

=back

=head2 Behaviour when no key is configured

If no key is found, C<ENC[...]> tokens are left as literal strings.  This means
the feature is purely opt-in: existing deployments without a key configured are
unaffected.

=head2 Requirements

L<CryptX> (C<Crypt::AuthEnc::GCM>, C<Crypt::PRNG>) must be installed:

  cpanm CryptX

=head1 COMMON PITFALLS

=head2 1. new() returns undef when no configuration is found

C<new()> returns C<undef>, not a blessed object, when no configuration data is
found and no C<data> argument was supplied.  Every caller must check the return value.

  my $cfg = Config::Abstraction->new(config_dirs => ['/etc/myapp']);
  die "No configuration found" unless defined $cfg;
  my $host = $cfg->get('database.host');   # safe

Forgetting the check leads to a cryptic "Can't call method on undef" error later,
with a stack trace that points to C<get()> rather than to the missing config file.

=head2 2. merge_defaults() requires a named argument, not a bare hashref

  # WRONG -- Params::Get fast-path returns the whole config unchanged
  my $merged = $cfg->merge_defaults(\%my_defaults);

  # RIGHT
  my $merged = $cfg->merge_defaults(defaults => \%my_defaults);

With the first form, C<Params::Get> treats the single hashref as the entire
parameter bag and returns the full config without merging anything.

=head2 3. Shallow merge in merge_defaults() silently drops nested keys from defaults

Without C<merge =E<gt> 1>, C<merge_defaults()> uses a plain Perl hash merge
(C<{ %defaults, %config }>) at the top level.  If the config contains a nested hash
for a key, it entirely replaces the corresponding nested hash in your defaults - any
keys that exist only in the defaults' nested hash are silently discarded.

  my $cfg = Config::Abstraction->new(
      data        => { db => { host => 'localhost', port => 5432 } },
      config_dirs => [],
  );

  my $merged = $cfg->merge_defaults(defaults => { db => { user => 'guest' } });
  # $merged->{db}{user} is UNDEF -- the whole 'db' hash was replaced by the config's version

  # To combine nested keys from both sides, pass merge => 1:
  my $merged = $cfg->merge_defaults(defaults => { db => { user => 'guest' } }, merge => 1);
  # $merged->{db}{user} is 'guest', $merged->{db}{host} is 'localhost'

=head2 4. undef from a higher-priority source permanently wins

C<Hash::Merge> LEFT_PRECEDENT means that an explicit C<undef> (YAML C<~>) in a
higher-priority source overrides a real value in a lower-priority source, including
when the lower-priority value is defined.

  # base.yaml:  timeout: 30
  # local.yaml: timeout: ~

  my $t = $cfg->get('timeout');   # undef -- local.yaml's null wins over base.yaml

This is intentional: it lets a local config deliberately unset a value.  If you
want to detect whether a key was explicitly nulled versus simply absent, use
C<explain_sources()> and inspect the C<sources> list.

=head2 5. Double underscore vs. single underscore in environment variable names

Single underscores are part of the key name; double underscores create a nesting level.

  APP_LOG_LEVEL=debug       => key 'log_level'   (single underscore, flat key)
  APP_DATABASE__HOST=db     => key 'database.host' (double underscore, nested)
  APP_API__RATE_LIMIT=100   => key 'api.rate_limit' (double underscore + single)

A common mistake is using single underscores expecting nested keys:

  APP_DATABASE_HOST=db   # produces key 'database_host', NOT 'database.host'

=head2 6. Using AUTOLOAD requires sep_char set to '_'

AUTOLOAD translates method names to config keys using C<sep_char>.  The default
C<sep_char> is C<'.'>, but method names cannot contain dots.  Set C<sep_char =E<gt> '_'>
to use AUTOLOAD, and be aware that this makes single underscores into hierarchy separators.

  my $cfg = Config::Abstraction->new(
      data    => { database => { host => 'localhost' } },
      sep_char => '_',
      config_dirs => [],
  );
  my $host = $cfg->database_host();   # works
  my $bad  = $cfg->no_such_key();    # dies: No such config key 'no_such_key'

=head2 7. Absolute config_file paths require an empty or omitted config_dirs

On Unix, C<File::Spec-E<gt>catfile('/etc', '/absolute/path.yaml')> concatenates the
two strings instead of letting the absolute path take over, producing a wrong path.
When C<config_file> is an absolute path, either omit C<config_dirs> entirely
(the constructor sets it to C<['']> automatically) or pass C<config_dirs =E<gt> ['']>
explicitly.

  # WRONG on Unix -- produces '/etc/etc/myapp/app.yaml'
  Config::Abstraction->new(
      config_file => '/etc/myapp/app.yaml',
      config_dirs => ['/etc'],
  );

  # RIGHT
  Config::Abstraction->new( config_file => '/etc/myapp/app.yaml' );

=head2 8. Tests must isolate from the developer's real config files

A call to C<new()> without C<config_dirs> will scan C</etc>, C<~/.conf>,
C<~/.config>, and other default locations and load any C<base.yaml> or
C<local.yaml> it finds there.  In a test suite this injects real host
configuration into your test object, causing non-deterministic failures.

Always pass C<config_dirs =E<gt> []> in tests that use only in-memory C<data>:

  my $cfg = Config::Abstraction->new(
      data        => { key => 'value' },
      config_dirs => [],              # do not scan the filesystem
  );

=head2 9. lazy => 1 defers errors until the first accessor call

With C<lazy =E<gt> 1>, C<new()> always returns a blessed object - it cannot return
C<undef> for a missing config, and any schema validation errors surface at the first
C<get()> or C<all()> call rather than at construction time.  See the C<lazy>
option documentation in L</new> for the full list of debugging implications.

=head1 VERSION HISTORY

Notable changes by release.  Full details are in the C<Changes> file.

=over 4

=item * B<0.40> (unreleased)

TOML file support (C<*.toml>) via C<TOML::Tiny>; C<base.toml> and C<local.toml>
are now discovered automatically alongside the YAML/JSON/XML/INI equivalents,
and TOML is also tried in the all-parsers chain for extensionless C<config_file>
entries.
Lazy loading (C<lazy =E<gt> 1> constructor option) defers all source discovery
and file I/O until the first accessor call.
New C<explain_sources()> method returns a per-key audit trail showing every
source that contributed to a value, in precedence order.
New C<prefer_env()>, C<prefer_file()>, C<prefer_data()>, and C<prefer_argv()>
shortcut methods return the value from a specific source layer without re-ordering.
Fixed C<merge_defaults()> permanently mutating the internal config hash
(now works on a shallow copy).
Fixed C<Hash::Merge> clone-behaviour global state leaking between calls
(C<get_clone_behavior()> is now saved and restored, preventing "Can't store CODE
items" crashes when C<data> contains coderefs).
Newcastle Connection remote configuration: C<config_dirs> entries beginning with
C</../hostname/path> are fetched over SSH via L<File::Slurp::Remote>.
Local-host entries (C</../localhost/>, C</../127.0.0.1/>, etc.) are short-circuited
to a plain local read - no SSH connection is made.

=item * B<0.39> (2026-05-24)

Disabled C<Data::Reuse::fixate()> - behaviour differed between Linux and macOS
in a way that could not be resolved portably.

=item * B<0.38> (2026-05-20)

Fixed corruption of coderefs and blessed objects passed via the C<data> argument
(added C<_is_plain_scalar()> guard in the YAML value-munging loop).
Fixed C<exists()> to return explicit C<0> rather than empty string in flat mode.
Fixed C<Data::Reuse::fixate()> crash in C<get()>.
Fixed circular initialisation crash when the C<logger> option is provided.
Documented the C<defaults> argument to C<new()>.

=item * B<0.36> (2025-10-15)

Added C<exists()> method.
Files that fail to parse now emit a warning and are skipped rather than aborting
construction.

=item * B<0.34> (2025-09-05)

Added C<bin/config-dump> CLI tool.
Schema validation via C<Params::Validate::Strict> (C<schema> option).

=item * B<0.25> (2025-05-15)

Added C<merge_defaults()> C<merge> option (recursive Hash::Merge merge).

=item * B<0.20> (2025-05-06)

Added C<merge_defaults()>.

=item * B<0.19> (2025-05-06)

The C<data> constructor argument now sets default values that are overridden by files.

=item * B<0.13> (2025-04-22)

Added C<data> option to C<new()>.
Added AUTOLOAD support for method-style key access.
Added C<sep_char> option.

=item * B<0.06> (2025-04-09)

C<config_path> key in C<all()> output lists the files actually loaded.
Format drivers are now lazy-loaded (only C<require>d when a file of that format is
found).

=item * B<0.01> (2025-04-07)

First release.

=back

=head1 LIMITATIONS

=over 4

=item * B<No separator escaping>

The separator character (C<sep_char>, default C<.>) cannot be embedded in a key name.
A key that literally contains a dot cannot be accessed via C<get()> when C<sep_char> is
the default.  Workaround: set C<sep_char> to a character not present in any key.

=item * B<Data::Reuse fixation disabled>

The C<Data::Reuse::fixate()> call inside C<get()> is currently a no-op because the
behaviour of C<Crypt::Storable::dclone> differs between Linux and macOS in a way
that cannot be resolved portably (RT#100461).  Hash values returned by C<get()> are
mutable references, not read-only copies.

=item * B<Windows environment variable case sensitivity>

On Windows, environment variable names are case-insensitive at the OS level but
case-sensitive in C<%ENV> as seen by Perl.  Overriding config keys via environment
variables may silently fail if the case does not match exactly.

=item * B<AUTOLOAD requires sep_char set to '_'>

AUTOLOAD method dispatch converts underscores to key separators.  If C<sep_char> is
the default C<'.'>, AUTOLOAD cannot reach nested keys because Perl method names cannot
contain dots.

=item * B<Remote directory TOML support requires File::Slurp::Remote>

TOML files in Newcastle Connection remote directories are only fetched when the
C<File::Slurp::Remote> module is installed.  Without it, remote directories are
skipped entirely regardless of file format.

=back

=head1 BUGS

It should be possible to escape the separator character either with backslashes or quotes.

Due to the case-insensitive nature of environment variables on Windows,
it may be challenging to override values using environment variables on that platform.

=head1 REPOSITORY

L<https://github.com/nigelhorne/Config-Abstraction>

=head1 SUPPORT

This module is provided as-is without any warranty.

Please report any bugs or feature requests to C<bug-config-abstraction at rt.cpan.org>,
or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Config-Abstraction>.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

You can find documentation for this module with the perldoc command.

    perldoc Config::Abstraction

=head1 SEE ALSO

=over 4

=item * L<File::Slurp::Remote>

    Used to fetch configuration from remote hosts when C<config_dirs> contains
    Newcastle Connection paths (C</../hostname/path>).

=item * L<Config::Any>

=item * L<Config::Auto>

=item * L<Data::Reuse>

Used to C<fixate()> elements when installed, unless C<no-fixate> is given

=item * L<Hash::Merge>

=item * L<Log::Abstraction>

=item * L<Test Dashboard|https://nigelhorne.github.io/Config-Abstraction/coverage/>

=item * Development version on GitHub L<https://github.com/nigelhorne/Config-Abstraction>

=back

=head1 AUTHOR

Nigel Horne, C<< <njh at nigelhorne.com> >>

=encoding UTF-8

=head1 FORMAL SPECIFICATION

=head2 get

  get : Config x Key → Value ∪ {⊥}
  get(c, k) ≜ if k = ⊥ then ⊥
              else lookup(c.config, split(c.sep_char, k))
  lookup(h, [])      â‰œ h
  lookup(h, p:rest)  â‰œ if p ∉ dom(h) then ⊥
                        else lookup(h[p], rest)

=head2 encrypt_value

  encrypt_value : Config x Plaintext → Token
  encrypt_value(c, p) ≜
    let k  = resolve_key(c)  where k ≠ ⊥
    let n  ~ Uniform(Bytes^12)            -- fresh random nonce
    let ct = AES256GCM_enc(k, n, p)
    let t  = GCM_tag(k, n, p)
    in "ENC[AES256GCM," || base64url(n || ct || t) || "]"

=head2 exists

  exists : Config x Key → {0, 1}
  exists(c, k) ≜ if k = ⊥ then 0
                 else 1 if lookup(c.config, split(c.sep_char, k)) ≠ ⊥
                 else 0

=head2 all

  all : Config → HashRef ∪ {⊥}
  all(c) ≜ if |dom(c.config)| = 0 then ⊥ else c.config

=head1 LICENCE AND COPYRIGHT

Copyright 2025-2026 Nigel Horne.

Usage is subject to the GPL2 licence terms.
If you use it,
please let me know.

=cut
3110
31111;