File Coverage

File:blib/lib/Config/Abstraction.pm
Coverage:65.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
745277
8
138
use strict;
8
10
10
10
17
5
205
use warnings;
9
10
10
10
10
19
7
232
use Carp;
11
10
10
10
16
10
287
use JSON::MaybeXS 'decode_json';        # Doesn't behave well with require
12
10
10
10
662
32344
191
use File::Slurp qw(read_file);
13
10
10
10
21
4
95
use File::Spec;
14
10
10
10
1789
31195
291
use Hash::Merge qw(merge);
15
10
10
10
1598
35945
228
use Params::Get 0.13;
16
10
10
10
2609
168533
232
use Params::Validate::Strict 0.11;
17
10
10
10
34
5
16827
use Scalar::Util;
18
19 - 27
=head1 NAME

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

=head1 VERSION

Version 0.37

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

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

=cut
761
762sub exists
763{
764
1
1
        my ($self, $key) = @_;
765
766
1
3
        if($self->{flatten}) {
767
0
0
                return exists($self->{config}{$key});
768        }
769
1
1
        my $ref = $self->{'config'};
770
1
8
        for my $part (split qr/\Q$self->{sep_char}\E/, $key) {
771
2
3
                return 0 unless ref $ref eq 'HASH';
772
2
2
                return 0 if(!exists($ref->{$part}));
773
2
2
                $ref = $ref->{$part};
774        }
775
1
2
        return 1;
776}
777
778 - 785
=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
786
787sub all
788{
789
11
10
        my $self = shift;
790
791
11
20
        return($self->{'config'} && scalar(keys %{$self->{'config'}})) ? $self->{'config'} : undef;
792}
793
794 - 836
=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
837
838sub merge_defaults
839{
840
4
1032
        my $self = shift;
841
4
5
        my $config = $self->all();
842
843
4
5
        return $config if(scalar(@_) == 0);
844
845
4
5
        my $params = Params::Get::get_params('defaults', @_);
846
4
51
        my $defaults = $params->{'defaults'};
847
4
5
        return $config if(!defined($defaults));
848
2
1
        my $section = $params->{'section'};
849
850
2
4
        Hash::Merge::set_clone_behavior(0);
851
852
2
71
        if($config->{'global'}) {
853
0
0
                if($params->{'deep'}) {
854
0
0
                        $defaults = merge($config->{'global'}, $defaults);
855                } else {
856
0
0
0
0
0
0
                        $defaults = { %{$defaults}, %{$config->{'global'}} };
857                }
858
0
0
                delete $config->{'global'};
859        }
860
2
3
        if($section && $config->{$section}) {
861
0
0
                $config = $config->{$section};
862        }
863
2
3
        if($params->{'merge'}) {
864
1
2
                return merge($config, $defaults);
865        }
866
1
1
1
1
1
3
        return { %{$defaults}, %{$config} };
867}
868
869# Helper routine to load a driver
870sub _load_driver
871{
872
85
86
        my($self, $driver, $imports) = @_;
873
874
85
122
        return 1 if($self->{'loaded'}{$driver});
875
73
81
        return 0 if($self->{'failed'}{$driver});
876
877
68
1887
        eval "require $driver";
878
68
39040
        if($@) {
879
14
23
                if(my $logger = $self->{'logger'}) {
880
0
0
                        $logger->warn(ref($self), ": $driver failed to load: $@");
881                }
882
14
15
                $self->{'failed'}{$driver} = 1;
883
14
26
                return;
884        }
885
54
54
58
572
        $driver->import(@{ $imports // [] });
886
54
97
        $self->{'loaded'}{$driver} = 1;
887
54
60
        return 1;
888}
889
890 - 917
=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
918
919sub AUTOLOAD
920{
921
32
7786
        our $AUTOLOAD;
922
923
32
42
        my $self = shift;
924
32
26
        my $key = $AUTOLOAD;
925
926
32
76
        $key =~ s/.*:://;       # remove package name
927
32
503
        return if $key eq 'DESTROY';
928
929        # my $val = $self->get($key);
930        # return $val if(defined($val));
931
932
8
12
        my $data = $self->{data} || $self->{'config'};
933
934        # If flattening is ON, assume keys are pre-flattened
935
8
9
        if ($self->{flatten}) {
936
3
3
                return $data->{$key} if(exists $data->{$key});
937        }
938
939
8
7
        my $sep = $self->{'sep_char'};
940
941        # Fallback: try resolving nested structure dynamically
942
8
6
        my $val = $data;
943
8
25
        foreach my $part(split /\Q$sep\E/, $key) {
944
14
23
                if((ref($val) eq 'HASH') && (exists $val->{$part})) {
945
13
23
                        $val = $val->{$part};
946                } else {
947
1
10
                        croak "No such config key '$key'";
948                }
949        }
950
7
18
        return $val;
951}
952
9531;
954
955 - 1026
=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 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<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 * 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
1027