File Coverage

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

linestmtbrancondsubtimecode
1package Config::Abstraction;
2
3# TODO: add TOML file support
4# TODO: environment-specific encodings - automatic loading of dev/staging/prod
5# TODO: devise a scheme to encrypt passwords in config files
6
7
10
10
10
738318
9
128
use strict;
8
10
10
10
15
7
168
use warnings;
9
10
10
10
10
17
6
203
use Carp;
11
10
10
10
1924
79002
289
use Data::Reuse;
12
10
10
10
37
8
322
use JSON::MaybeXS 'decode_json';        # Doesn't behave well with require
13
10
10
10
677
31067
186
use File::Slurp qw(read_file);
14
10
10
10
21
6
119
use File::Spec;
15
10
10
10
1807
30772
293
use Hash::Merge qw(merge);
16
10
10
10
1603
35851
196
use Params::Get 0.04;
17
10
10
10
1831
9811
236
use Params::Validate::Strict;
18
10
10
10
20
10
15672
use Scalar::Util;
19
20 - 28
=head1 NAME

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

=head1 VERSION

Version 0.34

=cut
29
30our $VERSION = '0.34';
31
32 - 310
=head1 SYNOPSIS

C<Config::Abstraction> lets you load configuration from multiple sources—such as files, environment variables, and in-code defaults—and merge them with predictable precedence.
It provides a consistent API for accessing the configuration settings, regardless of where they came from,
this helps keep your application’s or class's configuration flexible, centralized, and easy to override.

  use Config::Abstraction;

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

  my $db_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 Diagram

  +----------------+
  |   CLI args     |  (Highest priority)
  +----------------+
  | Environment    |
  +----------------+
  | Config file(s) |
  +----------------+
  | Defaults       |  (Lowest priority)
  +----------------+

=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.

=back

=head2 SUPPORTED FILE FORMATS

=over 4

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

The module supports loading YAML files using the C<YAML::XS> module.

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

The module supports loading JSON files using C<JSON::MaybeXS>.

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

The module supports loading XML files using C<XML::Simple>.

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

The module supports loading INI files using C<Config::IniFiles>.

=back

=head2 ENVIRONMENT VARIABLE HANDLING

Configuration values can be overridden via environment variables. For
instance, if you have a key in the configuration such as C<database.user>,
you can override it by setting the corresponding environment variable
C<APP_DATABASE__USER> in your system.

For example:

  $ export APP_DATABASE__USER="env_user"

This will override any value set for C<database.user> in the configuration files.

=head2 COMMAND LINE HANDLING

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.

=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>).

=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<env_prefix>

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

=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.

=back

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

=cut
311
312sub new
313{
314
24
645659
        my $class = shift;
315
24
25
        my $params;
316
317
24
44
        if(scalar(@_) == 1) {
318                # Just one parameter - the name of a file
319
1
2
                $params = Params::Get::get_params('file', \@_);
320        } else {
321
23
56
                $params = Params::Get::get_params(undef, \@_) || {};
322        }
323
324
24
417
        $params->{'config_dirs'} //= $params->{'path'};   # Compatibility with Config::Auto
325
326
24
52
        if((!defined($params->{'config_dirs'})) && $params->{'file'}) {
327
1
4
                $params->{'config_file'} = $params->{'file'};
328        }
329
330
24
31
        if(!defined($params->{'config_dirs'})) {
331
6
22
                if($params->{'config_file'} && File::Spec->file_name_is_absolute($params->{'config_file'})) {
332
1
2
                        $params->{'config_dirs'} = [''];
333                } else {
334                        # Set up the default value for config_dirs
335
5
8
                        if($^O ne 'MSWin32') {
336
5
11
                                $params->{'config_dirs'} = [ '/etc', '/usr/local/etc' ];
337                        } else {
338
0
0
                                $params->{'config_dirs'} = [''];
339                        }
340
5
10
                        if($ENV{'HOME'}) {
341
5
45
                                push @{$params->{'config_dirs'}},
342                                        File::Spec->catdir($ENV{'HOME'}, '.conf'),
343                                        File::Spec->catdir($ENV{'HOME'}, '.config'),
344
5
10
                                        File::Spec->catdir($ENV{'HOME'}, 'conf'),
345                        } elsif($ENV{'DOCUMENT_ROOT'}) {
346
0
0
                                push @{$params->{'config_dirs'}},
347                                        File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, File::Spec->updir(), 'conf'),
348                                        File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, 'conf'),
349
0
0
                                        File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, 'config');
350                        }
351
5
10
                        if(my $dir = $ENV{'CONFIG_DIR'}) {
352
0
0
0
0
                                push @{$params->{'config_dirs'}}, $dir;
353                        } else {
354
5
5
2
8
                                push @{$params->{'config_dirs'}}, 'conf', 'config';
355                        }
356                }
357        }
358
359        my $self = bless {
360                sep_char => '.',
361
24
120
                %{$params->{defaults} ? $params->{defaults} : $params},
362
24
28
                env_prefix => $params->{env_prefix} || 'APP_',
363                config => {},
364        }, $class;
365
366
24
51
        if(my $logger = $self->{'logger'}) {
367
0
0
                if(!Scalar::Util::blessed($logger)) {
368
0
0
                        $self->_load_driver('Log::Abstraction');
369
0
0
                        $self->{'logger'} = Log::Abstraction->new($logger);
370
0
0
                        if($params->{'level'} && $self->{'logger'}->can('level')) {
371
0
0
                                $self->{'logger'}->level($params->{'level'});
372                        }
373                }
374        }
375
24
44
        $self->_load_config();
