File: | blib/lib/Config/Abstraction.pm |
Coverage: | 67.8% |
line | stmt | bran | cond | sub | 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 10 | 738318 9 128 | use strict; | |||
8 | 10 10 10 | 15 7 168 | use warnings; | |||
9 | ||||||
10 | 10 10 10 | 17 6 203 | use Carp; | |||
11 | 10 10 10 | 1924 79002 289 | use Data::Reuse; | |||
12 | 10 10 10 | 37 8 322 | use JSON::MaybeXS 'decode_json'; # Doesn't behave well with require | |||
13 | 10 10 10 | 677 31067 186 | use File::Slurp qw(read_file); | |||
14 | 10 10 10 | 21 6 119 | use File::Spec; | |||
15 | 10 10 10 | 1807 30772 293 | use Hash::Merge qw(merge); | |||
16 | 10 10 10 | 1603 35851 196 | use Params::Get 0.04; | |||
17 | 10 10 10 | 1831 9811 236 | use Params::Validate::Strict; | |||
18 | 10 10 10 | 20 10 15672 | use Scalar::Util; | |||
19 | ||||||
20 - 28 | =head1 NAME Config::Abstraction - Merge and manage configuration data from different sources =head1 VERSION Version 0.34 =cut | |||||
29 | ||||||
30 | our $VERSION = '0.34'; | |||||
31 | ||||||
32 - 310 | =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. For instance, if you have a key in the configuration such as C<database.user>, you can override it by setting the corresponding environment variable C<APP_DATABASE__USER> in your system. For example: $ export APP_DATABASE__USER="env_user" This will override any value set for C<database.user> in the configuration files. =head2 COMMAND LINE HANDLING Configuration values can be overridden via the command line (C<@ARGV>). For instance, if you have a key in the configuration such as C<database.user>, you can override it by adding C<"--APP_DATABASE__USER=other_user_name"> to the command line arguments. This will override any value set for C<database.user> in the configuration files. =head2 EXAMPLE CONFIGURATION FLOW =over 4 =item 1. Data Argument The data passed into the constructor via the C<data> argument is the starting point. Essentially, this contains the default values. =item 2. Loading Files The module then looks for configuration files in the specified directories. It loads the following files in order of preference: C<base.yaml>, C<local.yaml>, C<base.json>, C<local.json>, C<base.xml>, C<local.xml>, C<base.ini>, and C<local.ini>. If C<config_file> or C<config_files> is set, those files are loaded last. If no C<config_dirs> is given, try hard to find the files in various places. =item 3. Merging and Resolving The module merges the contents of these files, with more specific configurations (e.g., C<local.*>) overriding general ones (e.g., C<base.*>). =item 4. Environment Overrides After loading and merging the configuration files, the environment variables are checked and used to override any conflicting settings. =item 5. Command Line Next, the command line arguments are checked and used to override any conflicting settings. =item 6. Accessing Values Values in the configuration can be accessed using a dotted notation (e.g., C<'database.user'>), regardless of the file format used. =back =head1 METHODS =head2 new Constructor for creating a new configuration object. Options: =over 4 =item * C<config_dirs> An arrayref of directories to look for configuration files (default: C<$CONFIG_DIR>, C<$HOME/.conf>, C<$HOME/config>, C<$HOME/conf>, C<$DOCUMENT_ROOT/conf>, C<$DOCUMENT_ROOT/../conf>, C<conf>). =item * C<config_file> Points to a configuration file of any format. =item * C<config_files> An arrayref of files to look for in the configuration directories. Put the more important files later, since later files override earlier ones. Considers the files C<default> and C<$script_name> before looking at C<config_file> and C<config_files>. =item * C<data> A hash ref of default data to prime the configuration with. These are applied before loading other sources and can be overridden by later sources or by explicitly passing options directly to C<new>. $config = Config::Abstraction->new( data => { log_level => 'info', retries => 3, } ); =item * C<env_prefix> A prefix for environment variable keys and comment line options, e.g. C<MYAPP_DATABASE__USER>, (default: C<'APP_'>). =item * C<file> Synonym for C<config_file> =item * C<flatten> If true, returns a flat hash structure like C<{database.user}> (default: C<0>) instead of C<{database}{user}>. ` =item * C<level> Level for logging. =item * C<logger> Used for warnings and traces. It can be an object that understands warn() and trace() messages, such as a L<Log::Log4perl> or L<Log::Any> object, a reference to code, a reference to an array, or a filename. =item * C<path> A synonym of C<config_dirs>. =item * C<sep_char> The separator in keys. The default is a C<'.'>, as in dotted notation, such as C<'database.user'>. =item * C<schema> A L<Params::Validate::Strict> compatible schema to validate the configuration file against. =back If just one argument is given, it is assumed to be the name of a file. =cut | |||||
311 | ||||||
312 | sub new | |||||
313 | { | |||||
314 | 24 | 645659 | my $class = shift; | |||
315 | 24 | 25 | my $params; | |||
316 | ||||||
317 | 24 | 44 | if(scalar(@_) == 1) { | |||
318 | # Just one parameter - the name of a file | |||||
319 | 1 | 2 | $params = Params::Get::get_params('file', \@_); | |||
320 | } else { | |||||
321 | 23 | 56 | $params = Params::Get::get_params(undef, \@_) || {}; | |||
322 | } | |||||
323 | ||||||
324 | 24 | 417 | $params->{'config_dirs'} //= $params->{'path'}; # Compatibility with Config::Auto | |||
325 | ||||||
326 | 24 | 52 | if((!defined($params->{'config_dirs'})) && $params->{'file'}) { | |||
327 | 1 | 4 | $params->{'config_file'} = $params->{'file'}; | |||
328 | } | |||||
329 | ||||||
330 | 24 | 31 | if(!defined($params->{'config_dirs'})) { | |||
331 | 6 | 22 | if($params->{'config_file'} && File::Spec->file_name_is_absolute($params->{'config_file'})) { | |||
332 | 1 | 2 | $params->{'config_dirs'} = ['']; | |||
333 | } else { | |||||
334 | # Set up the default value for config_dirs | |||||
335 | 5 | 8 | if($^O ne 'MSWin32') { | |||
336 | 5 | 11 | $params->{'config_dirs'} = [ '/etc', '/usr/local/etc' ]; | |||
337 | } else { | |||||
338 | 0 | 0 | $params->{'config_dirs'} = ['']; | |||
339 | } | |||||
340 | 5 | 10 | if($ENV{'HOME'}) { | |||
341 | 5 | 45 | push @{$params->{'config_dirs'}}, | |||
342 | File::Spec->catdir($ENV{'HOME'}, '.conf'), | |||||
343 | File::Spec->catdir($ENV{'HOME'}, '.config'), | |||||
344 | 5 | 10 | File::Spec->catdir($ENV{'HOME'}, 'conf'), | |||
345 | } elsif($ENV{'DOCUMENT_ROOT'}) { | |||||
346 | 0 | 0 | push @{$params->{'config_dirs'}}, | |||
347 | File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, File::Spec->updir(), 'conf'), | |||||
348 | File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, 'conf'), | |||||
349 | 0 | 0 | File::Spec->catdir($ENV{'DOCUMENT_ROOT'}, 'config'); | |||
350 | } | |||||
351 | 5 | 10 | if(my $dir = $ENV{'CONFIG_DIR'}) { | |||
352 | 0 0 | 0 0 | push @{$params->{'config_dirs'}}, $dir; | |||
353 | } else { | |||||
354 | 5 5 | 2 8 | push @{$params->{'config_dirs'}}, 'conf', 'config'; | |||
355 | } | |||||
356 | } | |||||
357 | } | |||||
358 | ||||||
359 | my $self = bless { | |||||
360 | sep_char => '.', | |||||
361 | 24 | 120 | %{$params->{defaults} ? $params->{defaults} : $params}, | |||
362 | 24 | 28 | env_prefix => $params->{env_prefix} || 'APP_', | |||
363 | config => {}, | |||||
364 | }, $class; | |||||
365 | ||||||
366 | 24 | 51 | if(my $logger = $self->{'logger'}) { | |||
367 | 0 | 0 | if(!Scalar::Util::blessed($logger)) { | |||
368 | 0 | 0 | $self->_load_driver('Log::Abstraction'); | |||
369 | 0 | 0 | $self->{'logger'} = Log::Abstraction->new($logger); | |||
370 | 0 | 0 | if($params->{'level'} && $self->{'logger'}->can('level')) { | |||
371 | 0 | 0 | $self->{'logger'}->level($params->{'level'}); | |||
372 | } | |||||
373 | } | |||||
374 | } | |||||
375 | 24 | 44 | $self->_load_config(); | |||
376 | ||||||
377 | 24 | 872 | if(my $schema = $params->{'schema'}) { | |||
378 | 1 | 3 | $self->{'config'} = Params::Validate::Strict::validate_strict(schema => $schema, input => $self->{'config'}); | |||
379 | } | |||||
380 | ||||||
381 | 23 23 | 39 39 | if($self->{'config'} && scalar(keys %{$self->{'config'}})) { | |||
382 | 22 | 70 | return $self; | |||
383 | } | |||||
384 | 1 | 4 | return undef; | |||
385 | } | |||||
386 | ||||||
387 | sub _load_config | |||||
388 | { | |||||
389 | 24 | 63 | if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) { | |||
390 | 0 | 0 | Carp::croak('Illegal Operation: This method can only be called by a subclass'); | |||
391 | } | |||||
392 | ||||||
393 | 24 | 260 | my $self = shift; | |||
394 | 24 | 23 | my %merged; | |||
395 | ||||||
396 | 24 | 34 | if($self->{'data'}) { | |||
397 | # The data argument given to 'new' contains defaults that this routine will override | |||||
398 | 7 7 | 3 9 | %merged = %{$self->{'data'}}; | |||
399 | } | |||||
400 | ||||||
401 | 24 | 26 | my $logger = $self->{'logger'}; | |||
402 | 24 | 29 | if($logger) { | |||
403 | 0 | 0 | $logger->trace(ref($self), ' ', __LINE__, ': Entered _load_config'); | |||
404 | } | |||||
405 | ||||||
406 | 24 24 | 22 36 | my @dirs = @{$self->{'config_dirs'}}; | |||
407 | 24 | 51 | if($self->{'config_file'} && (scalar(@dirs) > 1)) { | |||
408 | 0 | 0 | if(File::Spec->file_name_is_absolute($self->{'config_file'})) { | |||
409 | # Handle absolute paths | |||||
410 | 0 | 0 | @dirs = (''); | |||
411 | } else { | |||||
412 | # Look in the current directory | |||||
413 | 0 | 0 | push @dirs, File::Spec->curdir(); | |||
414 | } | |||||
415 | } | |||||
416 | 24 | 32 | for my $dir (@dirs) { | |||
417 | 54 | 61 | next if(!defined($dir)); | |||
418 | ||||||
419 | 54 | 47 | for my $file (qw/base.yaml base.yml base.json base.xml base.ini local.yaml local.yml local.json local.xml local.ini/) { | |||
420 | 540 | 1064 | my $path = File::Spec->catfile($dir, $file); | |||
421 | 540 | 457 | if($logger) { | |||
422 | 0 | 0 | $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path"); | |||
423 | } | |||||
424 | 540 | 1373 | next unless -f $path; | |||
425 | ||||||
426 | 32 | 34 | if($logger) { | |||
427 | 0 | 0 | $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path"); | |||
428 | } | |||||
429 | ||||||
430 | 32 | 24 | my $data; | |||
431 | # TODO: only load config modules when they are needed | |||||
432 | 32 | 126 | if ($file =~ /\.ya?ml$/) { | |||
433 | 7 | 12 | $self->_load_driver('YAML::XS', ['LoadFile']); | |||
434 | 7 7 | 8 9 | $data = eval { LoadFile($path) }; | |||
435 | 7 | 348 | croak "Failed to load YAML from $path: $@" if $@; | |||
436 | } elsif ($file =~ /\.json$/) { | |||||
437 | 5 5 | 4 7 | $data = eval { decode_json(read_file($path)) }; | |||
438 | 5 | 197 | croak "Failed to load JSON from $path: $@" if $@; | |||
439 | } elsif($file =~ /\.xml$/) { | |||||
440 | 10 | 5 | my $rc; | |||
441 | 10 | 16 | if($self->_load_driver('XML::Simple', ['XMLin'])) { | |||
442 | 0 0 | 0 0 | eval { $rc = XMLin($path, ForceArray => 0, KeyAttr => []) }; | |||
443 | 0 | 0 | if($@) { | |||
444 | 0 | 0 | if($logger) { | |||
445 | 0 | 0 | $logger->notice("Failed to load XML from $path: $@"); | |||
446 | } else { | |||||
447 | 0 | 0 | Carp::carp("Failed to load XML from $path: $@"); | |||
448 | } | |||||
449 | 0 | 0 | undef $rc; | |||
450 | } elsif($rc) { | |||||
451 | 0 | 0 | $data = $rc; | |||
452 | } | |||||
453 | } | |||||
454 | 10 | 17 | if((!defined($rc)) && $self->_load_driver('XML::PP')) { | |||
455 | 10 | 12 | my $xml_pp = XML::PP->new(); | |||
456 | 10 | 140 | $data = read_file($path); | |||
457 | 10 | 398 | if(my $tree = $xml_pp->parse(\$data)) { | |||
458 | 10 | 2052 | if($data = $xml_pp->collapse_structure($tree)) { | |||
459 | 10 | 252 | $self->{'type'} = 'XML'; | |||
460 | 10 | 9 | if($data->{'config'}) { | |||
461 | 10 | 13 | $data = $data->{'config'}; | |||
462 | } | |||||
463 | } | |||||
464 | } | |||||
465 | } | |||||
466 | } elsif ($file =~ /\.ini$/) { | |||||
467 | 10 | 13 | $self->_load_driver('Config::IniFiles'); | |||
468 | 10 | 19 | if(my $ini = Config::IniFiles->new(-file => $path)) { | |||
469 | $data = { map { | |||||
470 | 10 10 | 4406 47 | my $section = $_; | |||
471 | 10 15 | 14 152 | $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) } | |||
472 | } $ini->Sections() }; | |||||
473 | } else { | |||||
474 | 0 | 0 | if($logger) { | |||
475 | 0 | 0 | $logger->notice("Failed to load INI from $path: $@"); | |||
476 | } else { | |||||
477 | 0 | 0 | Carp::carp("Failed to load INI from $path: $@"); | |||
478 | } | |||||
479 | } | |||||
480 | } | |||||
481 | 32 | 200 | if($data) { | |||
482 | 32 | 31 | if($logger) { | |||
483 | 0 | 0 | $logger->debug(ref($self), ' ', __LINE__, ": Loaded data from $path"); | |||
484 | } | |||||
485 | 32 32 | 22 48 | %merged = %{ merge( $data, \%merged ) }; | |||
486 | 32 32 | 1835 44 | push @{$merged{'config_path'}}, $path; | |||
487 | } | |||||
488 | } | |||||
489 | ||||||
490 | # Put $self->{config_file} through all parsers, ignoring all errors, then merge that in | |||||
491 | 54 | 55 | if(!$self->{'script_name'}) { | |||
492 | 24 | 112 | require File::Basename && File::Basename->import() unless File::Basename->can('basename'); | |||
493 | ||||||
494 | # Determine script name | |||||
495 | 24 | 598 | $self->{'script_name'} = File::Basename::basename($ENV{'SCRIPT_NAME'} || $0); | |||
496 | } | |||||
497 | ||||||
498 | 54 | 45 | my $script_name = $self->{'script_name'}; | |||
499 | 54 54 | 73 47 | for my $config_file ('default', $script_name, "$script_name.cfg", "$script_name.conf", "$script_name.config", $self->{'config_file'}, @{$self->{'config_files'}}) { | |||
500 | 328 | 242 | next unless defined($config_file); | |||
501 | # Note that loading $script_name in the current directory could mean loading the script as it's own config. | |||||
502 | # This test is not foolproof, buyer beware | |||||
503 | 285 | 289 | next if(($config_file eq $script_name) && ((length($dir) == 0) || ($dir eq File::Spec->curdir()))); | |||
504 | 281 | 568 | my $path = length($dir) ? File::Spec->catfile($dir, $config_file) : $config_file; | |||
505 | 281 | 244 | if($logger) { | |||
506 | 0 | 0 | $logger->debug(ref($self), ' ', __LINE__, ": Looking for configuration $path"); | |||
507 | } | |||||
508 | 281 | 789 | if((-f $path) && (-r $path)) { | |||
509 | 13 | 27 | my $data = read_file($path); | |||
510 | 13 | 571 | if($logger) { | |||
511 | 0 | 0 | $logger->debug(ref($self), ' ', __LINE__, ": Loading data from $path"); | |||
512 | } | |||||
513 | 13 | 14 | eval { | |||
514 | 13 | 52 | if(($data =~ /^\s*<\?xml/) || ($data =~ /<\/.+>/)) { | |||
515 | 7 | 13 | if($self->_load_driver('XML::Simple', ['XMLin'])) { | |||
516 | 0 | 0 | if($data = XMLin($path, ForceArray => 0, KeyAttr => [])) { | |||
517 | 0 | 0 | $self->{'type'} = 'XML'; | |||
518 | } | |||||
519 | } elsif($self->_load_driver('XML::PP')) { | |||||
520 | 7 | 11 | my $xml_pp = XML::PP->new(); | |||
521 | 7 | 98 | if(my $tree = $xml_pp->parse(\$data)) { | |||
522 | 7 | 1008 | if($data = $xml_pp->collapse_structure($tree)) { | |||
523 | 7 | 92 | $self->{'type'} = 'XML'; | |||
524 | 7 | 7 | if($data->{'config'}) { | |||
525 | 7 | 11 | $data = $data->{'config'}; | |||
526 | } | |||||
527 | } | |||||
528 | } | |||||
529 | } | |||||
530 | } elsif($data =~ /\{.+:.\}/s) { | |||||
531 | 0 | 0 | $self->_load_driver('JSON::Parse'); | |||
532 | # CPanel::JSON is very noisy, so be careful before attempting to use it | |||||
533 | 0 | 0 | my $is_json; | |||
534 | 0 0 | 0 0 | eval { $is_json = JSON::Parse::parse_json($data) }; | |||
535 | 0 | 0 | if($is_json) { | |||
536 | 0 0 | 0 0 | eval { $data = decode_json($data) }; | |||
537 | 0 | 0 | if($@) { | |||
538 | 0 | 0 | undef $data; | |||
539 | } | |||||
540 | } else { | |||||
541 | 0 | 0 | undef $data; | |||
542 | } | |||||
543 | 0 | 0 | if($data) { | |||
544 | 0 | 0 | $self->{'type'} = 'JSON'; | |||
545 | } | |||||
546 | } else { | |||||
547 | 6 | 5 | undef $data; | |||
548 | } | |||||
549 | 13 | 30 | if(!$data) { | |||
550 | 6 | 20 | $self->_load_driver('YAML::XS', ['LoadFile']); | |||
551 | 6 6 | 6 10 | if((eval { $data = LoadFile($path) }) && (ref($data) eq 'HASH')) { | |||
552 | # Could be colon file, could be YAML, whichever it is break the configuration fields | |||||
553 | # foreach my($k, $v) (%{$data}) { | |||||
554 | 5 5 | 296 9 | foreach my $k (keys %{$data}) { | |||
555 | 19 | 12 | my $v = $data->{$k}; | |||
556 | 19 | 21 | next if($v =~ /^".+"$/); # Quotes to keep in one field | |||
557 | 19 | 21 | if($v =~ /,/) { | |||
558 | 4 | 10 | my @vals = split(/\s*,\s*/, $v); | |||
559 | 4 | 2 | delete $data->{$k}; | |||
560 | 4 | 4 | foreach my $val (@vals) { | |||
561 | 8 | 14 | if($val =~ /(.+)=(.+)/) { | |||
562 | 8 | 15 | $data->{$k}{$1} = $2; | |||
563 | } else { | |||||
564 | 0 | 0 | $data->{$k}{$val} = 1; | |||
565 | } | |||||
566 | } | |||||
567 | } | |||||
568 | } | |||||
569 | 5 | 8 | if($data) { | |||
570 | 5 | 6 | $self->{'type'} = 'YAML'; | |||
571 | } | |||||
572 | } | |||||
573 | 6 | 76 | if((!$data) || (ref($data) ne 'HASH')) { | |||
574 | 1 | 2 | $self->_load_driver('Config::IniFiles'); | |||
575 | 1 | 3 | if(my $ini = Config::IniFiles->new(-file => $path)) { | |||
576 | $data = { map { | |||||
577 | 0 0 | 0 0 | my $section = $_; | |||
578 | 0 0 | 0 0 | $section => { map { $_ => $ini->val($section, $_) } $ini->Parameters($section) } | |||
579 | } $ini->Sections() }; | |||||
580 | 0 | 0 | if($data) { | |||
581 | 0 | 0 | $self->{'type'} = 'INI'; | |||
582 | } | |||||
583 | } | |||||
584 | 1 | 297 | if((!$data) || (ref($data) ne 'HASH')) { | |||
585 | # Maybe XML without the leading XML header | |||||
586 | 1 | 3 | if($self->_load_driver('XML::Simple', ['XMLin'])) { | |||
587 | 0 0 | 0 0 | eval { $data = XMLin($path, ForceArray => 0, KeyAttr => []) }; | |||
588 | } | |||||
589 | 1 | 5 | if((!$data) || (ref($data) ne 'HASH')) { | |||
590 | 1 | 2 | if($self->_load_driver('Config::Abstract')) { | |||
591 | # Handle RT#164587 | |||||
592 | 0 | 0 | open my $oldSTDERR, ">&STDERR"; | |||
593 | 0 | 0 | close STDERR; | |||
594 | 0 0 | 0 0 | eval { $data = Config::Abstract->new($path) }; | |||
595 | 0 | 0 | if($@) { | |||
596 | 0 | 0 | undef $data; | |||
597 | } elsif($data) { | |||||
598 | 0 | 0 | $data = $data->get_all_settings(); | |||
599 | 0 0 | 0 0 | if(scalar(keys %{$data}) == 0) { | |||
600 | 0 | 0 | undef $data; | |||
601 | } | |||||
602 | } | |||||
603 | 0 | 0 | open STDERR, ">&", $oldSTDERR; | |||
604 | 0 | 0 | $self->{'type'} = 'Perl'; | |||
605 | } | |||||
606 | } | |||||
607 | 1 | 4 | if((!$data) || (ref($data) ne 'HASH')) { | |||
608 | 1 | 1 | $self->_load_driver('Config::Auto'); | |||
609 | 1 | 2 | my $ca = Config::Auto->new(source => $path); | |||
610 | 1 | 16 | if($data = $ca->parse()) { | |||
611 | 1 | 265 | $self->{'type'} = $ca->format(); | |||
612 | } | |||||
613 | } | |||||
614 | } | |||||
615 | } | |||||
616 | } | |||||
617 | }; | |||||
618 | 13 | 27 | if($logger) { | |||
619 | 0 | 0 | if($@) { | |||
620 | 0 | 0 | $logger->warn(ref($self), ' ', __LINE__, ": $@"); | |||
621 | 0 | 0 | undef $data; | |||
622 | } else { | |||||
623 | 0 | 0 | $logger->debug(ref($self), ' ', __LINE__, ': Loaded data from', $self->{'type'}, "file $path"); | |||
624 | } | |||||
625 | } | |||||
626 | 13 | 39 | if(scalar(keys %merged)) { | |||
627 | 2 | 2 | if($data) { | |||
628 | 2 2 | 1 2 | %merged = %{ merge($data, \%merged) }; | |||
629 | } | |||||
630 | } elsif($data && (ref($data) eq 'HASH')) { | |||||
631 | 11 11 | 8 21 | %merged = %{$data}; | |||
632 | } elsif((!$@) && $logger) { | |||||
633 | 0 | 0 | $logger->debug(ref($self), ' ', __LINE__, ': No configuration file loaded'); | |||
634 | } | |||||
635 | ||||||
636 | 13 13 | 94 29 | push @{$merged{'config_path'}}, $path; | |||
637 | } | |||||
638 | } | |||||
639 | } | |||||
640 | ||||||
641 | # Merge ENV vars | |||||
642 | 24 | 26 | my $prefix = $self->{env_prefix}; | |||
643 | 24 | 30 | $prefix =~ s/__$//; | |||
644 | 24 | 49 | $prefix =~ s/_$//; | |||
645 | 24 | 18 | $prefix =~ s/::$//; | |||
646 | 24 | 243 | for my $key (keys %ENV) { | |||
647 | 2351 | 2396 | next unless $key =~ /^$self->{env_prefix}(.*)$/i; | |||
648 | 14 | 13 | my $path = lc($1); | |||
649 | 14 | 13 | if($path =~ /__/) { | |||
650 | 10 | 11 | my @parts = split /__/, $path; | |||
651 | 10 | 7 | my $ref = \%merged; | |||
652 | 10 | 22 | $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1]; | |||
653 | 10 | 19 | $ref->{ $parts[-1] } = $ENV{$key}; | |||
654 | } else { | |||||
655 | 4 | 6 | $merged{$prefix}->{$path} = $ENV{$key}; | |||
656 | } | |||||
657 | } | |||||
658 | ||||||
659 | # Merge command line options | |||||
660 | 24 | 91 | foreach my $arg(@ARGV) { | |||
661 | 1 | 2 | next unless($arg =~ /=/); | |||
662 | 1 | 2 | my ($key, $value) = split(/=/, $arg, 2); | |||
663 | 1 | 8 | next unless $key =~ /^\-\-$self->{env_prefix}(.*)$/; | |||
664 | ||||||
665 | 1 | 2 | my $path = lc($1); | |||
666 | 1 | 1 | my @parts = split(/__/, $path); | |||
667 | 1 | 1 | my $ref = \%merged; | |||
668 | 1 | 2 | $ref = ($ref->{$_} //= {}) for @parts[0..$#parts-1]; | |||
669 | 1 | 1 | $ref->{ $parts[-1] } = $value; | |||
670 | } | |||||
671 | ||||||
672 | 24 | 31 | if($self->{'flatten'}) { | |||
673 | 2 | 5 | $self->_load_driver('Hash::Flatten', ['flatten']); | |||
674 | } else { | |||||
675 | 22 | 41 | $self->_load_driver('Hash::Flatten', ['unflatten']); | |||
676 | } | |||||
677 | # $self->{config} = $self->{flatten} ? flatten(\%merged) : unflatten(\%merged); | |||||
678 | # Don't unflatten because of RT#166761 | |||||
679 | 24 | 63 | $self->{config} = $self->{flatten} ? flatten(\%merged) : \%merged; | |||
680 | } | |||||
681 | ||||||
682 - 687 | =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 | |||||
688 | ||||||
689 | sub get | |||||
690 | { | |||||
691 | 27 | 1004 | my ($self, $key) = @_; | |||
692 | ||||||
693 | 27 | 47 | if($self->{flatten}) { | |||
694 | 2 | 5 | return $self->{config}{$key}; | |||
695 | } | |||||
696 | 25 | 19 | my $ref = $self->{'config'}; | |||
697 | 25 | 109 | for my $part (split qr/\Q$self->{sep_char}\E/, $key) { | |||
698 | 39 | 35 | return undef unless ref $ref eq 'HASH'; | |||
699 | 39 | 41 | $ref = $ref->{$part}; | |||
700 | } | |||||
701 | 25 | 54 | if((defined($ref) && !$self->{'no_fixate'})) { | |||
702 | 24 | 42 | if(ref($ref) eq 'HASH') { | |||
703 | 0 0 | 0 0 | Data::Reuse::fixate(%{$ref}); | |||
704 | } elsif(ref($ref) eq 'ARRAY') { | |||||
705 | 1 1 | 1 4 | Data::Reuse::fixate(@{$ref}); | |||
706 | } | |||||
707 | } | |||||
708 | 25 | 136 | return $ref; | |||
709 | } | |||||
710 | ||||||
711 - 718 | =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 | |||||
719 | ||||||
720 | sub all | |||||
721 | { | |||||
722 | 9 | 7 | my $self = shift; | |||
723 | ||||||
724 | 9 | 16 | return($self->{'config'} && scalar(keys %{$self->{'config'}})) ? $self->{'config'} : undef; | |||
725 | } | |||||
726 | ||||||
727 - 769 | =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 | |||||
770 | ||||||
771 | sub merge_defaults | |||||
772 | { | |||||
773 | 4 | 1026 | my $self = shift; | |||
774 | 4 | 4 | my $config = $self->all(); | |||
775 | ||||||
776 | 4 | 5 | return $config if(scalar(@_) == 0); | |||
777 | ||||||
778 | 4 | 4 | my $params = Params::Get::get_params('defaults', @_); | |||
779 | 4 | 48 | my $defaults = $params->{'defaults'}; | |||
780 | 4 | 6 | return $config if(!defined($defaults)); | |||
781 | 2 | 1 | my $section = $params->{'section'}; | |||
782 | ||||||
783 | 2 | 5 | Hash::Merge::set_clone_behavior(0); | |||
784 | ||||||
785 | 2 | 63 | if($config->{'global'}) { | |||
786 | 0 | 0 | if($params->{'deep'}) { | |||
787 | 0 | 0 | $defaults = merge($config->{'global'}, $defaults); | |||
788 | } else { | |||||
789 | 0 0 0 | 0 0 0 | $defaults = { %{$defaults}, %{$config->{'global'}} }; | |||
790 | } | |||||
791 | 0 | 0 | delete $config->{'global'}; | |||
792 | } | |||||
793 | 2 | 3 | if($section && $config->{$section}) { | |||
794 | 0 | 0 | $config = $config->{$section}; | |||
795 | } | |||||
796 | 2 | 2 | if($params->{'merge'}) { | |||
797 | 1 | 2 | return merge($config, $defaults); | |||
798 | } | |||||
799 | 1 1 1 | 1 1 8 | return { %{$defaults}, %{$config} }; | |||
800 | } | |||||
801 | ||||||
802 | # Helper routine to load a driver | |||||
803 | sub _load_driver | |||||
804 | { | |||||
805 | 85 | 92 | my($self, $driver, $imports) = @_; | |||
806 | ||||||
807 | 85 | 118 | return 1 if($self->{'loaded'}{$driver}); | |||
808 | 73 | 85 | return 0 if($self->{'failed'}{$driver}); | |||
809 | ||||||
810 | 68 | 1879 | eval "require $driver"; | |||
811 | 68 | 37571 | if($@) { | |||
812 | 14 | 20 | if(my $logger = $self->{'logger'}) { | |||
813 | 0 | 0 | $logger->warn(ref($self), ": $driver failed to load: $@"); | |||
814 | } | |||||
815 | 14 | 18 | $self->{'failed'}{$driver} = 1; | |||
816 | 14 | 29 | return; | |||
817 | } | |||||
818 | 54 54 | 62 513 | $driver->import(@{ $imports // [] }); | |||
819 | 54 | 92 | $self->{'loaded'}{$driver} = 1; | |||
820 | 54 | 57 | return 1; | |||
821 | } | |||||
822 | ||||||
823 - 850 | =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 | |||||
851 | ||||||
852 | sub AUTOLOAD | |||||
853 | { | |||||
854 | 32 | 7510 | our $AUTOLOAD; | |||
855 | ||||||
856 | 32 | 23 | my $self = shift; | |||
857 | 32 | 31 | my $key = $AUTOLOAD; | |||
858 | ||||||
859 | 32 | 69 | $key =~ s/.*:://; # remove package name | |||
860 | 32 | 506 | return if $key eq 'DESTROY'; | |||
861 | ||||||
862 | # my $val = $self->get($key); | |||||
863 | # return $val if(defined($val)); | |||||
864 | ||||||
865 | 8 | 11 | my $data = $self->{data} || $self->{'config'}; | |||
866 | ||||||
867 | # If flattening is ON, assume keys are pre-flattened | |||||
868 | 8 | 8 | if ($self->{flatten}) { | |||
869 | 3 | 3 | return $data->{$key} if(exists $data->{$key}); | |||
870 | } | |||||
871 | ||||||
872 | 8 | 7 | my $sep = $self->{'sep_char'}; | |||
873 | ||||||
874 | # Fallback: try resolving nested structure dynamically | |||||
875 | 8 | 7 | my $val = $data; | |||
876 | 8 | 24 | foreach my $part(split /\Q$sep\E/, $key) { | |||
877 | 14 | 26 | if((ref($val) eq 'HASH') && (exists $val->{$part})) { | |||
878 | 13 | 13 | $val = $val->{$part}; | |||
879 | } else { | |||||
880 | 1 | 24 | croak "No such config key '$key'"; | |||
881 | } | |||||
882 | } | |||||
883 | 7 | 15 | return $val; | |||
884 | } | |||||
885 | ||||||
886 | 1; | |||||
887 | ||||||
888 - 943 | =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. =back =head1 BUGS It should be possible to escape the separator character either with backslashes or quotes. Due to the case-insensitive nature of environment variables on Windows, it may be challenging to override values using environment variables on that platform. =head1 SUPPORT This module is provided as-is without any warranty. Please report any bugs or feature requests to C<bug-config-abstraction at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Config-Abstraction>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. You can find documentation for this module with the perldoc command. perldoc Config::Abstraction =head1 SEE ALSO =over 4 =item * L<Config::Any> =item * L<Config::Auto> =item * L<Hash::Merge> =item * L<Log::Abstraction> =item * Test Dashboard L<https://nigelhorne.github.io/Config-Abstraction/coverage/> =back =head1 AUTHOR Nigel Horne, C<< <njh at nigelhorne.com> >> =cut | |||||
944 |