File Coverage

File:blib/lib/Config/Abstraction.pm
Coverage:77.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# TODO: Think of a way of validating values - e.g. a value must be an integer, or match a regex
7
8
17
17
17
1892212
17
231
use strict;
9
17
17
17
28
15
367
use warnings;
10
11
17
17
17
34
16
501
use Carp;
12
17
17
17
34
18
519
use JSON::MaybeXS 'decode_json';        # Doesn't behave well with require
13
17
17
17
2401
67263
388
use File::Slurp qw(read_file);
14
17
17
17
36
11
168
use File::Spec;
15
17
17
17
3137
39414
519
use Hash::Merge qw(merge);
16
17
17
17
3165
191408
486
use Params::Get 0.14;
17
17
17
17
5064
266604
429
use Params::Validate::Strict 0.11;
18
17
17
17
57
40
31841
use Scalar::Util;
19
20 - 28
=head1 NAME

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

=head1 VERSION

Version 0.39

=cut
29
30our $VERSION = '0.39';
31
32 - 328
=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<defaults>

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

=item * C<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
329
330sub new
331{
332
296
1025119
        my $class = shift;
333
296
220
        my $params;
334
335
296
325
        if(scalar(@_) == 1) {
336                # Just one parameter - the name of a file
337
1
3
                $params = Params::Get::get_params('file', \@_);
338        } else {
339
295
465
                $params = Params::Get::get_params(undef, \@_) || {};
340        }
341
342
296
4131
        $params->{'config_dirs'} //= $params->{'path'};   # Compatibility with Config::Auto
343
344
296
323
        $params->{'config_file'} //= $params->{'file'} if($params->{'file'});
345
346
296
292
        if(!defined($params->{'config_dirs'})) {
347
15
37
                if($params->{'config_file'} && File::Spec->file_name_is_absolute($params->{'config_file'})) {
348
3
9
                        $params->{'config_dirs'} = [''];
349                } else {
350                        # Set up the default value for config_dirs
351
12
23
                        if($^O ne 'MSWin32') {
352
12
21
                                $params->{'config_dirs'} = [ '/etc', '/usr/local/etc' ];
353                        } else {
354
0
0
                                $params->{'config_dirs'} = [''];
355                        }
356
12
16
                        if($ENV{'HOME'}) {
357
11
103
                                push @{$params->{'config_dirs'}},
358                                        File::Spec->catdir($ENV{'HOME'}, '.conf'),
359                                        File::Spec->catdir($ENV{'HOME'}, '.config'),
360
11
13
                                        File::Spec->catdir($ENV{'HOME'}, 'conf'),
361                        } elsif($ENV{'DOCUMENT_ROOT'}) {
362
1
10
                                push @{$params->{'config_dirs'}},
363                                        File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, File::Spec->updir(), 'conf'),
364                                        File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, 'conf'),
365
1
1
                                        File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, 'config');
366                        }
367
12
22
                        if(my $dir = $ENV{'CONFIG_DIR'}) {
368
1
1
1
1
                                push @{$params->{'config_dirs'}}, $dir;
369                        } else {
370
11
11
7
17
                                push @{$params->{'config_dirs'}}, 'conf', 'config';
371                        }
372                }
373        }
374
375        my $self = bless {
376                sep_char => '.',
377
296
992
                %{$params->{defaults} ? $params->{defaults} : $params},
378
296
217
                env_prefix => $params->{env_prefix} || 'APP_',
379                config => {},
380        }, $class;
381
382
296
418
        if(my $logger = $self->{'logger'}) {
383
3
7
                if(!Scalar::Util::blessed($logger)) {
384                        # Don't call $self->_load_driver('Log::Abstraction') as it can make a call to logger, which is yet to be set up
385
1
31
                        eval "require Log::Abstraction";
386
1
3
                        if($@) {
387
1
15
                                carp(ref($self), ": Log::Abstraction failed to load: $@");
388                        } else {
389
0
0
                                Log::Abstraction->import();
390
0
0
                                $self->{'logger'} = Log::Abstraction->new($logger);
391
0
0
                                if($params->{'level'} && $self->{'logger'}->can('level')) {
392
0
0
                                        $self->{'logger'}->level($params->{'level'});
393                                }
394                        }
395                }
396        }
397
296
592
        $self->_load_config();
