File Coverage

blib/lib/Config/Abstraction.pm
Criterion Covered Total %
statement 267 362 73.7
branch 138 250 55.2
condition 48 86 55.8
subroutine 18 18 100.0
pod 5 5 100.0
total 476 721 66.0


line stmt bran cond sub pod time code
1             package Config::Abstraction;
2              
3             # TODO: add TOML file support
4             # TODO: environment-specific encodings - automatic loading of dev/staging/prod
5             # TODO: devise a scheme to encrypt passwords in config files
6              
7 10     10   2322034 use strict;
  10         20  
  10         395  
8 10     10   49 use warnings;
  10         22  
  10         641  
9              
10 10     10   62 use Carp;
  10         37  
  10         798  
11 10     10   4872 use JSON::MaybeXS 'decode_json'; # Doesn't behave well with require
  10         139586  
  10         1774  
12 10     10   2065 use File::Slurp qw(read_file);
  10         118232  
  10         589  
13 10     10   67 use File::Spec;
  10         21  
  10         389  
14 10     10   5251 use Hash::Merge qw(merge);
  10         93892  
  10         823  
15 10     10   4797 use Params::Get 0.13;
  10         112514  
  10         787  
16 10     10   6802 use Params::Validate::Strict 0.11;
  10         531692  
  10         740  
17 10     10   107 use Scalar::Util;
  10         20  
  10         59871  
