Cache-Static
view release on metacpan or search on metacpan
lib/Cache/Static.pm view on Meta::CPAN
elsif(lc($c) eq 'h') { $mult = 60 * 60; }
elsif(lc($c) eq 'm') { $mult = 60; }
elsif(lc($c) eq 's') { $mult = 1; }
else {
_log(2, "Cache::Static::get_seconds_from_timespec: unknown multiplier in $arg: $c");
return undef;
}
$period += $n * $mult;
$i += 2;
}
return $period;
}
sub _find_bound_before_time {
my ($time, $offset, $bound) = @_;
#valid bounds: [HMDW]
my @lt = localtime($time);
my ($roffset, $interval);
#this would be much nicer with switch/case, grumble.
if($bound eq 'M') {
$roffset = $lt[0];
$interval = 60;
} elsif($bound eq 'H') {
$roffset = $lt[0] + $lt[1] * 60;
$interval = 60 * 60;
} elsif($bound eq 'D') {
$roffset = $lt[0] + $lt[1] * 60 + $lt[2] * 60 * 60;
$interval = 24 * 60 * 60;
} elsif($bound eq 'W') {
$roffset = $lt[0] + $lt[1] * 60 + $lt[2] * 60 * 60 +
$lt[6] * 24 * 60 * 60;
$interval = 7 * 24 * 60 * 60;
} else {
_log(2, "Cache::Static::_find_bound_before_time: unknown time boundary: $bound");
return undef;
}
if($offset > $interval) {
_log(2, "Cache::Static::_find_bound_before_time: offset ($offset) > interval ($interval)");
return undef;
}
return $offset + $time - $roffset - ($roffset > $offset ? 0 : $interval);
}
sub _is_same {
my ($key, $depsref, %args) = @_;
my $ns = $args{namespace} || $namespace;
_die_if_invalid_namespace($ns);
#if no deps argument, find what we've got saved on disk for deps
unless($depsref) {
open(F, "$ROOT/$ns/cache/$key.dep");
my $deps_str = <F>;
close(F);
my @deps = split(/\0/, $deps_str);
$depsref = \@deps;
_log(4, "Cache::Static::_is_same: got ".($#deps+1)." deps for $key");
}
#get last modified time of the cached version, or 0 if it doesn't exist
my @t = stat("$ROOT/$ns/cache/$key");
my $request_modtime = @t ? $t[9] : 0;
return (0, "(not yet cached)") unless($request_modtime);
# give a chance to add any module specific extra deps
my %extra_deps;
### TODO: this is too slow, at least for XML::Comma (0.02 sec on p4@3GHz)
# foreach my $dep (@$depsref) {
# my ($type, $spec) = split(/\|/, $dep, 2);
# my $dep_modtime;
# if($type =~ /^_/) {
# #not a builtin - call an extension
# my ($module, $type, $spec) = split(/\|/, $dep, 3);
# $module =~ s/^_//;
# $module =~ s/\:\:/_/g;
# my @deps = eval
# "Cache::Static::${module}_Util::get_extra_deps(\"$type\", \"$spec\")";
# foreach my $d (@deps) {
# $extra_deps{$d} = 1 unless($extra_deps{$d});
# }
# }
# }
my @deps = (@$depsref, keys %extra_deps);
my @TRUE = ($key,1);
foreach my $dep (@deps) {
my @FALSE = (0,$dep);
my ($full_type, $spec) = split(/\|/, $dep, 2);
_log(4, "full_type: $full_type, spec: $spec");
my ($type, $modifier) = split(/-/, $full_type, 2);
if(defined($modifier)) {
_log(4, "modifier found: full_type: $full_type, type: $type, modifier: $modifier");
}
my $dep_modtime;
if($type =~ /^_/) {
#not a builtin - call an extension
my ($module, $type, $spec) = split(/\|/, $dep, 3);
$module =~ s/^_//;
$module =~ s/\:\:/_/g;
_log(4, "here we are, extension, module: $module, type: $type spec: $spec");
$dep_modtime = eval "Cache::Static::${module}_Util::modtime(\"$type\", \"$spec\")";
if($@) {
_log(3, "error calling Cache::Static::${module}_Util::modtime(\"$type\", \"$spec\"): $@");
} elsif(!$dep_modtime) {
_log(4, "got non-true value from Cache::Static::${module}_Util::modtime(\"$type\", \"$spec\"): $@ $!");
}
} elsif ($type eq 'file') {
_log(4, "here we are, file spec: $spec");
my @t = stat($spec);
$dep_modtime = $t[9];
} elsif ($type eq 'time') {
my $spec_regex = '([0-9]*[hmdsw])+([0-9]*)?';
if ($spec =~ /^[0-9]{10}$/) {
#one-time timestamp expiration
$dep_modtime = $spec;
} elsif ($spec =~ /^$spec_regex$/) {
#5w4d3h2m1s, e.g. 5 weeks, 4 days, ...
#this is a bit backwards: now - spec > time of modification
my $sex = get_seconds_from_timespec($spec);
return @FALSE unless(defined($sex));
$dep_modtime = time - $sex;
} elsif ($spec =~ /^[HMDW]:$spec_regex$/) {
#cron-esque timespecs, e.g. {week|day|hour|min} boundary + $spec
#or 3:57 on day 3 of the week (W:3d3h57m)
# bound_before(now)+offset <=> request time
my ($bound, $offset) = split(/:/, $spec);
my $sex = get_seconds_from_timespec($offset);
return @FALSE unless(defined($sex));
$dep_modtime = _find_bound_before_time(time,
$sex, $bound);
return @FALSE unless(defined($dep_modtime));
} else {
_log(2, "Cache::Static: unrecognized time spec: ($spec), regenerating");
return @FALSE;
}
} elsif ($type eq 'HIT') {
return @TRUE;
} elsif ($type eq 'MISS') {
return @FALSE;
} else {
my $ret = _get_conf($ns, 'unrecognized_dependency_returns');
_log(2, "Cache::Static: unrecognized dependency ($type)".
($ret ? ", serving anyway" : ", regenerating").
" as specified by conf option unrecognized_dependency_returns");
return ($ret ? @TRUE : @FALSE);
}
#always override the default if modifier exists
my $bool = defined($modifier) ? $modifier :
_get_conf($ns, 'dep_file_not_found_returns');
return ($bool ? @TRUE : @FALSE) unless($dep_modtime);
return @FALSE if($dep_modtime > $request_modtime);
}
return @TRUE;
}
sub _get_conf {
my ($ns, $var) = @_;
_readconf("$ns") unless(defined($CONF{$ns}));
return $CONF{$ns}->{$var} || $CONF{DEFAULT}->{$var};
}
#TODO: this whole function is a race condition...
#is doing a regenerate if there was a change since _is_same best?
#or should we try to save the version we thought we were gonna use?
sub _get {
my ($key, %args) = @_;
my $ns = $args{namespace} || $namespace;
_die_if_invalid_namespace($ns);
( run in 0.930 second using v1.01-cache-2.11-cpan-39bf76dae61 )