| File: | blib/lib/Config/Abstraction.pm |
| Coverage: | 89.1% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package 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 | |||||
| 17 | Readonly::Scalar my $_AES_NONCE_SIZE => 12; # GCM standard nonce length in bytes | |||||
| 18 | Readonly::Scalar my $_AES_TAG_SIZE => 16; # GCM authentication tag length in bytes | |||||
| 19 | Readonly::Scalar my $_AES_KEY_SIZE => 32; # AES-256 key length in bytes | |||||
| 20 | Readonly::Scalar my $_ENC_PAYLOAD_MIN => 28; # shortest valid payload: nonce(12) + tag(16) | |||||
| 21 | Readonly::Scalar my $_HEX_KEY_LEN => 64; # 32 bytes expressed as hexadecimal | |||||
| 22 | Readonly::Scalar my $_B64_KEY_MIN => 43; # minimum base64/base64url chars for 32 bytes | |||||
| 23 | Readonly::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 | ||||||
| 36 | our $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 | ||||||
| 674 | sub 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. | |||||
| 787 | sub _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. | |||||
| 808 | sub _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. | |||||
| 836 | sub _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. | |||||
| 852 | sub _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. | |||||
| 883 | sub _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). | |||||
| 907 | sub _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. | |||||
| 932 | sub _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. | |||||
| 983 | sub _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. | |||||
| 1011 | sub _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). | |||||
| 1039 | sub _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. | |||||
| 1072 | sub _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 | |||||
| 1094 | sub _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. | |||||
| 1112 | sub _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 | ||||||
| 1129 | sub _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 | ||||||
| 1137 | sub _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 | ||||||
| 1648 | sub 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 | ||||||
| 1687 | sub _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 | ||||||
| 1745 | sub 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 | ||||||
| 1802 | sub 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 | ||||||
| 1909 | sub 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 | # --------------------------------------------------------------------------- | |||||
| 1946 | sub _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 | ||||||
| 1993 | sub 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 | ||||||
| 2024 | sub 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 | ||||||
| 2059 | sub 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 | ||||||
| 2094 | sub 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 | ||||||
| 2155 | sub 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 | ||||||
| 2226 | sub 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. | |||||
| 2276 | sub _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 | # --------------------------------------------------------------------------- | |||||
| 2434 | sub _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 | # --------------------------------------------------------------------------- | |||||
| 2451 | sub _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 | # --------------------------------------------------------------------------- | |||||
| 2484 | sub _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 | # --------------------------------------------------------------------------- | |||||
| 2545 | sub _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 | # --------------------------------------------------------------------------- | |||||
| 2572 | sub _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 | ||||||
| 2629 | sub 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 | ||||||
| 2671 | 1; | |||||
| 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 | ||||||
| 3111 | 1; | |||||