File Coverage

blib/lib/File/Dir/Hash.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	3	4	75.0
condition	5	9	55.5
subroutine	8	8	100.0
pod	2	2	100.0
total	59	64	92.1

package File::Dir::Hash;
use strict;
use warnings;

use File::Spec;
use File::Path qw(mkpath);
use Digest::MD5 qw(md5_hex);

use Class::XSAccessor {
    constructor => '_real_new',
    accessors => [qw(
        pattern
        hash_func
        basedir
    )]
};

our $VERSION = '0.02';

sub new {
    my ($cls,%opts) = @_;
    my $hash_func = delete $opts{hash_func};
    $hash_func ||= \&md5_hex;

    my $pattern = delete $opts{pattern};
    $pattern ||= [1,2,2,4];

    my $basedir = delete $opts{basedir};
    $basedir ||= "";

    my $self = __PACKAGE__->_real_new(
        pattern => $pattern, hash_func => $hash_func,
        basedir => $basedir);
    return $self;
}

sub genpath {
    my ($self,$key,$mkdir) = @_;
    my $hashstr = $self->hash_func->($key);
    my @chars = split(//, $hashstr);
    my @components;
    #Figure out our pattern..
    my @templ = @{$self->pattern};
    while (@templ && @chars) {
        my $n_elem = shift @templ;
        push @components, join("", splice(@chars, 0, $n_elem));
    }
    my $fname = $hashstr;

    my $tree = File::Spec->catdir($self->basedir, @components);
    if ($mkdir) {
        -d $tree or mkpath($tree);
    }
    return File::Spec->catdir($tree, $fname);
}

1;

__END__