398
399
295
5011
        if(my $schema = $params->{'schema'}) {
400
10
29
                $self->{'config'} = Params::Validate::Strict::validate_strict(schema => $schema, input => $self->{'config'});
401        }
402
403
291
291
834
435
        if(defined($self->{'config'}) && scalar(keys %{$self->{'config'}})) {
404
287
646
                return $self;
405        }
406
4
12
        return undef;
407}
408
409# Determine if a value is a plain, unblessed, non-reference scalar
410# safe to use in regex/string operations.
411# Args:   value to test
412# Returns: 1 if plain scalar, 0 otherwise
413sub _is_plain_scalar
414{
415
43
7585
        my $val = $_[0];
416
417
43
48
        return 0 if !defined($val);
418
42
48
        return 0 if Scalar::Util::blessed($val);
419
41
43
        return 0 if ref($val);
420
36
41
        return 1;
421}
422
423sub _load_config
424{
425
295
381
        if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) {
426
0
0
                Carp::croak('Illegal Operation: This method can only be called by a subclass');
427        }
428
429
295
2435
        my $self = shift;
430
295
185
        my %merged;
431
432
295
294
        if($self->{'data'}) {
433                # The data argument given to 'new' contains defaults that this routine will override
434
235
235
136
494
                %merged = %{$self->{'data'}};
435        }
436
437
295
644
        my $logger = $self->{'logger'};
438
295
246
        if($logger) {
439
3
10
                $logger->trace(ref($self), ' ', __LINE__, ': Entered _load_config');
440        }
441
442
294
294
187
299
        my @dirs = @{$self->{'config_dirs'}};
