File Coverage

blib/lib/Locale/Maketext/Lexicon/Slurp.pm

Criterion	Covered	Total	%
statement	59	62	95.1
branch	23	28	82.1
condition	7	9	77.7
subroutine	9	9	100.0
pod	4	4	100.0
total	102	112	91.0

package Locale::Maketext::Lexicon::Slurp;

use strict;
use warnings;

use File::Basename ();
use Path::Class;

our $VERSION = "0.01";
our $AUTHORITY = 'NUFFIN';

sub read_file {
    my ( $self, %args ) = @_;

    local $/;

    my $file = $args{path};

    open my $fh, "<", $file or die "open($file): $!";

    binmode $fh, $args{binmode} if exists $args{binmode};

    scalar(<$fh>);
}

sub readdir {
    my ( $self, $dir ) = @_;
    grep { -f $_ } $dir->children;
}

sub get_files {
    my ( $self, $args ) = @_;

    my @files;
    my $dir = $args->{dir} && -d $args->{dir} ? Path::Class::dir($args->{dir}) : undef;

    if ( my $files = $args->{files} ) {
        if ( $dir ) {
            if ( (ref($files)||'') ne 'ARRAY' ) {
                @files = map { Path::Class::file($_) } glob( $dir->file($files)->stringify );
            } else {
                @files = map { $dir->file($_) } @$files;
            }
        } else {
            if ( (ref($files)||'') ne 'ARRAY' ) {
                @files = map { Path::Class::file($_) } glob($files);
            } else {
                @files = @$files;
            }
        }
    } elsif ( $dir ) {
        my $readdir = $args->{readdir} || "readdir";
        @files = $self->$readdir( $dir );
    } elsif ( $args->{dir} ) { # not a directory, special case for 1 arg form
        @files = map { Path::Class::file($_) } glob($args->{dir});
    }

    if ( my $re = $args->{regex} ) {
        @files = grep { $_ =~ $re } @files;
    }

    if ( my $filter = $args->{filter} ) {
        @files = grep { $self->$filter( $_ ) } @files;
    }

    if ( @files ) {
        if ( $dir ) {
            my $dir_obj = Path::Class::dir($dir);
            return { map { Path::Class::file($_)->relative( $dir_obj )->stringify => "$_" } @files },
        } else {
            return { map { File::Basename::basename($_) => "$_" } @files };
        }
    }

    die "No files specified";
}

sub parse {
    my ( $self, @args ) = @_;

    unshift @args, "dir" if @args % 2 == 1; # work in Lexicon's * mode

    my $args = { @args };

    my $files = $self->get_files( $args );

    return {
        map {
            my $name = $_;
            my $path = $files->{$name};
            $name => sub {
                return $self->read_file(
                    %$args,
                    path => $path,
                    name => $name,
                    args => \@_
                )
            }
        } keys %$files
    };
}

1;

__END__