File Coverage

blib/lib/OrePAN2/Repository/Cache.pm
Criterion Covered Total %
statement 51 79 64.5
branch 5 24 20.8
condition 0 12 0.0
subroutine 15 18 83.3
pod 0 6 0.0
total 71 139 51.0


line stmt bran cond sub pod time code
1              
2             use strict;
3 2     2   12 use warnings;
  2         4  
  2         51  
4 2     2   8 use utf8;
  2         4  
  2         39  
5 2     2   28 use 5.008_001;
  2         6  
  2         11  
6 2     2   89  
  2         6  
7             use Carp ();
8 2     2   9 use Class::Accessor::Lite 0.05 (
  2         4  
  2         82  
9             rw => [qw(is_dirty directory)],
10 2         14 );
11 2     2   11 use Digest::MD5 ();
  2         36  
12 2     2   199 use File::Path ();
  2         4  
  2         42  
13 2     2   10 use File::Spec ();
  2         3  
  2         24  
14 2     2   7 use File::stat qw( stat );
  2         20  
  2         54  
15 2     2   418 use IO::File::AtomicChange ();
  2         6619  
  2         10  
16 2     2   903 use JSON::PP ();
  2         2507  
  2         35  
17 2     2   12  
  2         4  
  2         1134  
18             my $class = shift;
19             my %args = @_ == 1 ? %{ $_[0] } : @_;
20 2     2 0 6  
21 2 50       9 for my $key (qw(directory)) {
  0         0  
22             unless ( exists $args{$key} ) {
23 2         8 Carp::croak("Missing mandatory parameter: $key");
24 2 50       9 }
25 0         0 }
26             my $self = bless {
27             %args,
28 2         8 }, $class;
29             $self->{filename}
30             = File::Spec->catfile( $self->{directory}, 'orepan2-cache.json' );
31             return $self;
32 2         28 }
33 2         13  
34             my $self = shift;
35             $self->{data} ||= do {
36             if ( open my $fh, '<', $self->{filename} ) {
37 0     0 0 0 JSON::PP::decode_json(
38 0   0     0 do { local $/; <$fh> }
39 0 0       0 );
40             }
41 0         0 else {
  0         0  
  0         0  
42             +{};
43             }
44             };
45 0         0 }
46              
47             my ( $self, $stuff ) = @_;
48              
49             my $entry = $self->data->{$stuff};
50              
51 0     0 0 0 return 0 unless $entry && $entry->{filename} && $entry->{md5};
52              
53 0         0 my $fullpath
54             = File::Spec->catfile( $self->directory, $entry->{filename} );
55 0 0 0     0 return 0 unless -f $fullpath;
      0        
56              
57             if ( my $stat = stat($stuff) && defined( $entry->{mtime} ) ) {
58 0         0 return 0 if $stat->mtime ne $entry->{mtime};
59 0 0       0 }
60              
61 0 0 0     0 my $md5 = $self->calc_md5($fullpath);
62 0 0       0 return 0 unless $md5;
63             return 0 if $md5 ne $entry->{md5};
64             return 1;
65 0         0 }
66 0 0       0  
67 0 0       0 my ( $self, $filename ) = @_;
68 0         0  
69             open my $fh, '<', $filename
70             or do {
71             return;
72 2     2 0 24 };
73              
74             my $md5 = Digest::MD5->new();
75 2 50       69 $md5->addfile($fh);
76 0         0 return $md5->hexdigest;
77             }
78              
79 2         28 my ( $self, $stuff, $filename ) = @_;
80 2         94  
81 2         40 my $md5
82             = $self->calc_md5(
83             File::Spec->catfile( $self->directory, $filename ) )
84             or Carp::croak("Cannot calcurate MD5 for '$filename'");
85 2     2 0 22 $self->{data}->{$stuff} = +{
86             filename => $filename,
87 2 50       10 md5 => $md5,
88             ( -f $filename ? ( mtime => stat($filename)->mtime ) : () ),
89             };
90             $self->is_dirty(1);
91 2 50       39 }
92              
93             my ($self) = @_;
94              
95             my $filename = $self->{filename};
96 2         11 my $json
97             = JSON::PP->new->pretty(1)->canonical(1)->encode( $self->{data} );
98              
99             File::Path::mkpath( File::Basename::dirname($filename) );
100 0     0 0    
101             my $fh = IO::File::AtomicChange->new( $filename, 'w' );
102 0           $fh->print($json);
103             $fh->close(); # MUST CALL close EXPLICITLY
104 0           }
105              
106 0           1;
107