my
$has_DMD5
;
$has_DMD5
= 1
unless
$@;
my
$has_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
)};
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
;
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!"
;
};
}
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;