443
294
343
        if($self->{'config_file'} && (scalar(@dirs) > 1)) {
444
1
6
                if(File::Spec->file_name_is_absolute($self->{'config_file'})) {
445                        # Handle absolute paths
446
1
2
                        @dirs = ('');
447                } else {
448                        # Look in the current directory
449
0
0
                        push @dirs, File::Spec->curdir();
450                }
451        }
452
294
286
        for my $dir (@dirs) {
453
160
132
                next if(!defined($dir));
454
159
771
                if(length($dir) && !-d $dir) {
455
42
44
                        next;
456                }
457
458
117
123
                for my $file (qw/base.yaml base.yml base.json base.xml base.ini local.yaml local.yml local.json local.xml local.ini/) {
459
1170
2596
                        my $path = File::Spec->catfile($dir, $file);
460
1170
1037
                        if($logger) {
461
0
0
                                $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path");
462                        }
463
1170
4749
                        next unless -f $path;
464
87
317
                        next unless -r $path;
465
466
87
84
                        if($logger) {
467
0
0
                                $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path");
468                        }
469
470
87
53
                        my $data;
471                        # Only load config modules when they are needed
472
87
242
                        if ($file =~ /\.ya?ml$/) {
473
53
90
                                $self->_load_driver('YAML::XS', ['LoadFile']);
474
53
53
52
70
                                $data = eval { LoadFile($path) };
475
53
2837
                                if($@) {
476
2
3
                                        if($logger) {
477
0
0
                                                $logger->notice("Failed to load YAML from $path: $@");
478                                        } else {
479
2
15
                                                Carp::carp("Failed to load YAML from $path: $@");
480                                        }
481
2
239
                                        next;
482                                }
483                        } elsif ($file =~ /\.json$/) {
484
10
10
10
18
                                $data = eval { decode_json(read_file($path)) };
485
10
443
                                        if($@) {
486
2
3
                                                if($logger) {
487
0
0
                                                        $logger->notice("Failed to load JSON from $path: $@");
488                                                } else {
489
2
17
                                                        Carp::carp("Failed to load JSON from $path: $@");
490                                                }
491
2
244
                                                next;
492                                        }
493                        } elsif($file =~ /\.xml$/) {
494
11
9
                                my $rc;
495
11
16
                                if($self->_load_driver('XML::Simple', ['XMLin'])) {
496
0
0
0
0
                                        eval { $rc = XMLin($path, ForceArray => 0, KeyAttr => []) };
497
0
0
                                        if($@) {
498
0
0
                                                if($logger) {
499
0
0
                                                        $logger->notice("Failed to load XML from $path: $@");
500                                                } else {
501
0
0
                                                        Carp::carp("Failed to load XML from $path: $@");
502                                                }
503
0
0
                                                undef $rc;
504                                        } elsif($rc) {
505
0
0
                                                $data = $rc;
506                                        }
507                                }
508
11
26
                                if((!defined($rc)) && $self->_load_driver('XML::PP')) {
509
11
18
                                        my $xml_pp = XML::PP->new();
510
11
158
                                        $data = read_file($path);
511
11
396
                                        if(my $tree = $xml_pp->parse(\$data)) {
512
11
5619
                                                if($data = $xml_pp->collapse_structure($tree)) {
513
11
278
                                                        $self->{'type'} = 'XML';
514
11
9
                                                        if($data->{'config'}) {
515
11
29
                                                                $data = $data->{'config'};
516                                                        }
517                                                }
518                                        }
519                                }
520                        } elsif ($file =~ /\.ini$/) {
521
13
21
                                $self->_load_driver('Config::IniFiles');
522
13
26
                                if(my $ini = Config::IniFiles->new(-file => $path)) {
523                                        $data = { map {
524
13
14
6308
76
                                                my $section = $_;
525
14
22
18
215
                                                $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) }
526                                        } $ini->Sections() };
527                                } else {
528
0
0
                                        if($logger) {
529
0
0
                                                $logger->notice("Failed to load INI from $path: $@");
530                                        } else {
531
0
0
                                                Carp::carp("Failed to load INI from $path: $@");
532                                        }
533                                }
534                        }
535
83
311
                        if($data) {
536
81
96
                                if(!ref($data)) {
537
0
0
                                        if($logger) {
538
0
0
                                                $logger->debug(ref($self), ' ', __LINE__, ": ignoring data from $path ($data)");
539                                        }
540
0
0
                                        next;
541                                }
542
81
105
                                if(ref($data) ne 'HASH') {
543
2
3
                                        if($logger) {
544
0
0
                                                $logger->debug(ref($self), ' ', __LINE__, ": ignoring data from $path (not a hashref)");
545                                        }
546
2
3
                                        next;
547                                }
548
79
112
                                if($logger) {
549
0
0
                                        $logger->debug(ref($self), ' ', __LINE__, ": Loaded data from $path");
550                                }
551
79
79
53
124
                                %merged = %{ merge( $data, \%merged ) };
552
79
79
3834
146
                                push @{$merged{'config_path'}}, $path;
553                        }
554                }
555
556                # Put $self->{config_file} through all parsers, ignoring all errors, then merge that in
557
117
143
                if(!$self->{'script_name'}) {
558
94
343
                        require File::Basename && File::Basename->import() unless File::Basename->can('basename');
559
560                        # Determine script name
561
94
2179
                        $self->{'script_name'} = File::Basename::basename($ENV{'SCRIPT_NAME'} || $0);
562                }
563
564
117
126
                my $script_name = $self->{'script_name'};