376
377
24
872
        if(my $schema = $params->{'schema'}) {
378
1
3
                $self->{'config'} = Params::Validate::Strict::validate_strict(schema => $schema, input => $self->{'config'});
379        }
380
381
23
23
39
39
        if($self->{'config'} && scalar(keys %{$self->{'config'}})) {
382
22
70
                return $self;
383        }
384
1
4
        return undef;
385}
386
387sub _load_config
388{
389
24
63
        if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) {
390
0
0
                Carp::croak('Illegal Operation: This method can only be called by a subclass');
391        }
392
393
24
260
        my $self = shift;
394
24
23
        my %merged;
395
396
24
34
        if($self->{'data'}) {
397                # The data argument given to 'new' contains defaults that this routine will override
398
7
7
3
9
                %merged = %{$self->{'data'}};
399        }
400
401
24
26
        my $logger = $self->{'logger'};
402
24
29
        if($logger) {
403
0
0
                $logger->trace(ref($self), ' ', __LINE__, ': Entered _load_config');
404        }
405
406
24
24
22
36
        my @dirs = @{$self->{'config_dirs'}};
407
24
51
        if($self->{'config_file'} && (scalar(@dirs) > 1)) {
408
0
0
                if(File::Spec->file_name_is_absolute($self->{'config_file'})) {
409                        # Handle absolute paths
410
0
0
                        @dirs = ('');
411                } else {
412                        # Look in the current directory
413
0
0
                        push @dirs, File::Spec->curdir();
414                }
415        }
416
24
32
        for my $dir (@dirs) {
417
54
61
                next if(!defined($dir));
418
419
54
47
                for my $file (qw/base.yaml base.yml base.json base.xml base.ini local.yaml local.yml local.json local.xml local.ini/) {
420
540
1064
                        my $path = File::Spec->catfile($dir, $file);
421
540
457
                        if($logger) {
422
0
0
                                $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path");
423                        }
424
540
1373
                        next unless -f $path;
425
426
32
34
                        if($logger) {
427
0
0
                                $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path");
428                        }
429
430
32
24
                        my $data;
431                        # TODO: only load config modules when they are needed
432
32
126
                        if ($file =~ /\.ya?ml$/) {
433
7
12
                                $self->_load_driver('YAML::XS', ['LoadFile']);
434
7
7
8
9
                                $data = eval { LoadFile($path) };
435
7
348
                                croak "Failed to load YAML from $path: $@" if $@;
436                        } elsif ($file =~ /\.json$/) {
437
5
5
4
7
                                $data = eval { decode_json(read_file($path)) };
438
5
197
                                croak "Failed to load JSON from $path: $@" if $@;
439                        } elsif($file =~ /\.xml$/) {
440
10
5
                                my $rc;
441
10
16
                                if($self->_load_driver('XML::Simple', ['XMLin'])) {
442
0
0
0
0
                                        eval { $rc = XMLin($path, ForceArray => 0, KeyAttr => []) };
443
0
0
                                        if($@) {
444
0
0
                                                if($logger) {
445
0
0
                                                        $logger->notice("Failed to load XML from $path: $@");
446                                                } else {
447
0
0
                                                        Carp::carp("Failed to load XML from $path: $@");
448                                                }
449
0
0
                                                undef $rc;
450                                        } elsif($rc) {
451
0
0
                                                $data = $rc;
452                                        }
453                                }
454
10
17
                                if((!defined($rc)) && $self->_load_driver('XML::PP')) {
455
10
12
                                        my $xml_pp = XML::PP->new();
456
10
140
                                        $data = read_file($path);
457
10
398
                                        if(my $tree = $xml_pp->parse(\$data)) {
458
10
2052
                                                if($data = $xml_pp->collapse_structure($tree)) {
459
10
252
                                                        $self->{'type'} = 'XML';
460
10
9
                                                        if($data->{'config'}) {
461
10
13
                                                                $data = $data->{'config'};
462                                                        }
463                                                }
464                                        }
465                                }
466                        } elsif ($file =~ /\.ini$/) {
467
10
13
                                $self->_load_driver('Config::IniFiles');
468
10
19
                                if(my $ini = Config::IniFiles->new(-file => $path)) {
469                                        $data = { map {
470
10
10
4406
47
                                                my $section = $_;
471
10
15
14
152
                                                $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) }
472                                        } $ini->Sections() };
473                                } else {
474
0
0
                                        if($logger) {
475
0
0
                                                $logger->notice("Failed to load INI from $path: $@");
476                                        } else {
477
0
0
                                                Carp::carp("Failed to load INI from $path: $@");
478                                        }
479                                }
480                        }
481
32
200
                        if($data) {
482
32
31
                                if($logger) {
483
0
0
                                        $logger->debug(ref($self), ' ', __LINE__, ": Loaded data from $path");
484                                }
485
32
32
22
48
                                %merged = %{ merge( $data, \%merged ) };
486
32
32
1835
44
                                push @{$merged{'config_path'}}, $path;
487                        }
488                }
489
490                # Put $self->{config_file} through all parsers, ignoring all errors, then merge that in
491
54
55
                if(!$self->{'script_name'}) {
492
24
112
                        require File::Basename && File::Basename->import() unless File::Basename->can('basename');
493
494                        # Determine script name
495
24
598
                        $self->{'script_name'} = File::Basename::basename($ENV{'SCRIPT_NAME'} || $0);
496                }
497
498
54
45
                my $script_name = $self->{'script_name'};
