File Coverage

blib/lib/Config/FromHash.pm

Criterion	Covered	Total	%
statement	65	77	84.4
branch	16	32	50.0
condition	5	13	38.4
subroutine	10	12	83.3
pod	0	6	0.0
total	96	140	68.5

use strict;
use warnings;
use 5.10.1;

package Config::FromHash;

our $VERSION = '0.0701'; # VERSION
# ABSTRACT: Read config files containing hashes

use File::Basename();
use Hash::Merge();
use Path::Tiny;


sub new {
    my($class, %args) = @_;

    $args{'data'} ||= {};
    $args{'sep'}  ||= qr!/!;
    $args{'require_all_files'} ||= 0;

    if(exists $args{'filename'} && exists $args{'filenames'}) {
        die "Don't use both 'filename' and 'filenames'.";
    }
    if(exists $args{'environment'} && exists $args{'environments'}) {
        die "Don't use both 'environment' and 'environments'.";
    }

    $args{'filenames'} = $args{'filename'} if exists $args{'filename'};


    if(exists $args{'filenames'}) {
        if(ref $args{'filenames'} ne 'ARRAY') {
            $args{'filenames'} = [ $args{'filenames'} ];
        }
    }
    else {
        $args{'filenames'} = [];
    }

    $args{'environments'} = $args{'filename'} if exists $args{'filename'};

    if(exists $args{'environments'}) {
        if(ref $args{'environments'} ne 'ARRAY') {
            $args{'environments'} = [ $args{'environments'} ];
        }
    }
    else {
        $args{'environments'} = [ undef ];
    }

    my $self = bless \%args => $class;

    Hash::Merge::set_behavior('LEFT_PRECEDENT');
    my $data = $args{'data'};

    if(scalar @{ $args{'filenames'} }) {

        foreach my $environment (reverse @{ $args{'environments'} }) {

            FILE:
            foreach my $config_file (reverse @{ $args{'filenames'} }) {
                my($filename, $directory, $extension) = File::Basename::fileparse($config_file, qr{\.[^.]+$});
                my $new_filename = $directory . $filename . (defined $environment ? ".$environment" : '') . $extension;

                if(!-e $new_filename) {
                    die "$new_filename does not exist" if $self->require_all_files;
                    next FILE;
                }

                $data = Hash::Merge::merge($self->parse($config_file, $data));

            }
        }
    }
    $args{'data'} = $data;

    return $self;

}

sub data {
    return shift->{'data'};
}

sub get {
    my $self = shift;
    my $path = shift;

    if(!defined $path) {
        warn "No path defined - nothing to return";
        return;
    }

    my @parts = split $self->{'sep'} => $path;
    my $hash = $self->{'data'};

    foreach my $part (@parts) {
        if(ref $hash eq 'HASH') {
            $hash = $hash->{ $part };
        }
        else {
            die "Can't resolve path '$path' beyond '$part'";
        }
    }
    return $hash;
}

sub parse {
    my $self = shift;
    my $file = shift;

    my $contents = path($file)->slurp_utf8;
    my($parsed, $error) = $self->eval($contents);

    die "Can't parse <$file>: $error" if $error;
    die "<$file> doesn't contain hash" if ref $parsed ne 'HASH';

    return $parsed;

}

sub eval {
    my $self = shift;
    my $contents = shift;

    return (eval $contents, $@);
}

sub require_all_files {
    return shift->{'require_all_files'};
}


1;

__END__