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 )