499
54
54
73
47
                for my $config_file ('default', $script_name, "$script_name.cfg", "$script_name.conf", "$script_name.config", $self->{'config_file'}, @{$self->{'config_files'}}) {
500
328
242
                        next unless defined($config_file);
501                        # Note that loading $script_name in the current directory could mean loading the script as it's own config.
502                        # This test is not foolproof, buyer beware
503
285
289
                        next if(($config_file eq $script_name) && ((length($dir) == 0) || ($dir eq File::Spec->curdir())));
504
281
568
                        my $path = length($dir) ? File::Spec->catfile($dir, $config_file) : $config_file;
505
281
244
                        if($logger) {
506
0
0
                                $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path");
507                        }
508
281
789
                        if((-f $path) && (-r $path)) {
509
13
27
                                my $data = read_file($path);
510
13
571
                                if($logger) {
511
0
0
                                        $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path");
512                                }
513
13
14
                                eval {
514
13
52
                                        if(($data =~ /^\s*<\?xml/) || ($data =~ /<\/.+>/)) {
515
7
13
                                                if($self->_load_driver('XML::Simple', ['XMLin'])) {
516
0
0
                                                        if($data = XMLin($path, ForceArray => 0, KeyAttr => [])) {
517
0
0
                                                                $self->{'type'} = 'XML';
518                                                        }
519                                                } elsif($self->_load_driver('XML::PP')) {
520
7
11
                                                        my $xml_pp = XML::PP->new();
521
7
98
                                                        if(my $tree = $xml_pp->parse(\$data)) {
522
7
1008
                                                                if($data = $xml_pp->collapse_structure($tree)) {
523
7
92
                                                                        $self->{'type'} = 'XML';
524
7
7
                                                                        if($data->{'config'}) {
525
7
11
                                                                                $data = $data->{'config'};
526                                                                        }
527                                                                }
528                                                        }
529                                                }
530                                        } elsif($data =~ /\{.+:.\}/s) {
531
0
0
                                                $self->_load_driver('JSON::Parse');
532                                                # CPanel::JSON is very noisy, so be careful before attempting to use it
533
0
0
                                                my $is_json;
534
0
0
0
0
                                                eval { $is_json = JSON::Parse::parse_json($data) };
535
0
0
                                                if($is_json) {
536
0
0
0
0
                                                        eval { $data = decode_json($data) };
537
0
0
                                                        if($@) {
538
0
0
                                                                undef $data;
539                                                        }
540                                                } else {
541
0
0
                                                        undef $data;
542                                                }
543
0
0
                                                if($data) {
544
0
0
                                                        $self->{'type'} = 'JSON';
545                                                }
546                                        } else {
547
6
5
                                                undef $data;
548                                        }
549
13
30
                                        if(!$data) {
550
6
20
                                                $self->_load_driver('YAML::XS', ['LoadFile']);
551
6
6
6
10
                                                if((eval { $data = LoadFile($path) }) && (ref($data) eq 'HASH')) {
552                                                        # Could be colon file, could be YAML, whichever it is break the configuration fields
553                                                        # foreach my($k, $v) (%{$data}) {
554
5
5
296
9
                                                        foreach my $k (keys %{$data}) {
555
19
12
                                                                my $v = $data->{$k};
556
19
21
                                                                next if($v =~ /^".+"$/);      # Quotes to keep in one field
557
19
21
                                                                if($v =~ /,/) {
558
4
10
                                                                        my @vals = split(/\s*,\s*/, $v);
559
4
2
                                                                        delete $data->{$k};
560
4
4
                                                                        foreach my $val (@vals) {
561
8
14
                                                                                if($val =~ /(.+)=(.+)/) {
562
8
15
                                                                                        $data->{$k}{$1} = $2;
563                                                                                } else {
564
0
0
                                                                                        $data->{$k}{$val} = 1;
565                                                                                }
566                                                                        }
567                                                                }
568                                                        }
569
5
8
                                                        if($data) {
570
5
6
                                                                $self->{'type'} = 'YAML';
571                                                        }
572                                                }
573
6
76
                                                if((!$data) || (ref($data) ne 'HASH')) {
574
1
2
                                                        $self->_load_driver('Config::IniFiles');
575
1
3
                                                        if(my $ini = Config::IniFiles->new(-file => $path)) {
576                                                                $data = { map {
577
0
0
0
0
                                                                        my $section = $_;
578
0
0
0
0
                                                                        $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) }
579                                                                } $ini->Sections() };
580
0
0
                                                                if($data) {
581
0
0
                                                                        $self->{'type'} = 'INI';
582                                                                }
583                                                        }
584
1
297
                                                        if((!$data) || (ref($data) ne 'HASH')) {
585                                                                # Maybe XML without the leading XML header
586
1
3
                                                                if($self->_load_driver('XML::Simple', ['XMLin'])) {
587
0
0
0
0
                                                                        eval { $data = XMLin($path, ForceArray => 0, KeyAttr => []) };
588                                                                }
589
1
5
                                                                if((!$data) || (ref($data) ne 'HASH')) {
590
1
2
                                                                        if($self->_load_driver('Config::Abstract')) {
591                                                                                # Handle RT#164587
592
0
0
                                                                                open my $oldSTDERR, ">&STDERR";
593
0
0
                                                                                close STDERR;
594
0
0
0
0
                                                                                eval { $data = Config::Abstract->new($path) };
595
0
0
                                                                                if($@) {
596
0
0
                                                                                        undef $data;
597                                                                                } elsif($data) {
598
0
0
                                                                                        $data = $data->get_all_settings();
599
0
0
0
0
                                                                                        if(scalar(keys %{$data}) == 0) {
600
0
0
                                                                                                undef $data;
601                                                                                        }
602                                                                                }
603
0
0
                                                                                open STDERR, ">&", $oldSTDERR;
604
0
0
                                                                                $self->{'type'} = 'Perl';
605                                                                        }
606                                                                }
607
1
4
                                                                if((!$data) || (ref($data) ne 'HASH')) {
608
1
1
                                                                        $self->_load_driver('Config::Auto');
609
1
2
                                                                        my $ca = Config::Auto->new(source => $path);
610
1
16
                                                                        if($data = $ca->parse()) {
611
1
265
                                                                                $self->{'type'} = $ca->format();
612                                                                        }
613                                                                }
614                                                        }
615                                                }
616                                        }
617                                };
618
13
27
                                if($logger) {
619
0
0
                                        if($@) {
620
0
0
                                                $logger->warn(ref($self), ' ', __LINE__, ": $@");
621
0
0
                                                undef $data;
622                                        } else {
623
0
0
                                                $logger->debug(ref($self), ' ', __LINE__, ': Loaded data from', $self->{'type'}, "file $path");
624                                        }
625                                }
626
13
39
                                if(scalar(keys %merged)) {
627
2
2
                                        if($data) {
628
2
2
1
2
                                                %merged = %{ merge($data, \%merged) };
629                                        }
630                                } elsif($data && (ref($data) eq 'HASH')) {
631
11
11
8
21
                                        %merged = %{$data};
632                                } elsif((!$@) && $logger) {
633
0
0
                                        $logger->debug(ref($self), ' ', __LINE__, ': No configuration file loaded');
634                                }
635
636
13
13
94
29
                                push @{$merged{'config_path'}}, $path;
