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