File Coverage

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

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
724113
8
131
use strict;
8
10
10
10
14
7
164
use warnings;
9
10
10
10
10
16
6
196
use Carp;
11
10
10
10
1826
77673
226
use Data::Reuse;
12
10
10
10
25
7
262
use JSON::MaybeXS 'decode_json';        # Doesn't behave well with require
13
10
10
10
686
30842
176
use File::Slurp qw(read_file);
14
10
10
10
16
7
85
use File::Spec;
15
10
10
10
1848
30483
319
use Hash::Merge qw(merge);
16
10
10
10
1588
35318
239
use Params::Get 0.13;
17
10
10
10
2447
26083
209
use Params::Validate::Strict 0.11;
18
10
10
10
20
10
16430
use Scalar::Util;
19
20 - 28
=head1 NAME

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

=head1 VERSION

Version 0.36

=cut
29
30our $VERSION = '0.36';
31
32 - 315
=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. 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.

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

Does a configuration value using dotted key notation (e.g., C<'database.user'>) exist?
Returns 0 or 1.

=cut
750
751sub exists
752{
753
1
1
        my ($self, $key) = @_;
754
755
1
2
        if($self->{flatten}) {
756
0
0
                return exists($self->{config}{$key});
757        }
758
1
1
        my $ref = $self->{'config'};
759
1
7
        for my $part (split qr/\Q$self->{sep_char}\E/, $key) {
760
2
3
                return 0 unless ref $ref eq 'HASH';
761
2
2
                return 0 if(!exists($ref->{$part}));
762
2
2
                $ref = $ref->{$part};
763        }
764
1
2
        return 1;
765}
766
767 - 774
=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
775
776sub all
777{
778
11
9
        my $self = shift;
779
780
11
20
        return($self->{'config'} && scalar(keys %{$self->{'config'}})) ? $self->{'config'} : undef;
781}
782
783 - 825
=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
826
827sub merge_defaults
828{
829
4
1006
        my $self = shift;
830
4
3
        my $config = $self->all();
831
832
4
5
        return $config if(scalar(@_) == 0);
833
834
4
5
        my $params = Params::Get::get_params('defaults', @_);
835
4
48
        my $defaults = $params->{'defaults'};
836
4
5
        return $config if(!defined($defaults));
837
2
2
        my $section = $params->{'section'};
838
839
2
3
        Hash::Merge::set_clone_behavior(0);
840
841
2
65
        if($config->{'global'}) {
842
0
0
                if($params->{'deep'}) {
843
0
0
                        $defaults = merge($config->{'global'}, $defaults);
844                } else {
845
0
0
0
0
0
0
                        $defaults = { %{$defaults}, %{$config->{'global'}} };
846                }
847
0
0
                delete $config->{'global'};
848        }
849
2
2
        if($section && $config->{$section}) {
850
0
0
                $config = $config->{$section};
851        }
852
2
3
        if($params->{'merge'}) {
853
1
1
                return merge($config, $defaults);
854        }
855
1
1
1
1
1
3
        return { %{$defaults}, %{$config} };
856}
857
858# Helper routine to load a driver
859sub _load_driver
860{
861
85
86
        my($self, $driver, $imports) = @_;
862
863
85
94
        return 1 if($self->{'loaded'}{$driver});
864
73
77
        return 0 if($self->{'failed'}{$driver});
865
866
68
1801
        eval "require $driver";
867
68
36001
        if($@) {
868
14
20
                if(my $logger = $self->{'logger'}) {
869
0
0
                        $logger->warn(ref($self), ": $driver failed to load: $@");
870                }
871
14
19
                $self->{'failed'}{$driver} = 1;
872
14
24
                return;
873        }
874
54
54
42
457
        $driver->import(@{ $imports // [] });
875
54
85
        $self->{'loaded'}{$driver} = 1;
876
54
48
        return 1;
877}
878
879 - 906
=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
907
908sub AUTOLOAD
909{
910
32
7332
        our $AUTOLOAD;
911
912
32
30
        my $self = shift;
913
32
26
        my $key = $AUTOLOAD;
914
915
32
74
        $key =~ s/.*:://;       # remove package name
916
32
485
        return if $key eq 'DESTROY';
917
918        # my $val = $self->get($key);
919        # return $val if(defined($val));
920
921
8
11
        my $data = $self->{data} || $self->{'config'};
922
923        # If flattening is ON, assume keys are pre-flattened
924
8
7
        if ($self->{flatten}) {
925
3
4
                return $data->{$key} if(exists $data->{$key});
926        }
927
928
8
5
        my $sep = $self->{'sep_char'};
929
930        # Fallback: try resolving nested structure dynamically
931
8
5
        my $val = $data;
932
8
24
        foreach my $part(split /\Q$sep\E/, $key) {
933
14
22
                if((ref($val) eq 'HASH') && (exists $val->{$part})) {
934
13
14
                        $val = $val->{$part};
935                } else {
936
1
7
                        croak "No such config key '$key'";
937                }
938        }
939
7
17
        return $val;
940}
941
9421;
943
944 - 1007
=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.

=item * Environment

When using environment variables,
remember that double underscores (__) create nested structures,
while single underscores remain as part of the key name under the prefix namespace.

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

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

=back

=head1 AUTHOR

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

=cut
1008