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


line stmt bran cond sub pod time code
1             package Remember::Anything::AsPath;
2              
3 2     2   16770 use 5.010;
  2         5  
4              
5 2     2   7 use strict;
  2         2  
  2         31  
6 2     2   5 use warnings;
  2         6  
  2         44  
7 2     2   6 use Carp;
  2         2  
  2         117  
8 2     2   7 use Sereal::Encoder;
  2         2  
  2         708  
9              
10             our $VERSION = '0.05';
11              
12             sub new {
13 2     2 0 313 my ($class, %args) = @_;
14              
15 2   100     9 my $tree_depth = int(($args{tree_depth} // 2) + 1);
16 2 50       5 croak 'tree depth must be at least 1' if $tree_depth < 1;
17              
18 2   66     5 my $digest_sub = $args{digest_sub} // do {
19 1 50       2 eval { require Digest::SHA }
  1         5  
20             || croak "pass 'digest_sub' which returns path friendly chars as attribute "
21             . "or install 'Digest::SHA' module to use default digest function";
22 1         17 Digest::SHA->import('sha1_hex');
23 1         1 \&sha1_hex;
24             };
25              
26 2   100     34 my $part_length = int(length($digest_sub->(1)) / ($args{tree_depth} // 3) + 1);
27 2         18 my $encoder = Sereal::Encoder->new({ canonical => 1 });
28             $args{_path_parts_of} = sub {
29 6     6   177 unpack "(A$part_length)*", $digest_sub->( $encoder->encode(\@_) );
30 2         8 };
31              
32 2   50     4 $args{out_dir} ||= '.';
33 2         5 $args{out_dir} =~ s{[\/\\]$}{}; # remove trailing slash or backslash
34 2 50       21 croak 'out dir does not exist' unless -d $args{out_dir};
35              
36 2         5 return bless \%args, $class;
37             }
38              
39             sub seen {
40 4     4 1 10 my $self = shift;
41 4   100     9 return (-f join '/', $self->{out_dir}, $self->{_path_parts_of}->(@_)) // 0;
42             }
43              
44             sub remember {
45 2     2 1 3 my $self = shift;
46              
47 2         3 my @path_parts = $self->{_path_parts_of}->(@_);
48              
49 2         6 my $full_path = join '/', $self->{out_dir}, @path_parts;
50 2 50       16 return if -f $full_path;
51              
52 2         2 my $cur_path = $self->{out_dir};
53 2         7 for my $path_part (@path_parts[0 .. $#path_parts - 1]) {
54 5         7 $cur_path .= "/$path_part";
55 5 50       3 eval { mkdir $cur_path unless -d $cur_path }
  5         221  
56             }
57              
58 2         95 open my $fh, '>', $full_path;
59 2         11 close $fh;
60              
61 2         7 return;
62             }
63              
64             1;
65              
66             __END__