File Coverage

blib/lib/Module/ScanDeps/Cache.pm
Criterion Covered Total %
statement 52 52 100.0
branch 17 24 70.8
condition 3 8 37.5
subroutine 10 10 100.0
pod 0 4 0.0
total 82 98 83.6


line stmt bran cond sub pod time code
1             package Module::ScanDeps::Cache;
2 1     1   6589 use strict;
  1         2  
  1         35  
3 1     1   6 use warnings;
  1         2  
  1         691  
4             my $has_DMD5;
5             eval { require Digest::MD5 };
6             $has_DMD5 = 1 unless $@;
7             my $has_Storable;
8             eval { require Storable };
9             $has_Storable = 1 unless $@;
10            
11            
12             my $cache;
13             my $cache_file;
14             my $cache_dirty;
15            
16             sub prereq_missing{
17 9     9 0 23 my @missing;
18 9 50       27 push @missing, 'Digest::MD5' unless $has_DMD5;
19 9 50       20 push @missing, 'Storable' unless $has_Storable;
20 9         29 return @missing;
21             }
22            
23             sub init_from_file{
24 8     8 0 17 my $c_file = shift;
25 8 50       25 return 0 if prereq_missing();
26 8         20 eval{$cache = Storable::retrieve($c_file)};
  8         33  
27             #warn $@ if ($@);
28 8 100       1599 unless ($cache){
29 1         54 warn "Couldn't retrieve data from file $c_file. Building new cache.\n";
30 1         6 $cache = {};
31             }
32 8         23 $cache_file = $c_file;
33 8         29 return 1;
34             }
35            
36             sub store_cache{
37 8   33 8 0 28 my $c_file = shift || $cache_file;
38             # no need to store to the file we retrieved from
39             # unless we have seen changes written to the cache
40 8 50 33     22 return unless ($cache_dirty
41             || $c_file ne $cache_file);
42 8 50       30 Storable::nstore($cache, $c_file)
43             or warn "Could not store cache to file $c_file!";
44             }
45            
46             sub get_cache_cb{
47             return sub{
48 75     75   4648 my %args = @_;
49 75 100       230 if ( $args{action} eq 'read' ){
    100          
50 54         183 return _read_cache( %args );
51             }
52             elsif ( $args{action} eq 'write' ){
53 20         59 return _write_cache( %args );
54             }
55 1         9 die "action in cache_cb must be read or write!";
56 9     9 0 12832 };
57             }
58            
59             ### check for existence of the entry
60             ### check for identity of the file
61             ### pass cached value in $mod_aref
62             ### return true in case of a hit
63            
64             sub _read_cache{
65 54     54   150 my %args = @_;
66 54         130 my ($key, $file, $mod_aref) = @args{qw/key file modules/};
67 54 100       194 return 0 unless (exists $cache->{$key});
68 34         62 my $entry = $cache->{$key};
69 34         64 my $checksum = _file_2_md5($file);
70 34 100       118 if ($entry->{checksum} eq $checksum){
71 33         53 @$mod_aref = @{$entry->{modules}};
  33         88  
72 33         182 return 1;
73             }
74 1         7 return 0;
75             }
76            
77             sub _write_cache{
78 20     20   49 my %args = @_;
79 20         53 my ($key, $file, $mod_aref) = @args{qw/key file modules/};
80 20   50     89 my $entry = $cache->{$key} ||= {};
81 20         47 my $checksum = _file_2_md5($file);
82 20         60 $entry->{checksum} = $checksum;
83 20         56 $entry->{modules} = [@$mod_aref];
84 20         30 $cache_dirty = 1;
85 20         95 return 1;
86             }
87            
88             sub _file_2_md5{
89 54     54   85 my $file = shift;
90 54 50       2057 open my $fh, '<', $file or die "can't open $file: $!";
91 54         519 my $md5 = Digest::MD5->new;
92 54         926 $md5->addfile($fh);
93 54 50       609 close $fh or die "can't close $file: $!";
94 54         596 return $md5->hexdigest;
95             }
96             1;
97