| Server IP : 127.0.1.1 / Your IP : 216.73.216.152 Web Server : Apache/2.4.52 (Ubuntu) System : Linux bahcrestlinepropertiesllc 5.15.0-113-generic #123-Ubuntu SMP Mon Jun 10 08:16:17 UTC 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.33 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : ON Directory : /proc/self/root/proc/2792866/cwd/usr/share/perl5/Module/ScanDeps/ |
Upload File : |
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;