637                        }
638                }
639        }
640
641        # Merge ENV vars
642
24
26
        my $prefix = $self->{env_prefix};
643
24
30
        $prefix =~ s/__$//;
644
24
49
        $prefix =~ s/_$//;
645
24
18
        $prefix =~ s/::$//;
646
24
243
        for my $key (keys %ENV) {
647
2351
2396
                next unless $key =~ /^$self->{env_prefix}(.*)$/i;
648
14
13
                my $path = lc($1);
649
14
13
                if($path =~ /__/) {
650
10
11
                        my @parts = split /__/, $path;
651
10
7
                        my $ref = \%merged;
652
10
22
                        $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1];
653
10
19
                        $ref->{ $parts[-1] } = $ENV{$key};
654                } else {
655
4
6
                        $merged{$prefix}->{$path} = $ENV{$key};
656                }
657        }
658
659        # Merge command line options
660
24
91
        foreach my $arg(@ARGV) {
661
1
2
                next unless($arg =~ /=/);
662
1
2
                my ($key, $value) = split(/=/, $arg, 2);
663
1
8
                next unless $key =~ /^\-\-$self->{env_prefix}(.*)$/;
664
665
1
2
                my $path = lc($1);
666
1
1
                my @parts = split(/__/, $path);
667
1
1
                my $ref = \%merged;
668
1
2
                $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1];
