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
1803829
14
179
use strict;
9
17
17
17
23
16
298
use warnings;
10
11
17
17
17
25
14
445
use Carp;
12
17
17
17
31
15
428
use JSON::MaybeXS 'decode_json';        # Doesn't behave well with require
13
17
17
17
2295
57229
371
use File::Slurp qw(read_file);
14
17
17
17
31
13
151
use File::Spec;
15
17
17
17
3197
37774
482
use Hash::Merge qw(merge);
16
17
17
17
2929
58606
356
use Params::Get 0.14;
17
17
17
17
5166
289372
370
use Params::Validate::Strict 0.11;
18
17
17
17
42
16
28989
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
951420
        my $class = shift;
333
296
213
        my $params;
334
335
296
363
        if(scalar(@_) == 1) {
336                # Just one parameter - the name of a file
337
1
2
                $params = Params::Get::get_params('file', \@_);
338        } else {
339
295
421
                $params = Params::Get::get_params(undef, \@_) || {};
340        }
341
342
296
3968
        $params->{'config_dirs'} //= $params->{'path'};   # Compatibility with Config::Auto
343
344
296
325
        $params->{'config_file'} //= $params->{'file'} if($params->{'file'});
345
346
296
290
        if(!defined($params->{'config_dirs'})) {
347
15
41
                if($params->{'config_file'} && File::Spec->file_name_is_absolute($params->{'config_file'})) {
348
3
4
                        $params->{'config_dirs'} = [''];
349                } else {
350                        # Set up the default value for config_dirs
351
12
19
                        if($^O ne 'MSWin32') {
352
12
14
                                $params->{'config_dirs'} = [ '/etc', '/usr/local/etc' ];
353                        } else {
354
0
0
                                $params->{'config_dirs'} = [''];
355                        }
356
12
22
                        if($ENV{'HOME'}) {
357
11
96
                                push @{$params->{'config_dirs'}},
358                                        File::Spec->catdir($ENV{'HOME'}, '.conf'),
359                                        File::Spec->catdir($ENV{'HOME'}, '.config'),
360
11
8
                                        File::Spec->catdir($ENV{'HOME'}, 'conf'),
361                        } elsif($ENV{'DOCUMENT_ROOT'}) {
362
1
8
                                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
28
                        if(my $dir = $ENV{'CONFIG_DIR'}) {
368
1
1
1
1
                                push @{$params->{'config_dirs'}}, $dir;
369                        } else {
370
11
11
8
16
                                push @{$params->{'config_dirs'}}, 'conf', 'config';
371                        }
372                }
373        }
374
375        my $self = bless {
376                sep_char => '.',
377
296
951
                %{$params->{defaults} ? $params->{defaults} : $params},
378
296
195
                env_prefix => $params->{env_prefix} || 'APP_',
379                config => {},
380        }, $class;
381
382
296
394
        if(my $logger = $self->{'logger'}) {
383
3
6
                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
30
                        eval "require Log::Abstraction";
386
1
707
                        if($@) {
387
1
11
                                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
1910
        $self->_load_config();
398
399
295
4682
        if(my $schema = $params->{'schema'}) {
400
10
26
                $self->{'config'} = Params::Validate::Strict::validate_strict(schema => $schema, input => $self->{'config'});
401        }
402
403
291
291
768
424
        if(defined($self->{'config'}) && scalar(keys %{$self->{'config'}})) {
404
287
584
                return $self;
405        }
406
4
10
        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
6851
        my $val = $_[0];
416
417
43
43
        return 0 if !defined($val);
418
42
52
        return 0 if Scalar::Util::blessed($val);
419
41
46
        return 0 if ref($val);
420
36
35
        return 1;
421}
422
423sub _load_config
424{
425
295
360
        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
2305
        my $self = shift;
430
295
188
        my %merged;
431
432
295
295
        if($self->{'data'}) {
433                # The data argument given to 'new' contains defaults that this routine will override
434
235
235
146
461
                %merged = %{$self->{'data'}};
435        }
436
437
295
636
        my $logger = $self->{'logger'};
438
295
258
        if($logger) {
439
3
10
                $logger->trace(ref($self), ' ', __LINE__, ': Entered _load_config');
440        }
441
442
294
294
174
286
        my @dirs = @{$self->{'config_dirs'}};
443
294
340
        if($self->{'config_file'} && (scalar(@dirs) > 1)) {
444
1
5
                if(File::Spec->file_name_is_absolute($self->{'config_file'})) {
445                        # Handle absolute paths
446
1
1
                        @dirs = ('');
447                } else {
448                        # Look in the current directory
449
0
0
                        push @dirs, File::Spec->curdir();
450                }
451        }
452
294
263
        for my $dir (@dirs) {
453
160
138
                next if(!defined($dir));
454
159
735
                if(length($dir) && !-d $dir) {
455
42
30
                        next;
456                }
457
458
117
121
                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
2449
                        my $path = File::Spec->catfile($dir, $file);
460
1170
1058
                        if($logger) {
461
0
0
                                $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path");
462                        }
463
1170
4548
                        next unless -f $path;
464
87
358
                        next unless -r $path;
465
466
87
73
                        if($logger) {
467
0
0
                                $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path");
468                        }
469
470
87
77
                        my $data;
471                        # Only load config modules when they are needed
472
87
204
                        if ($file =~ /\.ya?ml$/) {
473
53
96
                                $self->_load_driver('YAML::XS', ['LoadFile']);
474
53
53
51
64
                                $data = eval { LoadFile($path) };
475
53
3495
                                if($@) {
476
2
3
                                        if($logger) {
477
0
0
                                                $logger->notice("Failed to load YAML from $path: $@");
478                                        } else {
479
2
10
                                                Carp::carp("Failed to load YAML from $path: $@");
480                                        }
481
2
1533
                                        next;
482                                }
483                        } elsif ($file =~ /\.json$/) {
484
10
10
5
19
                                $data = eval { decode_json(read_file($path)) };
485
10
1244
                                        if($@) {
486
2
2
                                                if($logger) {
487
0
0
                                                        $logger->notice("Failed to load JSON from $path: $@");
488                                                } else {
489
2
12
                                                        Carp::carp("Failed to load JSON from $path: $@");
490                                                }
491
2
1417
                                                next;
492                                        }
493                        } elsif($file =~ /\.xml$/) {
494
11
8
                                my $rc;
495
11
15
                                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
157
                                        $data = read_file($path);
511
11
418
                                        if(my $tree = $xml_pp->parse(\$data)) {
512
11
5211
                                                if($data = $xml_pp->collapse_structure($tree)) {
513
11
277
                                                        $self->{'type'} = 'XML';
514
11
8
                                                        if($data->{'config'}) {
515
11
19
                                                                $data = $data->{'config'};
516                                                        }
517                                                }
518                                        }
519                                }
520                        } elsif ($file =~ /\.ini$/) {
521
13
18
                                $self->_load_driver('Config::IniFiles');
522
13
29
                                if(my $ini = Config::IniFiles->new(-file => $path)) {
523                                        $data = { map {
524
13
14
6398
70
                                                my $section = $_;
525
14
22
18
258
                                                $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
326
                        if($data) {
536
81
88
                                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
98
                                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
71
                                if($logger) {
549
0
0
                                        $logger->debug(ref($self), ' ', __LINE__, ": Loaded data from $path");
550                                }
551
79
79
44
117
                                %merged = %{ merge( $data, \%merged ) };
552
79
79
3520
131
                                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
142
                if(!$self->{'script_name'}) {
558
94
283
                        require File::Basename && File::Basename->import() unless File::Basename->can('basename');
559
560                        # Determine script name
561
94
1891
                        $self->{'script_name'} = File::Basename::basename($ENV{'SCRIPT_NAME'} || $0);
562                }
563
564
117
96
                my $script_name = $self->{'script_name'};
565
117
117
155
128
                for my $config_file ('default', $script_name, "$script_name.cfg", "$script_name.conf", "$script_name.config", $self->{'config_file'}, @{$self->{'config_files'}}) {
566
710
594
                        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
678
                        next if(($config_file eq $script_name) && ((length($dir) == 0) || ($dir eq File::Spec->curdir())));
570
602
1224
                        my $path = length($dir) ? File::Spec->catfile($dir, $config_file) : $config_file;
571
602
509
                        if($logger) {
572
0
0
                                $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path");
573                        }
574
602
2521
                        if((-f $path) && (-r $path)) {
575
30
48
                                my $data = read_file($path);
576
30
1272
                                if($logger) {
577
0
0
                                        $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path");
578                                }
579
30
29
                                eval {
580
30
99
                                        if(($data =~ /^\s*<\?xml/) || ($data =~ /<\/.+>/)) {
581
8
14
                                                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
11
                                                        my $xml_pp = XML::PP->new();
587
8
126
                                                        if(my $tree = $xml_pp->parse(\$data)) {
588
8
2558
                                                                if($data = $xml_pp->collapse_structure($tree)) {
589
8
101
                                                                        $self->{'type'} = 'XML';
590
8
11
                                                                        if($data->{'config'}) {
591
8
14
                                                                                $data = $data->{'config'};
592                                                                        }
593                                                                }
594                                                        }
595                                                }
596                                        } elsif($data =~ /\{.+:.\}/s) {
597
1
2
                                                $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
2
6
                                                        eval { $data = decode_json($data) };
603
1
1
                                                        if($@) {
604
0
0
                                                                undef $data;
605                                                        }
606                                                } else {
607
0
0
                                                        undef $data;
608                                                }
609
1
2
                                                if($data) {
610
1
2
                                                        $self->{'type'} = 'JSON';
611                                                }
612                                        } else {
613
21
16
                                                undef $data;
614                                        }
615
30
48
                                        if(!$data) {
616
21
45
                                                $self->_load_driver('YAML::XS', ['LoadFile']);
617
21
21
24
29
                                                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
911
29
                                                        foreach my $k (keys %{$data}) {
621
36
54
                                                                my $v = $data->{$k};
622
36
39
                                                                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
31
                                                                next unless _is_plain_scalar($v);
631
632
34
36
                                                                next if($v =~ /^".+"$/);      # Quotes to keep in one field
633
34
39
                                                                if($v =~ /,/) {
634
4
8
                                                                        my @vals = split(/\s*,\s*/, $v);
635
4
5
                                                                        delete $data->{$k};
636
4
3
                                                                        foreach my $val (@vals) {
637
8
16
                                                                                if($val =~ /(.+)=(.+)/) {
638
8
10
                                                                                        $data->{$k}{$1} = $2;
639                                                                                } else {
640
0
0
                                                                                        $data->{$k}{$val} = 1;
641                                                                                }
642                                                                        }
643                                                                }
644                                                        }
645
18
19
                                                        if($data) {
646
18
22
                                                                $self->{'type'} = 'YAML';
647                                                        }
648                                                }
649
21
1064
                                                if((!$data) || (ref($data) ne 'HASH')) {
650
3
7
                                                        $self->_load_driver('Config::IniFiles');
651
3
7
                                                        if(my $ini = Config::IniFiles->new(-file => $path)) {
652                                                                $data = { map {
653
2
3
1412
24
                                                                        my $section = $_;
654
3
6
4
68
                                                                        $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) }
655                                                                } $ini->Sections() };
656
2
22
                                                                if($data) {
657
2
3
                                                                        $self->{'type'} = 'INI';
658                                                                }
659                                                        }
660
3
281
                                                        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
4
                                                                if((!$data) || (ref($data) ne 'HASH')) {
666
1
1
                                                                        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
2
                                                                if((!$data) || (ref($data) ne 'HASH')) {
685
1
1
                                                                        $self->_load_driver('Config::Auto');
686
1
2
                                                                        my $ca = Config::Auto->new(source => $path);
687
1
14
                                                                        if($data = $ca->parse()) {
688
1
226
                                                                                $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
66
                                if(scalar(keys %merged)) {
704
7
13
                                        if($data) {
705
7
7
6
11
                                                %merged = %{ merge($data, \%merged) };
706                                        }
707                                } elsif($data && (ref($data) eq 'HASH')) {
708
23
23
21
59
                                        %merged = %{$data};
709                                } elsif((!$@) && $logger) {
710
0
0
                                        $logger->debug(ref($self), ' ', __LINE__, ': No configuration file loaded');
711                                }
712
713
30
30
308
70
                                push @{$merged{'config_path'}}, $path;
714                        }
715                }
716        }
717
718        # Merge ENV vars
719
294
215
        my $prefix = $self->{env_prefix};
720
294
249
        $prefix =~ s/__$//;
721
294
468
        $prefix =~ s/_$//;
722
294
235
        $prefix =~ s/::$//;
723
294
1987
        for my $key (keys %ENV) {
724
38185
37761
                next unless $key =~ /^$self->{env_prefix}(.*)$/i;
725
33
42
                my $path = lc($1);
726
33
49
                if($path =~ /__/) {
727
20
26
                        my @parts = split /__/, $path;
728
20
15
                        my $ref = \%merged;
729
20
56
                        $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1];
730
20
38
                        $ref->{ $parts[-1] } = $ENV{$key};
731                } else {
732
13
21
                        $merged{$prefix}->{$path} = $ENV{$key};
733                }
734        }
735
736        # Merge command line options
737
294
901
        foreach my $arg(@ARGV) {
738
20
28
                next unless($arg =~ /=/);
739
14
26
                my ($key, $value) = split(/=/, $arg, 2);
740
14
82
                next unless $key =~ /^\-\-$self->{env_prefix}(.*)$/;
741
742
12
16
                my $path = lc($1);
743
12
16
                my @parts = split(/__/, $path);
744
12
16
                if(scalar(@parts) > 0) {
745
12
11
                        my $ref = \%merged;
746
12
15
                        if(scalar(@parts) > 1) {
747
5
12
                                $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1];
748                        }
749
12
21
                        $ref->{$parts[-1]} = $value;
750                }
751        }
752
753
294
317
        if($self->{'flatten'}) {
754
19
38
                $self->_load_driver('Hash::Flatten', ['flatten']);
755        } else {
756
275
380
                $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
526
        $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
15835
        my ($self, $key) = @_;
773
774
249
265
        if($self->{flatten}) {
775
14
26
                return $self->{config}{$key};
776        }
777
235
178
        my $ref = $self->{'config'};
778
235
779
        for my $part (split qr/\Q$self->{sep_char}\E/, $key) {
779
358
343
                return undef unless ref $ref eq 'HASH';
780
356
305
                return unless exists $ref->{$part};
781
349
290
                $ref = $ref->{$part};
782        }
783
226
540
        if((defined($ref) && (ref($ref) eq 'HASH') && !$self->{'no_fixate'})) {
784
21
20
                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
429
        return $ref;
803}
804
805sub _load_data_reuse
806{
807
26
26
        my $self = $_[0];
808
809        # Skip fixation entirely if caller has opted out
810
26
45
        return 0 if($self->{'no_fixate'});
811
812        # Return cached result to avoid repeated require attempts
813
24
20
        return 1 if($self->{reuse_loaded});
814
24
27
        return 0 if($self->{reuse_failed});
815
816
17
12
        eval {
817
17
1077
                require Data::Reuse;
818
0
0
                Data::Reuse->import();
819        };
820
17
5998
        if($@) {
821                # Cache the failure so we do not attempt to load again
822
17
18
                $self->{reuse_failed} = 1;
823
17
23
                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
184
        my ($self, $key) = @_;
839
840
27
39
        if($self->{flatten}) {
841
6
14
                return exists($self->{config}{$key}) ? 1 : 0;
842        }
843
21
18
        my $ref = $self->{'config'};
844
21
91
        for my $part (split qr/\Q$self->{sep_char}\E/, $key) {
845
30
33
                return 0 unless ref $ref eq 'HASH';
846
28
41
                return 0 if(!exists($ref->{$part}));
847
22
20
                $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
50
        my $self = shift;
864
865
48
56
        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
31
86
        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
1787
        my $self = shift;
922
26
29
        my $config = $self->all();
923
924
26
29
        return $config if(scalar(@_) == 0);
925
926
24
31
        my $params = Params::Get::get_params('defaults', @_);
927
24
259
        my $defaults = $params->{'defaults'};
928
24
31
        return $config if(!defined($defaults));
929
20
20
        my $section = $params->{'section'};
930
931
20
50
        Hash::Merge::set_clone_behavior(0);
932
933
20
243
        if(exists $config->{'global'}) {
934
5
7
                if($params->{'deep'}) {
935
2
5
                        $defaults = merge($config->{'global'}, $defaults);
936                } else {
937
3
3
3
3
3
6
                        $defaults = { %{$defaults}, %{$config->{'global'}} };
938                }
939
5
102
                delete $config->{'global'};
940        }
941
20
34
        if($section && exists $config->{$section}) {
942
5
4
                $config = $config->{$section};
943        }
944
20
25
        if($params->{'merge'}) {
945
5
7
                return merge($config, $defaults);
946        }
947
15
15
15
12
16
33
        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
406
        my($self, $driver, $imports) = @_;
958
959
436
538
        return 1 if($self->{'loaded'}{$driver});
960
415
367
        return 0 if($self->{'failed'}{$driver});
961
962
408
11069
        eval "require $driver";
963
408
69830
        if($@) {
964
18
24
                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
31
                return;
969        }
970
390
390
296
3530
        $driver->import(@{ $imports // [] });
971
390
457
        $self->{'loaded'}{$driver} = 1;
972
390
323
        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
91986
        our $AUTOLOAD;
1007
1008
321
228
        my $self = shift;
1009
321
244
        my $key = $AUTOLOAD;
1010
1011
321
686
        $key =~ s/.*:://;       # remove package name
1012
321
3837
        return if $key eq 'DESTROY';
1013
1014        # my $val = $self->get($key);
1015        # return $val if(defined($val));
1016
1017
24
33
        my $data = $self->{data} || $self->{'config'};
1018
1019        # If flattening is ON, assume keys are pre-flattened
1020
24
30
        if ($self->{flatten}) {
1021
4
6
                return $data->{$key} if(exists $data->{$key});
1022        }
1023
1024
23
19
        my $sep = $self->{'sep_char'};
1025
1026        # Fallback: try resolving nested structure dynamically
1027
23
21
        my $val = $data;
1028
23
92
        foreach my $part(split /\Q$sep\E/, $key) {
1029
37
64
                if((ref($val) eq 'HASH') && (exists $val->{$part})) {
1030
34
35
                        $val = $val->{$part};
1031                } else {
1032
3
22
                        croak "No such config key '$key'";
1033                }
1034        }
1035
20
62
        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