565
117
117
158
166
                for my $config_file ('default', $script_name, "$script_name.cfg", "$script_name.conf", "$script_name.config", $self->{'config_file'}, @{$self->{'config_files'}}) {
566
710
598
                        next unless defined($config_file);
567                        # Note that loading $script_name in the current directory could mean loading the script as it's own config.
568                        # This test is not foolproof, buyer beware
569
615
751
                        next if(($config_file eq $script_name) && ((length($dir) == 0) || ($dir eq File::Spec->curdir())));
570
602
1246
                        my $path = length($dir) ? File::Spec->catfile($dir, $config_file) : $config_file;
571
602
531
                        if($logger) {
572
0
0
                                $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path");
573                        }
574
602
2542
                        if((-f $path) && (-r $path)) {
575
30
76
                                my $data = read_file($path);
576
30
1331
                                if($logger) {
577
0
0
                                        $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path");
578                                }
579
30
31
                                eval {
580
30
116
                                        if(($data =~ /^\s*<\?xml/) || ($data =~ /<\/.+>/)) {
581
8
16
                                                if($self->_load_driver('XML::Simple', ['XMLin'])) {
582
0
0
                                                        if($data = XMLin($path, ForceArray => 0, KeyAttr => [])) {
583
0
0
                                                                $self->{'type'} = 'XML';
584                                                        }
585                                                } elsif($self->_load_driver('XML::PP')) {
586
8
12
                                                        my $xml_pp = XML::PP->new();
587
8
128
                                                        if(my $tree = $xml_pp->parse(\$data)) {
588
8
2724
                                                                if($data = $xml_pp->collapse_structure($tree)) {
589
8
106
                                                                        $self->{'type'} = 'XML';
590
8
8
                                                                        if($data->{'config'}) {
591
8
17
                                                                                $data = $data->{'config'};
592                                                                        }
593                                                                }
594                                                        }
595                                                }
596                                        } elsif($data =~ /\{.+:.\}/s) {
597
1
14
                                                $self->_load_driver('JSON::Parse');
598                                                # CPanel::JSON is very noisy, so be careful before attempting to use it
599
1
1
                                                my $is_json;
600
1
1
1
4
                                                eval { $is_json = JSON::Parse::parse_json($data) };
601
1
2
                                                if($is_json) {
602
1
1
1
5
                                                        eval { $data = decode_json($data) };
603
1
2
                                                        if($@) {
604
0
0
                                                                undef $data;
605                                                        }
606                                                } else {
607
0
0
                                                        undef $data;
608                                                }
609
1
2
                                                if($data) {
610
1
1
                                                        $self->{'type'} = 'JSON';
611                                                }
612                                        } else {
613
21
19
                                                undef $data;
614                                        }
615
30
48
                                        if(!$data) {
616
21
51
                                                $self->_load_driver('YAML::XS', ['LoadFile']);
617
21
21
18
33
                                                if((eval { $data = LoadFile($path) }) && (ref($data) eq 'HASH')) {
618                                                        # Could be colon file, could be YAML, whichever it is break the configuration fields
619                                                        # foreach my($k, $v) (%{$data}) {
620
18
18
947
32
                                                        foreach my $k (keys %{$data}) {
621
36
32
                                                                my $v = $data->{$k};
622
36
34
                                                                if(!defined($v)) {
623                                                                        # e.g. a simple line
624                                                                        #       foo:
625                                                                        # with nothing under it
626
0
0
                                                                        $data->{$k} = undef;
627
0
0
                                                                        next;
628                                                                }
629                                                                # Do not inspect or modify coderefs, blessed objects, or any reference
630
36
42
                                                                next unless _is_plain_scalar($v);
631
632
34
38
                                                                next if($v =~ /^".+"$/);      # Quotes to keep in one field
633
34
39
                                                                if($v =~ /,/) {
634
4
9
                                                                        my @vals = split(/\s*,\s*/, $v);
635
4
4
                                                                        delete $data->{$k};
636
4
3
                                                                        foreach my $val (@vals) {
637
8
14
                                                                                if($val =~ /(.+)=(.+)/) {
638
8
16
                                                                                        $data->{$k}{$1} = $2;
639                                                                                } else {
640
0
0
                                                                                        $data->{$k}{$val} = 1;
641                                                                                }
642                                                                        }
643                                                                }
644                                                        }
645
18
24
                                                        if($data) {
646
18
26
                                                                $self->{'type'} = 'YAML';
647                                                        }
648                                                }
649
21
184
                                                if((!$data) || (ref($data) ne 'HASH')) {
650
3
4
                                                        $self->_load_driver('Config::IniFiles');
651
3
8
                                                        if(my $ini = Config::IniFiles->new(-file => $path)) {
652                                                                $data = { map {
653
2
3
1392
19
                                                                        my $section = $_;
654
3
6
4
62
                                                                        $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) }
655                                                                } $ini->Sections() };
656
2
23
                                                                if($data) {
657
2
2
                                                                        $self->{'type'} = 'INI';
658                                                                }
659                                                        }
660
3
261
                                                        if((!$data) || (ref($data) ne 'HASH')) {
661                                                                # Maybe XML without the leading XML header
662
1
2
                                                                if($self->_load_driver('XML::Simple', ['XMLin'])) {
663
0
0
0
0
                                                                        eval { $data = XMLin($path, ForceArray => 0, KeyAttr => []) };
664                                                                }
665
1
5
                                                                if((!$data) || (ref($data) ne 'HASH')) {
666
1
2
                                                                        if($self->_load_driver('Config::Abstract')) {
667                                                                                # Handle RT#164587
668
0
0
                                                                                open my $oldSTDERR, '>&STDERR';
669
0
0
                                                                                close STDERR;
670
0
0
0
0
                                                                                eval { $data = Config::Abstract->new($path) };
671
0
0
                                                                                my $err = $@;
672
0
0
                                                                                open STDERR, '>&', $oldSTDERR;
673
0
0
                                                                                if($err) {
674
0
0
                                                                                        undef $data;
675                                                                                } elsif($data) {
676
0
0
                                                                                        $data = $data->get_all_settings();
677
0
0
0
0
                                                                                        if(scalar(keys %{$data}) == 0) {
678
0
0
                                                                                                undef $data;
679                                                                                        }
680                                                                                }
681
0
0
                                                                                $self->{'type'} = 'Perl';
682                                                                        }
683                                                                }
684
1
3
                                                                if((!$data) || (ref($data) ne 'HASH')) {
685
1
2
                                                                        $self->_load_driver('Config::Auto');
686
1
2
                                                                        my $ca = Config::Auto->new(source => $path);
687
1
14
                                                                        if($data = $ca->parse()) {
688
1
225
                                                                                $self->{'type'} = $ca->format();
689                                                                        }
690                                                                }
691                                                        }
692                                                }
693                                        }
694                                };
695
30
44
                                if($logger) {
696
0
0
                                        if($@) {
697
0
0
                                                $logger->warn(ref($self), ' ', __LINE__, ": $@");
698
0
0
                                                undef $data;
699                                        } else {
700
0
0
                                                $logger->debug(ref($self), ' ', __LINE__, ': Loaded data from', $self->{'type'}, "file $path");
701                                        }
702                                }
703
30
80
                                if(scalar(keys %merged)) {
704
7
10
                                        if($data) {
705
7
7
7
17
                                                %merged = %{ merge($data, \%merged) };
706                                        }
707                                } elsif($data && (ref($data) eq 'HASH')) {
708
23
23
20
34
                                        %merged = %{$data};
709                                } elsif((!$@) && $logger) {
710
0
0
                                        $logger->debug(ref($self), ' ', __LINE__, ': No configuration file loaded');
711                                }
712
713
30
30
382
67
                                push @{$merged{'config_path'}}, $path;
