use strict;
$SIG{__DIE__} = \&Carp::confess;
my @dbms = qw( MLDBM::Sync::SDBM_File DB_File GDBM_File );
my $dbm_ok;
for my $dbm ( @dbms ) {
eval "use $dbm";
if(! $@) {
$dbm_ok = $dbm;
# print STDERR $dbm_ok."\n";
last;
}
}
return unless $dbm_ok;
&Apache::ASP::CGI::do_self(
CacheSize => '1K', # auto cleanup after test
CacheDB => $dbm_ok,
UseStrict => 1,
NoState => 1,
# Debug => -3,
# CacheDir can be set separately from StateDir
StateDir => '.state',
CacheDir => '.cache',
);
__END__
<%
my $asp = $Server->{asp};
my $cache_lock = ".cache/cache/Response.lock";
my $reset_cache_counts = sub { map { $asp->{'cache_count_'.$_} = 0 }
qw( fetch miss store expires last_modified_expires )
};
my $check_cache_counts = sub {
my($error, %args) = @_;
for my $key ( keys %args ) {
my $asp_key = 'cache_count_'.$key;
$t->eok($asp->{$asp_key} == $args{$key},
"$error cache test: $asp_key is $asp->{$asp_key}, should be $args{$key}"
);
}
};
my $out_length = 2000;
my $script = qq[<\%\=
"1234" x 500
%\>];
# BASIC
for(1..3) {
my $out = $Response->TrapInclude({
File => \$script,
Cache => 1,
Expires => 3600,
LastModified => time()-10,
Key => $0,
});
$t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
}
&$check_cache_counts("BASIC", fetch => 2, miss => 1, store => 1);
&$reset_cache_counts;
$t->eok(-e $cache_lock, "Cache lock test");
# EXPIRES PAST
for(1..3) {
my $out = $Response->TrapInclude({
File => \$script,
Cache => 1,
Expires => -1,
Key => $0,
});
$t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
}
&$check_cache_counts("EXPIRES", expires => 3, store => 3);
&$reset_cache_counts;
# EXPIRES FUTURE, first is new, second should be cached, third should expire
for(1..3) {
my $out = $Response->TrapInclude({
File => \$script,
Cache => 1,
Expires => 2,
Key => [ 'EXPIRES FUTURE' ],
});
if($_ == 2) { sleep 2; };
$t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
};
&$check_cache_counts("EXPIRES FUTURE", miss => 1, fetch => 1, expires => 1, store => 2);
&$reset_cache_counts;
# LAST MODIFIED EXPIRE/CACHE
for my $last_modified ( time + 10, Apache::ASP::Date::time2str(time + 10), time-10, Apache::ASP::Date::time2str(time-10) ) {
my $out = $Response->TrapInclude({
File => \$script,
Cache => 1,
Key => [ 'EXPIRES FUTURE' ],
LastModified => $last_modified,
});
$t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
}
&$check_cache_counts("LAST MODIFED EXPIRES", last_modified_expires => 2, store => 2, fetch => 2);
&$reset_cache_counts;
# CLEAR
for (1,0,1,0,1) {
my $out = $Response->TrapInclude({
File => \$script,
Cache => 1,
Key => [ 'EXPIRES FUTURE' ],
Clear => $_,
});
$t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
}
&$check_cache_counts("CLEAR", store => 3, fetch => 2);
&$reset_cache_counts;
# KEY
for (1,0,1,0,1) {
my $out = $Response->TrapInclude({
File => \$script,
Cache => 1,
Key => { 'KEY TEST' => $_ },
});
$t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
}
&$check_cache_counts("CLEAR", miss => 2, store => 2, fetch => 3);
&$reset_cache_counts;
# NORMAL + RV
for my $arg (1,0,1,0,1,0,1) {
my @rv = $Response->Include({
File => 'cache_test.inc',
Cache => 1,
}, $arg, $arg);
$Response->Debug("return values from cached include: ",@rv);
$t->eok((grep($_ eq $arg, @rv)) == 2, "Return values from caching include");
my $out = $Response->{BinaryRef};
$$out =~ s/\s+//isg;
$t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
$Response->Clear;
}
&$check_cache_counts("CLEAR", miss => 2, store => 2, fetch => 5);
&$reset_cache_counts;
# KEY CHECK 2
for my $arg ({ arg => 1 }, { arg => 1 }, { arg => 1 }, { arg => 2 }) {
my @rv = $Response->Include({
File => 'cache_test.inc',
Cache => 1,
Key => $arg
}, $arg );
my $out = $Response->{BinaryRef};
$$out =~ s/\s+//isg;
$t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
$Response->Clear;
}
&$check_cache_counts("CLEAR", miss => 2, store => 2, fetch => 2);
&$reset_cache_counts;
$asp->{r}->register_cleanup(sub { -e $cache_lock && die("cache lock $cache_lock still exists after cleanup") });
%>