File Coverage

blib/lib/Config/CmdRC.pm

Criterion	Covered	Total	%
statement	65	65	100.0
branch	18	20	90.0
condition	7	10	70.0
subroutine	13	13	100.0
pod	2	2	100.0
total	105	110	95.4

package Config::CmdRC;
use strict;
use warnings;
use File::Spec;
use Config::Simple;
use Hash::Merge qw/merge/;

our $VERSION = '0.07';

our $RC;

our $RC_DIRS = ($^O =~ m!Win32!) ? [
    # TODO: better windows support
    '.',
    $ENV{CMDRC_DIR},
    $ENV{HOME},
] : [
    # TODO: Are these common configuration directories?
    '.',
    $ENV{CMDRC_DIR},
    $ENV{HOME},
    '/etc',
];

sub import {
    my $class = shift;

    my $caller_class = caller;

    $class->read(@_);

    {
        no strict 'refs'; ## no critic
        *{"${caller_class}::RC"} = \&RC;
    }
}

sub read {
    my $self = shift;

    my ($file, $dir, $loader) = _get_args(@_);

    if ( my $user_rc_file = _get_user_rcfile() ) {
        $file = $user_rc_file;
    }

    my %hash;
    for my $d ( @{_array($dir)}, @{$RC_DIRS} ) {
        next unless $d;
        for my $f ( @{_array($file)} ) {
            my $path = File::Spec->catfile($d, $f);
            if (-e $path) {
                my $config = $loader->($path);
                %hash = %{ merge(\%hash, $config) };
            }
        }
    }

    return $RC = \%hash;
}

sub _get_user_rcfile {
    return unless @ARGV;

    my $f = 0;
    my @rcfiles;
    for my $opt (@ARGV) {
        if ($f && $opt) {
            push @rcfiles, $opt;
            $f = 0;
        }
        elsif ($opt && $opt eq '--rc') {
            $f = 1;
        }
    }

    return \@rcfiles if @rcfiles;
}

sub _get_args {
    my ($file, $dir, $loader);
    if (@_ == 1) {
        $file = shift;
    }
    else {
        my %arg = @_;
        $file = $arg{file} || []; # TODO: Is default file name needed?
        $dir  = $arg{dir}  || [];
        $loader = $arg{loader};
    }

    $loader = $loader ? $loader : sub {
        my $path = shift;
        my $config = Config::Simple->new($path);
        return $config->vars;
    };

    return($file, $dir, $loader);
}

sub _array {
    my $v = shift;
    return (ref $v eq 'ARRAY') ? $v : [$v];
}

sub RC { $RC }

1;

__END__