714                        }
715                }
716        }
717
718        # Merge ENV vars
719
294
222
        my $prefix = $self->{env_prefix};
720
294
277
        $prefix =~ s/__$//;
721
294
517
        $prefix =~ s/_$//;
722
294
242
        $prefix =~ s/::$//;
723
294
2029
        for my $key (keys %ENV) {
724
38474
39508
                next unless $key =~ /^$self->{env_prefix}(.*)$/i;
725
33
40
                my $path = lc($1);
726
33
50
                if($path =~ /__/) {
727
20
26
                        my @parts = split /__/, $path;
728
20
17
                        my $ref = \%merged;
729
20
53
                        $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1];
730
20
37
                        $ref->{ $parts[-1] } = $ENV{$key};
731                } else {
732
13
25
                        $merged{$prefix}->{$path} = $ENV{$key};
733                }
734        }
735
736        # Merge command line options
737
294
920
        foreach my $arg(@ARGV) {
738
20
30
                next unless($arg =~ /=/);
739
14
25
                my ($key, $value) = split(/=/, $arg, 2);
740
14
70
                next unless $key =~ /^\-\-$self->{env_prefix}(.*)$/;
741
742
12
18
                my $path = lc($1);
743
12
18
                my @parts = split(/__/, $path);
744
12
19
                if(scalar(@parts) > 0) {
745
12
13
                        my $ref = \%merged;
746
12
14
                        if(scalar(@parts) > 1) {
747
5
12
                                $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1];
748                        }
749
12
23
                        $ref->{$parts[-1]} = $value;
750                }
751        }
752
753
294
277
        if($self->{'flatten'}) {
754
19
29
                $self->_load_driver('Hash::Flatten', ['flatten']);
755        } else {
756
275
357
                $self->_load_driver('Hash::Flatten', ['unflatten']);
757        }
758        # $self->{config} = $self->{flatten} ? flatten(\%merged) : unflatten(\%merged);
759        # Don't unflatten because of RT#166761
760
294
582
        $self->{config} = $self->{flatten} ? flatten(\%merged) : \%merged;