669
1
1
                $ref->{ $parts[-1] } = $value;
670        }
671
672
24
31
        if($self->{'flatten'}) {
673
2
5
                $self->_load_driver('Hash::Flatten', ['flatten']);
674        } else {
675
22
41
                $self->_load_driver('Hash::Flatten', ['unflatten']);
676        }
677        # $self->{config} = $self->{flatten} ? flatten(\%merged) : unflatten(\%merged);
678        # Don't unflatten because of RT#166761
679
24
63
        $self->{config} = $self->{flatten} ? flatten(\%merged) : \%merged;
680}
681
682 - 687
=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.

=cut
688
689sub get
690{
691
27
1004
        my ($self, $key) = @_;
692
693
27
47
        if($self->{flatten}) {
694
2
5
                return $self->{config}{$key};
695        }
696
25
19
        my $ref = $self->{'config'};
697
25
109
        for my $part (split qr/\Q$self->{sep_char}\E/, $key) {
698
39
35
                return undef unless ref $ref eq 'HASH';
699
39
41
                $ref = $ref->{$part};
700        }
701
25
54
        if((defined($ref) && !$self->{'no_fixate'})) {
702
24
42
                if(ref($ref) eq 'HASH') {
703
0
0
0
0
                        Data::Reuse::fixate(%{$ref});
704                } elsif(ref($ref) eq 'ARRAY') {
705
1
1
1
4
                        Data::Reuse::fixate(@{$ref});
706                }
707        }
708
25
136
        return $ref;
709}
710
711 - 718
=head2 all()

