File Coverage

blib/lib/Remember/Anything/AsPath.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	5	10	50.0
condition	9	11	81.8
subroutine	9	9	100.0
pod	2	3	66.6
total	69	77	89.6

package Remember::Anything::AsPath;

use 5.010;

use strict;
use warnings;
use Carp;
use Sereal::Encoder;

our $VERSION = '0.04';

sub new {
    my ($class, %args) = @_;

    my $tree_depth = int(($args{tree_depth} // 2) + 1);
    croak 'tree depth must be at least 1' if $tree_depth < 1;

    my $digest_sub = $args{digest_sub} // do {
        eval { require Digest::SHA }
            || croak "pass 'digest_sub' which returns path friendly chars  as attribute "
                   . "or install 'Digest::SHA' module to use default digest function";
        Digest::SHA->import('sha1_hex');
        \&sha1_hex;
    };

    my $part_length = int(length($digest_sub->(1)) / ($args{tree_depth} // 3) + 1);
    my $encoder     = Sereal::Encoder->new({ sort_keys => 1 });
    $args{_path_parts_of} = sub {
        unpack "(A$part_length)*", $digest_sub->( $encoder->encode(\@_) );
    };

    $args{out_dir} ||= '.';
    $args{out_dir} =~ s{[\/\\]$}{}; # remove trailing slash or backslash
    croak 'out dir does not exist' unless -d $args{out_dir};

    return bless \%args, $class;
}

sub seen {
    my $self = shift;
    return (-f join '/', $self->{out_dir}, $self->{_path_parts_of}->(@_)) // 0;
}

sub remember {
    my $self = shift;

    my @path_parts = $self->{_path_parts_of}->(@_);

    my $full_path = join '/', $self->{out_dir}, @path_parts;
    return if -f $full_path;

    my $cur_path = $self->{out_dir};
    for my $path_part (@path_parts[0 .. $#path_parts - 1]) {
        $cur_path .= "/$path_part";
        eval { mkdir $cur_path unless -d $cur_path }
    }

    open my $fh, '>', $full_path;
    close $fh;

    return;
}

1;

__END__