package Config::Hash;
use strict;
use warnings;
use v5.06;
use File::Basename;
our $VERSION = '0.920';
sub new {
my ( $class, %args ) = @_;
# Initialize defaults
$args{data} ||= {};
$args{param} ||= {};
$args{separator} ||= qr/\./;
my $self = bless \%args, $class;
no strict 'refs';
no warnings 'redefine';
*{"${class}::AUTOLOAD"} = sub {
our $AUTOLOAD;
my $sub = $AUTOLOAD =~ /::(\w+)$/ ? $1 : return;
die "Param '$sub' not defined" unless exists $self->param->{$sub};
return $self->param->{$sub};
};
if ( defined $self->{filename} ) {
# Load the main config file
my $data = merge( $self->{data}, $self->load( $self->{filename} ) );
# Break up the path in chunks
my ( $name, $dir, $ext ) = fileparse( $self->{filename}, qr/\.[^.]*/ );
# Load the rest of the files
if ( $self->{mode} ) {
my @modes = split( /\s*\,\s*/, $self->{mode} );
for my $m (@modes) {
my $filename = sprintf( "%s%s_%s%s", $dir, $name, $m, $ext );
if ( -e $filename ) {
$data = merge( $data, $self->load($filename) );
}
}
}
$self->{data} = $data;
}
return $self;
}
sub _eval {
local $@;
return (eval shift, $@);
}
sub load {
my ( $self, $filename ) = @_;
# Open and read file
open( my $in, "<:encoding(UTF-8)", $filename )
or do {
warn "Can not read config file " . $filename;
return {};
};
my $text = do { local $/ = undef; <$in> };
close($in);
my ( $hash, $error ) = _eval( $text );
die "Config file $filename parse error: " . $error if $error;
die "Config file $filename did not return a HASH - $hash"
unless ref $hash eq 'HASH';
return $hash;
}
sub get {
my ( $self, $path ) = @_;
return unless $path;
my @a = split( $self->{separator}, $path );
my $val = $self->{data};
for my $chunk (@a) {
if ( ref($val) eq 'HASH' ) {
$val = $val->{$chunk};
}
else {
die "Config path $path breaks at '$chunk'";
}
}
return $val;
}
sub merge {
my ( $a, $b ) = @_;
return $b
if !ref($a)
|| !ref($b)
|| ref($a) ne ref($b)
|| ref($a) ne 'HASH';
for my $k ( keys %$b ) {
$a->{$k} =
exists $a->{$k}
? merge( $a->{$k}, $b->{$k} )
: $b->{$k};
}
return $a;
}
sub data { $_[0]->{data} }
sub param { $_[0]->{param} }
sub DESTROY {}
1;
__END__
=head1 NAME
Config::Hash
=head1 DESCRIPTION
Handle config files containing Perl hashes
=head1 SYNOPSIS
Read, parse and merge config files containing Perl hashes:
my $c = Config::Hash->new( filename => 'MyApp.conf' );
my $user = $c->get('mysql.test.user');
my $pass = $c->get('mysql.test.pass');
# The contents of the config file named MyApp.conf:
# {
# mysql => {
# test => {
# user => 'rick',
# pass => 'james'
# }
# }
# };
Manually initialize the config data:
my $c = Config::Hash->new(
data => {
user => 'james',
pass => 'rick',
ips => {
alpha => '127.0.0.1',
beta => '10.0.0.2'
}
}
);
say "Beta is at: " . $c->get('ips.beta');
Merge data with config files:
my $c = Config::Hash->new(
data => { server => 'localhost' },
filename => 'MyApp.conf'
);
In this case the contents of the file will merge with the data hash, with
precedent given to the config file.
=head1 DESCRIPTION
Simple yet powerful config module. Why simple? Because it uses Perl hashes.
Why powerful? Because it uses Perl hashes.
=head1 MERGING
Config::Hash merges two hashes so that the second hash overrides the first
one. Let's say we have two hashes, A and B. Merging will proceed as follows:
=over
=item
Each key in B that doesn't contain a hash will be copied to A. Duplicate
keys will be overwriten in favor of B.
=cut
=item
Each key in B that contains a hash will be merged using the same algorithm
described here.
=cut
=back
Example:
# Example 1
$a = { a => 1, b => 2 };
$b = { a => 3 };
$merged = { a => 2, b => 2 };
# Example 2
$a = { a => { b => 'foo' } };
$b = { a => { b => 'baz' }, c => 'bar' };
$merged = { a => { b => 'baz', c => 'bar' } }; # Hashes merge
# Example 3:
$a = { a => [ 1, 2, 3 ] };
$b = { a => [] };
$merged = { a => [] }; # Non-hashes overwrite the other key
=head1 ATTRIBUTES
=head2 filename
Full pathname of the config file.
my $c = Config::Hash->new( filename => 'conf/stuff.pl' );
It does not matter what file extension is used, as long as the file contains a
legitimate Perl hash. Example:
# conf/stuff.pl
{
redis => 1,
mongo => {
table => 'stuff',
data => 'general'
}
};
=head2 data
Load a Perl hash instead of a file.
my $c = Config::Hash->new(
data => {
redis => 1,
mysql => {
user => 'test',
pass => 'secret'
}
}
);
=head2 mode
Application mode or modes. Files that match the modes will be merged into
the configuration data. Example:
my $c = Config::Hash->new(
filename => 'app.conf',
mode => 'development'
);
This will look first for a file C<app.conf>, then for C<app_development.conf>
and both files will be merged.
C<mode> can be a comma separated list of modes, so:
my $c = Config::Hash->new(
filename => 'app.conf',
mode => 'development, local, test'
);
will look for and merge C<app.conf>, C<app_development.conf>,
C<app_local.conf> and C<app_test.conf>.
=head2 param
Allows for passing variables to the config hash.
my $c = Config::Hash->new(
filename => 'app.conf',
param => { base_path => '/path/to/stuff' }
);
Each key of the C<param> hash can be accessed via a function with the same name
inside the config file:
# app.conf
{
name => 'Rick James',
path => base_path() . 'rick/james'
};
The evaluation of the config code is isolated from the rest of the code, so
it doesn't have access to C<$self>. If you need to use C<$self>, you'll have
to pass it in the C<params> hash and then reference it with C<self()>
B<Note:> You will have to add C<()> to the function name, otherwise Perl will
not recognize it as such and will die with an error.
=head2 separator
A regular expression for the value separator used by L</get>. The default is
C<qr/\./>, i.e. a dot.
=head1 SUBROUTINES
=head2 get
Get a value from the config hash.
my $value = $c->get('bar.foo.baz');
my $same = $c->get('bar')->{foo}->{baz};
my $again = $c->data->{bar}->{foo}->{baz};
By default the subhash separator is a dot, but this can be changed via the
L</separator> attribute.
my $c = Config::Hash->new(
filename => 'app.conf',
separator => qr/\-/
);
my $value = $c->get('bar-foo-baz');
=head1 AUTHOR
minimalist - minimal@cpan.org
=head1 LICENSE
Same as Perl itself.
=cut