File Coverage

blib/lib/Config/JFDI/Source/Loader.pm

Criterion	Covered	Total	%
statement	104	105	99.0
branch	29	36	80.5
condition	4	9	44.4
subroutine	17	17	100.0
pod	0	3	0.0
total	154	170	90.5

package Config::JFDI::Source::Loader;

use Moose;
use MooseX::AttributeHelpers;

use Config::Any;
use Carp;
use List::MoreUtils qw/any/;

has name => qw/is ro required 0 isa Str|ScalarRef/;

has path => qw/is ro default ./;

has driver => qw/is ro lazy_build 1/;
sub _build_driver {
    return {};
}

has local_suffix => qw/is ro required 1 lazy 1 default local/;

has no_env => qw/is ro required 1/, default => 0;

has no_local => qw/is ro required 1/, default => 0;

has env_lookup => qw/is ro/, default => sub { [] };

has path_is_file => qw/is ro default 0/;

has _found => qw/metaclass Collection::Array is rw isa ArrayRef/, provides => {qw/
    elements found
/};

sub _env(@) {
    my $key = uc join "_", @_;
    $key =~ s/::/_/g;
    $key =~ s/\W/_/g;
    return $ENV{$key};
}

sub BUILD {
    my $self = shift;
    my $given = shift;

    if (defined( my $name = $self->name )) {
        if (ref $name eq "SCALAR") {
            $name = $$name;
        }
        else {
            $name =~ s/::/_/g;
            $name = lc $name;
        }
        $self->{name} = $name;
    }

    if (defined $self->env_lookup) {
        $self->{env_lookup} = [ $self->env_lookup ] unless ref $self->env_lookup eq "ARRAY";
    }

}

sub read {
    my $self = shift;

    my @files = $self->_find_files;
    my $cfg_files = $self->_load_files(\@files);
    my %cfg_files = map { (%$_)[0] => $_ } reverse @$cfg_files;
    $self->_found( [ map { (%$_)[0] } @$cfg_files ] );

    my (@cfg, @local_cfg);
    {
        # Anything that is local takes precedence
        my $local_suffix = $self->_get_local_suffix;
        for (sort keys %cfg_files) {

            my $cfg = $cfg_files{$_};

            if (m{$local_suffix\.}ms) {
                push @local_cfg, $cfg;
            }
            else {
                push @cfg, $cfg;
            }
        }
    }

    return $self->no_local ? @cfg : (@cfg, @local_cfg);
}

around found => sub {
    my $inner = shift;
    my $self = shift;

    $self->read unless $self->{_found};

    return $inner->( $self, @_ );
};

sub _load_files {
    my $self = shift;
    my $files = shift;
    return Config::Any->load_files({
        files => $files,
        use_ext => 1,
        driver_args => $self->driver,
    });
}

sub _find_files { # Doesn't really find files...hurm...
    my $self = shift;

    if ($self->path_is_file) {
        my $path;
        $path = $self->_env_lookup('CONFIG') unless $self->no_env;
        $path ||= $self->path;
        return ($path);
    }
    else {
        my ($path, $extension) = $self->_get_path;
        my $local_suffix = $self->_get_local_suffix;
        my @extensions = $self->_get_extensions;
        my $no_local = $self->no_local;

        my @files;
        if ($extension) {
            croak "Can't handle file extension $extension" unless any { $_ eq $extension } @extensions;
            push @files, $path;
            unless ($no_local) {
                (my $local_path = $path) =~ s{\.$extension$}{_$local_suffix.$extension};
                push @files, $local_path;
            }
        }
        else {
            push @files, map { "$path.$_" } @extensions;
            push @files, map { "${path}_${local_suffix}.$_" } @extensions unless $no_local;
        }

        return @files;
    }
}

sub _env_lookup {
    my $self = shift;
    my @suffix = @_;

    my $name = $self->name;
    my $env_lookup = $self->env_lookup;
    my @lookup;
    push @lookup, $name if $name;
    push @lookup, @$env_lookup;

    for my $prefix (@lookup) {
        my $value = _env($prefix, @suffix);
        return $value if defined $value;
    }

    return;
}

sub _get_local_suffix {
    my $self = shift;

    my $name = $self->name;
    my $suffix;
    $suffix = $self->_env_lookup('CONFIG_LOCAL_SUFFIX') unless $self->no_env;
#    $suffix = _env($self->name, 'CONFIG_LOCAL_SUFFIX') if $name && ! $self->no_env;
    $suffix ||= $self->local_suffix;

    return $suffix;
}

sub _get_extensions {
    return @{ Config::Any->extensions }
}

sub file_extension ($) {
    my $path = shift;
    return if -d $path;
    my ($extension) = $path =~ m{\.([^/\.]{1,4})$};
    return $extension;
}

sub _get_path {
    my $self = shift;

    my $name = $self->name;
    my $path;
#    $path = _env($name, 'CONFIG') if $name && ! $self->no_env;
    $path = $self->_env_lookup('CONFIG') unless $self->no_env;
    $path ||= $self->path;

    my $extension = file_extension $path;

    if (-d $path) {
        $path =~ s{[\/\\]$}{}; # Remove any trailing slash, e.g. apple/ or apple\ => apple
        $path .= "/$name"; # Look for a file in path with $self->name, e.g. apple => apple/name
    }

    return ($path, $extension);
}


1;