761}
762
763 - 768
=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
769
770sub get
771{
772
249
17578
        my ($self, $key) = @_;
773
774
249
285
        if($self->{flatten}) {
775
14
31
                return $self->{config}{$key};
776        }
777
235
201
        my $ref = $self->{'config'};
778
235
899
        for my $part (split qr/\Q$self->{sep_char}\E/, $key) {
779
358
373
                return undef unless ref $ref eq 'HASH';
780
356
340
                return unless exists $ref->{$part};
781
349
326
                $ref = $ref->{$part};
782        }
783
226
610
        if((defined($ref) && (ref($ref) eq 'HASH') && !$self->{'no_fixate'})) {
784
21
29
                if($self->_load_data_reuse()) {
785
0
0
                        if(ref($ref) eq 'HASH') {
786
0
0
                                if(!tied %$ref) {
787                                        # Pass the hashref directly (not dereferenced) so fixate receives
788                                        # a named scalar it can make read-only without flattening the hash
789                                        # FIXME:
790                                        # What works on MacOS doesn't work
791                                        # on Linux and vice versa.
792                                        # Something is wrong.
793                                        # Data::Reuse::fixate(%{$ref}) if scalar(keys %{$ref});
794                                        # Data::Reuse::fixate($ref) if scalar(keys %{$ref});
795                                }
796                        } elsif(ref($ref) eq 'ARRAY') {
797                                # RT#171980
798                                # Data::Reuse::fixate(@{$ref});
799                        }
800                }
801        }
802
226
479
        return $ref;
803}
804
805sub _load_data_reuse
806{
807
26
27
        my $self = $_[0];
808
809        # Skip fixation entirely if caller has opted out
810
26
34
        return 0 if($self->{'no_fixate'});
811
812        # Return cached result to avoid repeated require attempts
813
24
26
        return 1 if($self->{reuse_loaded});
814
24
29
        return 0 if($self->{reuse_failed});
815
816
17
16
        eval {
817
17
1015
                require Data::Reuse;
818
0
0
                Data::Reuse->import();
819        };
820
17
24
        if($@) {
821                # Cache the failure so we do not attempt to load again
822
17
19
                $self->{reuse_failed} = 1;
823
17
20
                return 0;
824        }
825
0
0
        $self->{reuse_loaded} = 1;
826
0
0
        return 1;
827}
828
829 - 834
=head2 exists(key)

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