18              
19             =head1 NAME
20              
21             Config::Abstraction - Merge and manage configuration data from different sources
22              
23             =head1 VERSION
24              
25             Version 0.37
26              
27             =cut
28              
29             our $VERSION = '0.37';
30              
31             =head1 SYNOPSIS
32              
33             C lets you load configuration from multiple sources,
34             such as files, environment variables, and in-code defaults,
35             and merge them with predictable precedence.
36             It provides a consistent API for accessing the configuration settings, regardless of where they came from,
37             this helps keep your application's or class's configuration flexible, centralized, and easy to override.
38              
39             use Config::Abstraction;
40              
41             my $config = Config::Abstraction->new(
42             config_dirs => ['config'],
43             env_prefix => 'APP_',
44             flatten => 0,
45             );
46              
47             my $db_user = $config->get('database.user');
48              
49             =head1 DESCRIPTION
50              
51             C is a flexible configuration management layer that sits above C modules.
52             It provides a simple way to layer multiple configuration sources with predictable merge order.
53             It lets you define sources such as:
54              
55             =over 4
56              
57             =item * Perl hashes (in-memory defaults or dynamic values)
58              
59             =item * Environment variables (with optional prefixes)
60              
61             =item * Configuration files (YAML, JSON, INI, or plain key=value)
62              
63             =item * Command-line arguments
64              
65             =back
66              
67             Sources are applied in the order they are provided. Later sources override
68             earlier ones unless a key is explicitly set to C in the later source.
69              
70             In addition to using drivers to load configuration data from multiple file
71             formats (YAML, JSON, XML, and INI),
72             it also allows levels of configuration, each of which overrides the lower levels.
73             So, it also integrates environment variable
74             overrides and command line arguments for runtime configuration adjustments.
75             This module is designed to help developers manage layered configurations that can be loaded from files and overridden at run-time for debugging,
76             offering a modern, robust and dynamic approach
77             to configuration management.
78              
79             =head2 Merge Precedence Diagram
80              
81             +----------------+
82             | CLI args | (Highest priority)
83             +----------------+
84             | Environment |
85             +----------------+
86             | Config file(s) |
87             +----------------+
88             | Defaults | (Lowest priority)
89             +----------------+
90              
91             =head2 KEY FEATURES
92              
93             =over 4
94              
95             =item * Multi-Format Support
96              
97             Supports configuration files in YAML, JSON, XML, and INI formats.
98             Automatically merges configuration data from these different formats,
99             allowing hierarchical configuration management.
100              
101             =item * Environment Variable Overrides
102              
103             Allows environment variables to override values in the configuration files.
104             By setting environment variables with a specific prefix (default: C),
105             values in the configuration files can be dynamically adjusted without modifying
106             the file contents.
107              
108             =item * Flattened Configuration Option
109              
110             Optionally supports flattening the configuration structure. This converts deeply
111             nested configuration keys into a flat key-value format (e.g., C
112             instead of C{user}>). This makes accessing values easier for
113             applications that prefer flat structures or need compatibility with flat
114             key-value stores.
115              
116             =item * Layered Configuration
117              
118             Supports merging multiple layers of configuration files. For example, you can
119             have a C configuration file that provides default values, and a
120             C (or C, C, etc.) file that overrides
121             specific values. This allows for environment-specific configurations while
122             keeping defaults intact.
123              
124             =item * Merge Strategy
125              
126             The module merges the configuration data intelligently, allowing values in more
127             specific files (like C, C, C, C)
128             to override values in base files. This enables a flexible and layered configuration
129             system where you can set defaults and override them for specific environments.
130              
131             =item * Error Handling
132              
133             Includes error handling for loading configuration files.
134             If any file fails to
135             load (e.g., due to syntax issues), the module will throw descriptive error
136             messages to help with debugging.
137              
138             =back
139              
140             =head2 SUPPORTED FILE FORMATS
141              
142             =over 4
143              
144             =item * YAML (C<*.yaml>, C<*.yml>)
145              
146             The module supports loading YAML files using the C module.
147              
148             =item * JSON (C<*.json>)
149              
150             The module supports loading JSON files using C.
151              
152             =item * XML (C<*.xml>)
153              
154             The module supports loading XML files using C.
155              
156             =item * INI (C<*.ini>)
157              
158             The module supports loading INI files using C.
159              
160             =back
161              
162             =head2 ENVIRONMENT VARIABLE HANDLING
163              
164             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.
165              
166             For example:
167              
168             APP_DATABASE__USER becomes database.user (nested structure)
169              
170             $ export APP_DATABASE__USER="env_user"
171              
172             will override any value set for `database.user` in the configuration files.
173              
174             APP_LOGLEVEL becomes APP.loglevel (flat under prefix namespace)
175              
176             APP_API__RATE_LIMIT becomes api.rate_limit (mixed usage)
177              
178             This allows you to override both top-level and nested configuration values using environment variables.
179              
180             Configuration values can be overridden via the command line (C<@ARGV>).
181             For instance, if you have a key in the configuration such as C,
182             you can override it by adding C<"--APP_DATABASE__USER=other_user_name"> to the command line arguments.
183             This will override any value set for C in the configuration files.
184              
185             =head2 EXAMPLE CONFIGURATION FLOW
186              
187             =over 4
188              
189             =item 1. Data Argument
190              
191             The data passed into the constructor via the C argument is the starting point.
192             Essentially,
193             this contains the default values.
194              
195             =item 2. Loading Files
196              
197             The module then looks for configuration files in the specified directories.
198             It loads the following files in order of preference:
199             C, C, C, C, C,
200             C, C, and C.
201              
202             If C or C is set, those files are loaded last.
203              
204             If no C is given, try hard to find the files in various places.
205              
206             =item 3. Merging and Resolving
207              
208             The module merges the contents of these files, with more specific configurations
209             (e.g., C) overriding general ones (e.g., C).
210              
211             =item 4. Environment Overrides
212              
213             After loading and merging the configuration files,
214             the environment variables are
215             checked and used to override any conflicting settings.
216              
217             =item 5. Command Line
218              
219             Next, the command line arguments are checked and used to override any conflicting settings.
220              
221             =item 6. Accessing Values
222              
223             Values in the configuration can be accessed using a dotted notation
224             (e.g., C<'database.user'>), regardless of the file format used.
225              
226             =back
227              
228             =head1 METHODS
229              
230             =head2 new
231              
232             Constructor for creating a new configuration object.
233              
234             Options:
235              
236             =over 4
237              
238             =item * C
239              
240             An arrayref of directories to look for configuration files
241             (default: C<$CONFIG_DIR>, C<$HOME/.conf>, C<$HOME/config>, C<$HOME/conf>, C<$DOCUMENT_ROOT/conf>, C<$DOCUMENT_ROOT/../conf>, C).
242              
243             =item * C
244              
245             Points to a configuration file of any format.
246              
247             =item * C
248              
249             An arrayref of files to look for in the configuration directories.
250             Put the more important files later,
251             since later files override earlier ones.
252              
253             Considers the files C and C<$script_name> before looking at C and C.
254              
255             =item * C
256              
257             A hash ref of default data to prime the configuration with.
258             These are applied before loading
259             other sources and can be overridden by later sources or by explicitly passing
260             options directly to C.
261              
262             $config = Config::Abstraction->new(
263             data => {
264             log_level => 'info',
265             retries => 3,
266             }
267             );
268              
269             =item * C
270              
271             A prefix for environment variable keys and comment line options, e.g. C,
272             (default: C<'APP_'>).
273              
274             =item * C
275              
276             Synonym for C
277              
278             =item * C
279              
280             If true, returns a flat hash structure like C<{database.user}> (default: C<0>) instead of C<{database}{user}>.
281             `
282             =item * C
283              
284             Level for logging.
285              
286             =item * C
287              
288             Used for warnings and traces.
289             It can be an object that understands warn() and trace() messages,
290             such as a L or L object,
291             a reference to code,
292             a reference to an array,
293             or a filename.
294              
295             =item * C
296              
297             A synonym of C.
298              
299             =item * C
300              
301             The separator in keys.
302             The default is a C<'.'>,
303             as in dotted notation,
304             such as C<'database.user'>.
305              
306             =item * C
307              
308             A L compatible schema to validate the configuration file against.
309              
310             =back
311              
312             If just one argument is given, it is assumed to be the name of a file.
313              
314             =cut
315              
316             sub new
317             {
318 24     24 1 2390344 my $class = shift;
319 24         235 my $params;
320              
321 24 100       170 if(scalar(@_) == 1) {
322             # Just one parameter - the name of a file
323 1         4 $params = Params::Get::get_params('file', \@_);
324             } else {
325 23   50     153 $params = Params::Get::get_params(undef, \@_) || {};
326             }
327              
328 24   100     925 $params->{'config_dirs'} //= $params->{'path'}; # Compatibility with Config::Auto
329              
330 24 100 100     126 if((!defined($params->{'config_dirs'})) && $params->{'file'}) {
331 1         3 $params->{'config_file'} = $params->{'file'};
332             }
333              
334 24 100       78 if(!defined($params->{'config_dirs'})) {
335 6 100 66     34 if($params->{'config_file'} && File::Spec->file_name_is_absolute($params->{'config_file'})) {
336 1         3 $params->{'config_dirs'} = [''];
337             } else {
338             # Set up the default value for config_dirs
339 5 50       18 if($^O ne 'MSWin32') {
340 5         16 $params->{'config_dirs'} = [ '/etc', '/usr/local/etc' ];
341             } else {
342 0         0 $params->{'config_dirs'} = [''];
343             }
344 5 50       22 if($ENV{'HOME'}) {
    0          
345 5         158 push @{$params->{'config_dirs'}},
346             File::Spec->catdir($ENV{'HOME'}, '.conf'),
347             File::Spec->catdir($ENV{'HOME'}, '.config'),
348 5         16 File::Spec->catdir($ENV{'HOME'}, 'conf'),
349             } elsif($ENV{'DOCUMENT_ROOT'}) {
350 0         0 push @{$params->{'config_dirs'}},
351             File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, File::Spec->updir(), 'conf'),
352             File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, 'conf'),
353 0         0 File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, 'config');
354             }
355 5 50       31 if(my $dir = $ENV{'CONFIG_DIR'}) {
356 0         0 push @{$params->{'config_dirs'}}, $dir;
  0         0  
357             } else {
358 5         7 push @{$params->{'config_dirs'}}, 'conf', 'config';
  5         17  
359             }
360             }
361             }
362              
363             my $self = bless {
364             sep_char => '.',
365 24 50       304 %{$params->{defaults} ? $params->{defaults} : $params},
366 24   100     51 env_prefix => $params->{env_prefix} || 'APP_',
367             config => {},
368             }, $class;
369              
370 24 50       182 if(my $logger = $self->{'logger'}) {
371 0 0       0 if(!Scalar::Util::blessed($logger)) {
372 0         0 $self->_load_driver('Log::Abstraction');
373 0         0 $self->{'logger'} = Log::Abstraction->new($logger);
374 0 0 0     0 if($params->{'level'} && $self->{'logger'}->can('level')) {
375 0         0 $self->{'logger'}->level($params->{'level'});
376             }
377             }
378             }
379 24         145 $self->_load_config();
380              
381 24 100       2985 if(my $schema = $params->{'schema'}) {
382 1         7 $self->{'config'} = Params::Validate::Strict::validate_strict(schema => $schema, input => $self->{'config'});
383             }
384              
385 23 100 50     131 if(defined($self->{'config'}) && scalar(keys %{$self->{'config'}})) {
  23         111  
386 22         226 return $self;
387             }
388 1         7 return undef;
389             }
390              
391             sub _load_config
392             {
393 24 50   24   157 if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) {
394 0         0 Carp::croak('Illegal Operation: This method can only be called by a subclass');
395             }
396              
397 24         636 my $self = shift;
398 24         53 my %merged;
399              
400 24 100       82 if($self->{'data'}) {
401             # The data argument given to 'new' contains defaults that this routine will override
402 7         12 %merged = %{$self->{'data'}};
  7         49  
403             }
404              
405 24         52 my $logger = $self->{'logger'};
406 24 50       68 if($logger) {
407 0         0 $logger->trace(ref($self), ' ', __LINE__, ': Entered _load_config');
408             }
409              
410 24         101 my @dirs = @{$self->{'config_dirs'}};
  24         84  
411 24 50 66     152 if($self->{'config_file'} && (scalar(@dirs) > 1)) {
412 0 0       0 if(File::Spec->file_name_is_absolute($self->{'config_file'})) {
413             # Handle absolute paths
414 0         0 @dirs = ('');
415             } else {
416             # Look in the current directory
417 0         0 push @dirs, File::Spec->curdir();
418             }
419             }
420 24         64 for my $dir (@dirs) {
421 54 50       119 next if(!defined($dir));
422 54 100 100     1201 if(length($dir) && !-d $dir) {
423 25         44 next;
424             }
425              
426 29         90 for my $file (qw/base.yaml base.yml base.json base.xml base.ini local.yaml local.yml local.json local.xml local.ini/) {
427 290         2394 my $path = File::Spec->catfile($dir, $file);
428 290 50       690 if($logger) {
429 0         0 $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path");
430             }
431 290 100       7002 next unless -f $path;
432 32 50       476 next unless -r $path;
433              
434 32 50       102 if($logger) {
435 0         0 $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path");
436             }
437              
438 32         61 my $data;
439             # Only load config modules when they are needed
440 32 100       322 if ($file =~ /\.ya?ml$/) {
    100          
    100          
    50          
441 7         46 $self->_load_driver('YAML::XS', ['LoadFile']);
442 7         21 $data = eval { LoadFile($path) };
  7         30  
443 7 50       2681 croak "Failed to load YAML from $path: $@" if $@;
444             } elsif ($file =~ /\.json$/) {
445 5         14 $data = eval { decode_json(read_file($path)) };
  5         27  
446 5 50       771 croak "Failed to load JSON from $path: $@" if $@;
447             } elsif($file =~ /\.xml$/) {
448 10         17 my $rc;
449 10 50       85 if($self->_load_driver('XML::Simple', ['XMLin'])) {
450 0         0 eval { $rc = XMLin($path, ForceArray => 0, KeyAttr => []) };
  0         0  
451 0 0       0 if($@) {
    0          
452 0 0       0 if($logger) {
453 0         0 $logger->notice("Failed to load XML from $path: $@");
454             } else {
455 0         0 Carp::carp("Failed to load XML from $path: $@");
456             }
457 0         0 undef $rc;
458             } elsif($rc) {
459 0         0 $data = $rc;
460             }
461             }
462 10 50 33     47 if((!defined($rc)) && $self->_load_driver('XML::PP')) {
463 10         55 my $xml_pp = XML::PP->new();
464 10         396 $data = read_file($path);
465 10 50       1433 if(my $tree = $xml_pp->parse(\$data)) {
466 10 50       13738 if($data = $xml_pp->collapse_structure($tree)) {
467 10         726 $self->{'type'} = 'XML';
468 10 50       28 if($data->{'config'}) {
469 10         35 $data = $data->{'config'};
470             }
471             }
472             }
473             }
474             } elsif ($file =~ /\.ini$/) {
475 10         57 $self->_load_driver('Config::IniFiles');
476 10 50       73 if(my $ini = Config::IniFiles->new(-file => $path)) {
477             $data = { map {
478 10         13608 my $section = $_;
  10         128  
479 10         34 $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) }
  15         455  
480             } $ini->Sections() };
481             } else {
482 0 0       0 if($logger) {
483 0         0 $logger->notice("Failed to load INI from $path: $@");
484             } else {
485 0         0 Carp::carp("Failed to load INI from $path: $@");
486             }
487             }
488             }
489 32 50       623 if($data) {
490 32 50       92 if(!ref($data)) {
491 0 0       0 if($logger) {
492 0         0 $logger->debug(ref($self), ' ', __LINE__, ": ignoring data from $path ($data)");
493             }
494 0         0 next;
495             }
496 32 50       106 if(ref($data) ne 'HASH') {
497 0 0       0 if($logger) {
498 0         0 $logger->debug(ref($self), ' ', __LINE__, ": ignoring data from $path (not a hashref)");
499             }
500 0         0 next;
501             }
502 32 50       86 if($logger) {
503 0         0 $logger->debug(ref($self), ' ', __LINE__, ": Loaded data from $path");
504             }
505 32         59 %merged = %{ merge( $data, \%merged ) };
  32         142  
506 32         6030 push @{$merged{'config_path'}}, $path;
  32         178  
507             }
508             }
509              
510             # Put $self->{config_file} through all parsers, ignoring all errors, then merge that in
511 29 100       111 if(!$self->{'script_name'}) {
512 24 50 0     354 require File::Basename && File::Basename->import() unless File::Basename->can('basename');
513              
514             # Determine script name
515 24   33     1480 $self->{'script_name'} = File::Basename::basename($ENV{'SCRIPT_NAME'} || $0);
516             }
517              
518 29         92 my $script_name = $self->{'script_name'};
519 29         161 for my $config_file ('default', $script_name, "$script_name.cfg", "$script_name.conf", "$script_name.config", $self->{'config_file'}, @{$self->{'config_files'}}) {
  29         125  
520 178 100       422 next unless defined($config_file);
521             # Note that loading $script_name in the current directory could mean loading the script as it's own config.
522             # This test is not foolproof, buyer beware
523 160 100 66     624 next if(($config_file eq $script_name) && ((length($dir) == 0) || ($dir eq File::Spec->curdir())));
      66        
524 156 100       1161 my $path = length($dir) ? File::Spec->catfile($dir, $config_file) : $config_file;
525 156 50       384 if($logger) {
526 0         0 $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path");
527             }
528 156 100 66     5210 if((-f $path) && (-r $path)) {
529 13         81 my $data = read_file($path);
530 13 50       1974 if($logger) {
531 0         0 $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path");
532             }
533 13         28 eval {
534 13 100 100     151 if(($data =~ /^\s*<\?xml/) || ($data =~ /<\/.+>/)) {
    50          
535 7 50       53 if($self->_load_driver('XML::Simple', ['XMLin'])) {
    50          
536 0 0       0 if($data = XMLin($path, ForceArray => 0, KeyAttr => [])) {
537 0         0 $self->{'type'} = 'XML';
538             }
539             } elsif($self->_load_driver('XML::PP')) {
540 7         27 my $xml_pp = XML::PP->new();
541 7 50       243 if(my $tree = $xml_pp->parse(\$data)) {
542 7 50       5174 if($data = $xml_pp->collapse_structure($tree)) {
543 7         207 $self->{'type'} = 'XML';
544 7 50       18 if($data->{'config'}) {
545 7         31 $data = $data->{'config'};
546             }
547             }
548             }
549             }
550             } elsif($data =~ /\{.+:.\}/s) {
551 0         0 $self->_load_driver('JSON::Parse');
552             # CPanel::JSON is very noisy, so be careful before attempting to use it
553 0         0 my $is_json;
554 0         0 eval { $is_json = JSON::Parse::parse_json($data) };
  0         0  
555 0 0       0 if($is_json) {
556 0         0 eval { $data = decode_json($data) };
  0         0  
557 0 0       0 if($@) {
558 0         0 undef $data;
559             }
560             } else {
561 0         0 undef $data;
562             }
563 0 0       0 if($data) {
564 0         0 $self->{'type'} = 'JSON';
565             }
566             } else {
567 6         13 undef $data;
568             }
569 13 100       67 if(!$data) {
570 6         42 $self->_load_driver('YAML::XS', ['LoadFile']);
571 6 100 66     16 if((eval { $data = LoadFile($path) }) && (ref($data) eq 'HASH')) {
  6         26  
572             # Could be colon file, could be YAML, whichever it is break the configuration fields
573             # foreach my($k, $v) (%{$data}) {
574 5         941 foreach my $k (keys %{$data}) {
  5         22  
575 19         28 my $v = $data->{$k};
576 19 50       59 if(!defined($v)) {
577             # e.g. a simple line
578             # foo:
579             # with nothing under it
580 0         0 $data->{$k} = undef;
581 0         0 next;
582             }
583 19 50       41 next if($v =~ /^".+"$/); # Quotes to keep in one field
584 19 100       43 if($v =~ /,/) {
585 4         16 my @vals = split(/\s*,\s*/, $v);
586 4         6 delete $data->{$k};
587 4         6 foreach my $val (@vals) {
588 8 50       21 if($val =~ /(.+)=(.+)/) {
589 8         25 $data->{$k}{$1} = $2;
590             } else {
591 0         0 $data->{$k}{$val} = 1;
592             }
593             }
594             }
595             }
596 5 50       16 if($data) {
597 5         20 $self->{'type'} = 'YAML';
598             }
599             }
600 6 100 66     283 if((!$data) || (ref($data) ne 'HASH')) {
601 1         6 $self->_load_driver('Config::IniFiles');
602 1 50       7 if(my $ini = Config::IniFiles->new(-file => $path)) {
603             $data = { map {
604 0         0 my $section = $_;
  0         0  
605 0         0 $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) }
  0         0  
606             } $ini->Sections() };
607 0 0       0 if($data) {
608 0         0 $self->{'type'} = 'INI';
609             }
610             }
611 1 50 33     829 if((!$data) || (ref($data) ne 'HASH')) {
612             # Maybe XML without the leading XML header
613 1 50       6 if($self->_load_driver('XML::Simple', ['XMLin'])) {
614 0         0 eval { $data = XMLin($path, ForceArray => 0, KeyAttr => []) };
  0         0  
615             }
616 1 50 33     17 if((!$data) || (ref($data) ne 'HASH')) {
617 1 50       4 if($self->_load_driver('Config::Abstract')) {
618             # Handle RT#164587
619 0         0 open my $oldSTDERR, '>&STDERR';
620 0         0 close STDERR;
621 0         0 eval { $data = Config::Abstract->new($path) };
  0         0  
622 0         0 my $err = $@;
623 0         0 open STDERR, '>&', $oldSTDERR;
624 0 0       0 if($err) {
    0          
625 0         0 undef $data;
626             } elsif($data) {
627 0         0 $data = $data->get_all_settings();
628 0 0       0 if(scalar(keys %{$data}) == 0) {
  0         0  
629 0         0 undef $data;
630             }
631             }
632 0         0 $self->{'type'} = 'Perl';
633             }
634             }
635 1 50 33     8 if((!$data) || (ref($data) ne 'HASH')) {
636 1         5 $self->_load_driver('Config::Auto');
637 1         6 my $ca = Config::Auto->new(source => $path);
638 1 50       47 if($data = $ca->parse()) {
639 1         767 $self->{'type'} = $ca->format();
640             }
641             }
642             }
643             }
644             }
645             };
646 13 50       75 if($logger) {
647 0 0       0 if($@) {
648 0         0 $logger->warn(ref($self), ' ', __LINE__, ": $@");
649 0         0 undef $data;
650             } else {
651 0         0 $logger->debug(ref($self), ' ', __LINE__, ': Loaded data from', $self->{'type'}, "file $path");
652             }
653             }
654 13 100 33     92 if(scalar(keys %merged)) {
    50 0        
    0          
655 2 50       6 if($data) {
656 2         3 %merged = %{ merge($data, \%merged) };
  2         13  
657             }
658             } elsif($data && (ref($data) eq 'HASH')) {
659 11         20 %merged = %{$data};
  11         44  
660             } elsif((!$@) && $logger) {
661 0         0 $logger->debug(ref($self), ' ', __LINE__, ': No configuration file loaded');
662             }
663              
664 13         297 push @{$merged{'config_path'}}, $path;
  13         70  
665             }
666             }
667             }
668              
669             # Merge ENV vars
670 24         71 my $prefix = $self->{env_prefix};
671 24         63 $prefix =~ s/__$//;
672 24         125 $prefix =~ s/_$//;
673 24         60 $prefix =~ s/::$//;
674 24         185 for my $key (keys %ENV) {
675 527 100       1765 next unless $key =~ /^$self->{env_prefix}(.*)$/i;
676 14         47 my $path = lc($1);
677 14 100       48 if($path =~ /__/) {
678 10         32 my @parts = split /__/, $path;
679 10         22 my $ref = \%merged;
680 10   100     78 $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1];
681 10         51 $ref->{ $parts[-1] } = $ENV{$key};
682             } else {
683 4         24 $merged{$prefix}->{$path} = $ENV{$key};
684             }
685             }
686              
687             # Merge command line options
688 24         89 foreach my $arg(@ARGV) {
689 1 50       7 next unless($arg =~ /=/);
690 1         5 my ($key, $value) = split(/=/, $arg, 2);
691 1 50       22 next unless $key =~ /^\-\-$self->{env_prefix}(.*)$/;
692              
693 1         5 my $path = lc($1);
694 1         5 my @parts = split(/__/, $path);
695 1 50       4 if(scalar(@parts) > 0) {
696 1         3 my $ref = \%merged;
697 1 50       5 if(scalar(@parts) > 1) {
698 0   0     0 $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1];
699             }
700 1         5 $ref->{$parts[-1]} = $value;
701             }
702             }
703              
704 24 100       92 if($self->{'flatten'}) {
705 2         14 $self->_load_driver('Hash::Flatten', ['flatten']);
706             } else {
707 22         104 $self->_load_driver('Hash::Flatten', ['unflatten']);
708             }
709             # $self->{config} = $self->{flatten} ? flatten(\%merged) : unflatten(\%merged);
710             # Don't unflatten because of RT#166761
711 24 100       150 $self->{config} = $self->{flatten} ? flatten(\%merged) : \%merged;
712             }
713              
714             =head2 get(key)
715              
716             Retrieve a configuration value using dotted key notation (e.g.,
717             C<'database.user'>). Returns C if the key doesn't exist.
718              
719             =cut
720              
721             sub get
722             {
723 28     28 1 7882 my ($self, $key) = @_;
724              
725 28 100       103 if($self->{flatten}) {
726 2         14 return $self->{config}{$key};
727             }
728 26         57 my $ref = $self->{'config'};
729 26         379 for my $part (split qr/\Q$self->{sep_char}\E/, $key) {
730 41 50       150 return undef unless ref $ref eq 'HASH';
731 41         100 $ref = $ref->{$part};
732             }
733 26 100 66     175 if((defined($ref) && !$self->{'no_fixate'})) {
734 24 50       60 if(!$self->{reuse_loaded}) {
735 24         45 eval {
736 24         2950 require Data::Reuse;
737 0         0 Data::Reuse->import();
738             };
739 24 50       16373 unless($@) {
740 0         0 $self->{reuse_loaded} = 1;
741             }
742             }
743 24 50       88 if($self->{reuse_loaded}) {
744 0 0       0 if(ref($ref) eq 'HASH') {
    0          
745 0         0 Data::Reuse::fixate(%{$ref});
  0         0  
746             } elsif(ref($ref) eq 'ARRAY') {
747             # RT#171980
748             # Data::Reuse::fixate(@{$ref});
749             }
750             }
751             }
752 26         182 return $ref;
753             }
754              
755             =head2 exists(key)
756              
757             Does a configuration value using dotted key notation (e.g., C<'database.user'>) exist?
758             Returns 0 or 1.
759              
760             =cut
761              
762             sub exists
763             {
764 1     1 1 3 my ($self, $key) = @_;
765              
766 1 50       4 if($self->{flatten}) {
767 0         0 return exists($self->{config}{$key});
768             }
769 1         2 my $ref = $self->{'config'};
770 1         17 for my $part (split qr/\Q$self->{sep_char}\E/, $key) {
771 2 50       7 return 0 unless ref $ref eq 'HASH';
772 2 50       4 return 0 if(!exists($ref->{$part}));
773 2         3 $ref = $ref->{$part};
774             }
775 1         7 return 1;
776             }
777              
778             =head2 all()
779              
780             Returns the entire configuration hash,
781             possibly flattened depending on the C option.
782              
783             The entry C contains a list of the files that the configuration was loaded from.
784              
785             =cut
786              
787             sub all
788             {
789 11     11 1 24 my $self = shift;
790              
791 11 50 50     38 return($self->{'config'} && scalar(keys %{$self->{'config'}})) ? $self->{'config'} : undef;
792             }
793              
794             =head2 merge_defaults
795              
796             Merge the configuration hash into the given hash.
797              
798             package MyPackage;
799             use Params::Get;
800             use Config::Abstraction;
801              
802             sub new
803             {
804             my $class = shift;
805              
806             my $params = Params::Get::get_params(undef, \@_) || {};
807              
808             if(my $config = Config::Abstraction->new(env_prefix => "${class}::")) {
809             $params = $config->merge_defaults(defaults => $params, merge => 1, section => $class);
810             }
811              
812             return bless $params, $class;
813             }
814              
815             Options:
816              
817             =over 4
818              
819             =item * merge
820              
821             Usually,
822             what's in the object will overwrite what's in the defaults hash,
823             if given,
824             the result will be a combination of the hashes.
825              
826             =item * section
827              
828             Merge in that section from the configuration file.
829              
830             =item * deep
831              
832             Try harder to merge all configurations from the global section of the configuration file.
833              
834             =back
835              
836             =cut
837              
838             sub merge_defaults
839             {
840 4     4 1 2092 my $self = shift;
841 4         8 my $config = $self->all();
842              
843 4 50       9 return $config if(scalar(@_) == 0);
844              
845 4         10 my $params = Params::Get::get_params('defaults', @_);
846 4         83 my $defaults = $params->{'defaults'};
847 4 100       8 return $config if(!defined($defaults));
848 2         3 my $section = $params->{'section'};
849              
850 2         8 Hash::Merge::set_clone_behavior(0);
851              
852 2 50       147 if($config->{'global'}) {
853 0 0       0 if($params->{'deep'}) {
854 0         0 $defaults = merge($config->{'global'}, $defaults);
855             } else {
856 0         0 $defaults = { %{$defaults}, %{$config->{'global'}} };
  0         0  
  0         0  
857             }
858 0         0 delete $config->{'global'};
859             }
860 2 0 33     6 if($section && $config->{$section}) {
861 0         0 $config = $config->{$section};
862             }
863 2 100       7 if($params->{'merge'}) {
864 1         4 return merge($config, $defaults);
865             }
866 1         2 return { %{$defaults}, %{$config} };
  1         1  
  1         5  
867             }
868              
869             # Helper routine to load a driver
870             sub _load_driver
871             {
872 85     85   250 my($self, $driver, $imports) = @_;
873              
874 85 100       374 return 1 if($self->{'loaded'}{$driver});
875 73 100       242 return 0 if($self->{'failed'}{$driver});
876              
877 68         5329 eval "require $driver";
878 68 100       122958 if($@) {
879 14 50       60 if(my $logger = $self->{'logger'}) {
880 0         0 $logger->warn(ref($self), ": $driver failed to load: $@");
881             }
882 14         49 $self->{'failed'}{$driver} = 1;
883 14         70 return;
884             }
885 54   100     118 $driver->import(@{ $imports // [] });
  54         1362  
886 54         246 $self->{'loaded'}{$driver} = 1;
887 54         142 return 1;
888             }
889              
890             =head2 AUTOLOAD
891              
892             This module supports dynamic access to configuration keys via AUTOLOAD.
893             Nested keys are accessible using the separator,
894             so C<$config-Edatabase_user()> resolves to C<< $config->{database}->{user} >>,
895             when C is set to '_'.
896              
897             $config = Config::Abstraction->new(
898             data => {
899             database => {
900             user => 'alice',
901             pass => 'secret'
902             },
903             log_level => 'debug'
904             },
905             flatten => 1,
906             sep_char => '_'
907             );
908              
909             my $user = $config->database_user(); # returns 'alice'
910              
911             # or
912             $user = $config->database()->{'user'}; # returns 'alice'
913              
914             # Attempting to call a nonexistent key
915             my $foo = $config->nonexistent_key(); # dies with error
916              
917             =cut
918              
919             sub AUTOLOAD
920             {
921 32     32   20010 our $AUTOLOAD;
922              
923 32         60 my $self = shift;
924 32         84 my $key = $AUTOLOAD;
925              
926 32         203 $key =~ s/.*:://; # remove package name
927 32 100       1241 return if $key eq 'DESTROY';
928              
929             # my $val = $self->get($key);
930             # return $val if(defined($val));
931              
932 8   66     34 my $data = $self->{data} || $self->{'config'};
933              
934             # If flattening is ON, assume keys are pre-flattened
935 8 100       24 if ($self->{flatten}) {
936 3 50       12 return $data->{$key} if(exists $data->{$key});
937             }
938              
939 8         19 my $sep = $self->{'sep_char'};
940              
941             # Fallback: try resolving nested structure dynamically
942 8         14 my $val = $data;
943 8         102 foreach my $part(split /\Q$sep\E/, $key) {
944 14 100 66     103 if((ref($val) eq 'HASH') && (exists $val->{$part})) {
945 13         35 $val = $val->{$part};
946             } else {
947 1         23 croak "No such config key '$key'";
948             }
949             }
950 7         51 return $val;
951             }
952              
953             1;
954              
955             =head1 COMMON PITFALLS
956              
957             =over 4
958              
959             =item * Nested hashes
960              
961             Merging replaces entire nested hashes unless you enable deep merging.
962              
963             =item * Undef values
964              
965             Keys explicitly set to C in a later source override earlier values.
966              
967             =item * Environment
968              
969             When using environment variables,
970             remember that double underscores (__) create nested structures,
971             while single underscores remain as part of the key name under the prefix namespace.
972              
973             =back
974              
975             =head1 BUGS
976              
977             It should be possible to escape the separator character either with backslashes or quotes.
978              
979             Due to the case-insensitive nature of environment variables on Windows,
980             it may be challenging to override values using environment variables on that platform.
981              
982             =head1 REPOSITORY
983              
984             L
985              
986             =head1 SUPPORT
987              
988             This module is provided as-is without any warranty.
989              
990             Please report any bugs or feature requests to C,
991             or through the web interface at
992             L.
993             I will be notified, and then you'll
994             automatically be notified of progress on your bug as I make changes.
995              
996             You can find documentation for this module with the perldoc command.
997              
998             perldoc Config::Abstraction
999              
1000             =head1 SEE ALSO
1001              
1002             =over 4
1003              
1004             =item * L
1005              
1006             =item * L
1007              
1008             =item * L
1009              
1010             Used to C elements when installed, unless C is given
1011              
1012             =item * L
1013              
1014             =item * L
1015              
1016             =item * Test Dashboard L
1017              
1018             =item * Development version on GitHub L
1019              
1020             =back
1021              
1022             =head1 AUTHOR
1023              
1024             Nigel Horne, C<< >>
1025              
1026             =cut
1027              
1028             __END__