Returns the entire configuration hash,
possibly flattened depending on the C<flatten> option.

The entry C<config_path> contains a list of the files that the configuration was loaded from.

=cut
719
720sub all
721{
722
9
7
        my $self = shift;
723
724
9
16
        return($self->{'config'} && scalar(keys %{$self->{'config'}})) ? $self->{'config'} : undef;
725}
726
727 - 769
=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
770
771sub merge_defaults
772{
773
4
1026
        my $self = shift;
774
4
4
        my $config = $self->all();
775
776
4
5
        return $config if(scalar(@_) == 0);
777
778
4
4
        my $params = Params::Get::get_params('defaults', @_);
779
4
48
        my $defaults = $params->{'defaults'};
780
4
6
        return $config if(!defined($defaults));
781
2
1
        my $section = $params->{'section'};
782
783
2
5
        Hash::Merge::set_clone_behavior(0);
784
785
2
63
        if($config->{'global'}) {
786
0
0
                if($params->{'deep'}) {
787
0
0
                        $defaults = merge($config->{'global'}, $defaults);
788                } else {
789
0
0
0
0
0
0
                        $defaults = { %{$defaults}, %{$config->{'global'}} };
790                }
791
0
0
                delete $config->{'global'};
792        }
793
2
3
        if($section && $config->{$section}) {
794
0
0
                $config = $config->{$section};
795        }
796
2
2
        if($params->{'merge'}) {
797
1
2
                return merge($config, $defaults);
798        }
799
1
1
1
1
1
8
        return { %{$defaults}, %{$config} };
800}
801
802# Helper routine to load a driver
803sub _load_driver
804{
805
85
92
        my($self, $driver, $imports) = @_;
806
807
85
118
        return 1 if($self->{'loaded'}{$driver});
808
73
85
        return 0 if($self->{'failed'}{$driver});
809
810
68
1879
        eval "require $driver";
811
68
37571
        if($@) {
812
14
20
                if(my $logger = $self->{'logger'}) {
813
0
0
                        $logger->warn(ref($self), ": $driver failed to load: $@");
814                }
815
14
18
                $self->{'failed'}{$driver} = 1;
816
14
29
                return;
817        }
818
54
54
62
513
        $driver->import(@{ $imports // [] });
819
54
92
        $self->{'loaded'}{$driver} = 1;
820
54
57
        return 1;
821}
822
823 - 850
=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
851
852sub AUTOLOAD
853{
854
32
7510
        our $AUTOLOAD;
855
856
32
23
        my $self = shift;
857
32
31
        my $key = $AUTOLOAD;
858
859
32
69
        $key =~ s/.*:://;       # remove package name
860
32
506
        return if $key eq 'DESTROY';
861
862        # my $val = $self->get($key);
863        # return $val if(defined($val));
864
865
8
11
        my $data = $self->{data} || $self->{'config'};
866
867        # If flattening is ON, assume keys are pre-flattened
868
8
8
        if ($self->{flatten}) {
869
3
3
                return $data->{$key} if(exists $data->{$key});
870        }
871
872
8
7
        my $sep = $self->{'sep_char'};
873
874        # Fallback: try resolving nested structure dynamically
875
8
7
        my $val = $data;
876
8
24
        foreach my $part(split /\Q$sep\E/, $key) {
877
14
26
                if((ref($val) eq 'HASH') && (exists $val->{$part})) {
878
13
13
                        $val = $val->{$part};
879                } else {
880
1
24
                        croak "No such config key '$key'";
881                }
882        }
883
7
15
        return $val;
884}
885
8861;
887
888 - 943
=head1 COMMON PITFALLS

=over 4

=item * Nested hashes

Merging replaces entire nested hashes unless you enable deep merging.

=item * Undef values

Keys explicitly set to C<undef> in a later source override earlier values.

=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 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<Config::Any>

=item * L<Config::Auto>

=item * L<Hash::Merge>

=item * L<Log::Abstraction>

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

=back

=head1 AUTHOR

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

=cut
944