=cut
835
836sub exists
837{
838
27
211
        my ($self, $key) = @_;
839
840
27
37
        if($self->{flatten}) {
841
6
17
                return exists($self->{config}{$key}) ? 1 : 0;
842        }
843
21
17
        my $ref = $self->{'config'};
844
21
124
        for my $part (split qr/\Q$self->{sep_char}\E/, $key) {
845
30
45
                return 0 unless ref $ref eq 'HASH';
846
28
42
                return 0 if(!exists($ref->{$part}));
847
22
27
                $ref = $ref->{$part};
848        }
849
13
32
        return 1;
850}
851
852 - 859
=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
860
861sub all
862{
863
48
55
        my $self = shift;
864
865
48
71
        return if(!$self->{config});
866
867        # This is good for debugging, but not much more and it breaks inheritance, so disabled
868        # if($self->_load_data_reuse()) {
869                # Data::Reuse::fixate($self->{config});
870        # }
871
872
48
48
32
97
        return(scalar(keys %{$self->{'config'}})) ? $self->{'config'} : undef;
873}
874
875 - 917
=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
918
919sub merge_defaults
920{
921
26
1880
        my $self = shift;
922
26
60
        my $config = $self->all();
923
924
26
33
        return $config if(scalar(@_) == 0);
925
926
24
38
        my $params = Params::Get::get_params('defaults', @_);
927
24
305
        my $defaults = $params->{'defaults'};
928
24
61
        return $config if(!defined($defaults));
929
20
17
        my $section = $params->{'section'};
930
931
20
38
        Hash::Merge::set_clone_behavior(0);
932
933
20
259
        if(exists $config->{'global'}) {
934
5
9
                if($params->{'deep'}) {
935
2
5
                        $defaults = merge($config->{'global'}, $defaults);
936                } else {
937
3
3
3
4
5
7
                        $defaults = { %{$defaults}, %{$config->{'global'}} };
938                }
939
5
108
                delete $config->{'global'};
940        }
941
20
38
        if($section && exists $config->{$section}) {
942
5
6
                $config = $config->{$section};
943        }
944
20
29
        if($params->{'merge'}) {
945
5
10
                return merge($config, $defaults);
946        }
947
15
15
15
16
12
37
        return { %{$defaults}, %{$config} };
948}
949
950# Helper routine to load a driver.
951# NOTE: Log::Abstraction must NOT be loaded via this method - it is
952# bootstrapped directly in new() to avoid a circular initialisation
953# dependency where _load_driver would attempt to log via an as-yet
954# uninitialised logger.
955sub _load_driver
956{
957
436
448
        my($self, $driver, $imports) = @_;
958
959
436
603
        return 1 if($self->{'loaded'}{$driver});
960
415
409
        return 0 if($self->{'failed'}{$driver});
961
962
408
11677
        eval "require $driver";
963
408
64415
        if($@) {
964
18
30
                if(my $logger = $self->{'logger'}) {
965
0
0
                        $logger->warn(ref($self), ": $driver failed to load: $@");
966                }
967
18
23
                $self->{'failed'}{$driver} = 1;
968
18
29
                return;
969        }
970
390
390
288
4213
        $driver->import(@{ $imports // [] });
971
390
506
        $self->{'loaded'}{$driver} = 1;
972
390
327
        return 1;
973}
974
975 - 1002
=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
1003
1004sub AUTOLOAD
1005{
1006
321
97928
        our $AUTOLOAD;
1007
1008
321
248
        my $self = shift;
1009
321
292
        my $key = $AUTOLOAD;
1010
1011
321
823
        $key =~ s/.*:://;       # remove package name
1012
321
3810
        return if $key eq 'DESTROY';
1013
1014        # my $val = $self->get($key);
1015        # return $val if(defined($val));
1016
1017
24
45
        my $data = $self->{data} || $self->{'config'};
1018
1019        # If flattening is ON, assume keys are pre-flattened
1020
24
29
        if ($self->{flatten}) {
1021
4
9
                return $data->{$key} if(exists $data->{$key});
1022        }
1023
1024
23
29
        my $sep = $self->{'sep_char'};
1025
1026        # Fallback: try resolving nested structure dynamically
1027
23
23
        my $val = $data;
1028
23
96
        foreach my $part(split /\Q$sep\E/, $key) {
1029
37
75
                if((ref($val) eq 'HASH') && (exists $val->{$part})) {
1030
34
40
                        $val = $val->{$part};
1031                } else {
1032
3
29
                        croak "No such config key '$key'";
1033                }
1034        }
1035
20
47
        return $val;
1036}
1037
10381;
1039
1040 - 1111
=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 * L<Test Dashboard|https://nigelhorne.github.io/Config-Abstraction/coverage/>

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

=back

=head1 AUTHOR

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

=cut
1112