File Coverage

blib/lib/Config/Directory.pm

Criterion	Covered	Total	%
statement	87	91	95.6
branch	50	60	83.3
condition	19	29	65.5
subroutine	10	10	100.0
pod	3	5	60.0
total	169	195	86.6

package Config::Directory;

use 5.000;
use strict;
use File::Basename;
use File::Spec;

use vars qw($VERSION);

$VERSION = '0.05';

my $DIRLIST;
my $ARG;

# Helper routine - read an individual file
sub readfile
{
    my ($self, $dir_file, $arg) = @_;
    my $content = '';

    # Open
    open FILE, "<$dir_file" or die "can't open file '$dir_file': $!";

    # Read only $arg->{lines} lines, if set
    if ($arg->{lines} && $arg->{lines} =~ m/(\d+)/) {
        for (1 .. $1) {
            $content .= ;
        }
    }

    # Otherwise slurp entire file
    else {
        local $/ = undef;
        $content = ;
    }
    close FILE;

    return $content;
}

# Initialise hash
sub init
{
    my ($self, $dir, $arg) = @_;
    $dir = [ $dir ] if ref $dir ne 'ARRAY';
    $DIRLIST = $dir;
    $ARG = $arg;
    my $env = $arg->{env};
    my $maxsize = $arg->{maxsize} || 102_400;
    my $ignore = $arg->{ignore};

    # Iterate over directories in reverse order
    for my $d (reverse @$dir) {
        if (! -d $d) {
            warn "invalid directory '$d'";
            next;
        }

        # Read file list
        my @files = ();
        if ($arg->{glob}) {
            if (ref $arg->{glob} eq 'ARRAY') {
                for my $g (@{$arg->{glob}}) {
                    push @files, glob File::Spec->catfile($d, $g);
                }
            }
            else {
                @files = glob File::Spec->catfile($d, $arg->{glob});
            }
        }
        else {
            opendir DIR, $d or die "can't open directory '$d': $!";
            @files = readdir DIR;
        }

        # Iterate over files
        for my $f (@files) {
            my $dir_file = $arg->{glob} ? $f : File::Spec->catfile($d, $f);
            $f = basename($f) if $arg->{glob};

            # Ignore directories
            next if -d $dir_file;

            # Ignore if matches $ignore regex
            next if defined $ignore && $f =~ m/$ignore/;

            # Ignore if size > $maxsize
            next if -s $dir_file > $maxsize;

            # Ignore if not readable
            next unless -r $dir_file;

            # Derived names
            my $prefix_file = defined $arg->{prefix} ? $arg->{prefix} . "$f" : $f;
            my $env_file = '';
            if ($env) {
              $env_file = $env eq '1' ? $prefix_file : "${env}$f";
            }

            # Ignore if we have a later version
            next if exists $self->{$prefix_file};

            # Warn on permissions problems
            if (! -r $dir_file) {
                warn "can't read file '$dir_file'";
                next;
            }

            # Zero-sized files clear any earlier entry
            if (-z $dir_file) {
                $self->{$prefix_file} = undef;
                delete $ENV{$env_file} if $env_file and exists $ENV{$env_file};
                next;
            }

            # Read file
            $self->{$prefix_file} = $self->readfile($dir_file, $arg);

            # Chomp value unless chomp => 0 arg given
            chomp $self->{$prefix_file}
                unless exists $arg->{'chomp'} && $arg->{'chomp'} == 0;

            # Trim value unless trim => 0 arg given
            $self->{$prefix_file} =~ s/^\s*(.*?)\s*$/$1/m
                unless exists $arg->{trim} && $arg->{trim} == 0;

            # Add to environment ('env_dir') if 'env' option and single line
            if ($env) {
                my ($first, $rest) = split /\n/, $self->{$prefix_file}, 2;
                if (! $rest) {
                    $ENV{$env_file} = $self->{$prefix_file};
                    chomp $ENV{$env_file};
                }
            }
        }
        closedir DIR unless $arg->{glob};
    }

    # Delete zero-sized files
    for (keys %$self) {
        delete $self->{$_} if ! defined $self->{$_};
    }

    return $self;
}

# Constructor
sub new
{
    my $self = bless {}, shift;
    $self->init(@_);
}

# Accessor
sub get
{
    my ($self, $name) = @_;
    $self->{$name};
}

# Mutator
sub set
{
    my ($self, $name, $value) = @_;

    # Find and check directory to write to
    my $dir = $DIRLIST->[$#$DIRLIST];
    die "final directory $dir is not writable" unless -d $dir && -w $dir;

    # Save to file
    my $file = File::Spec->catfile($dir,$name);
    open OUT, ">$file" or die "unable to open '$file' for write: $!";
    {
        local $\ = undef;
        print OUT $value;
        print OUT "\n"
            unless substr($value,-1) eq "\n" || length($value) == 0 ||
                  (exists $ARG->{'chomp'} && $ARG->{'chomp'} == 0);
    }
    close OUT or die "unable to close '$file': $!";

    # Update $self
    $self->{$name} = $value;
}

1;

__END__