1
2use Apache::ASP::CGI;
3use strict;
4$SIG{__DIE__} = \&Carp::confess;
5
6my @dbms = qw( MLDBM::Sync::SDBM_File DB_File GDBM_File );
7my $dbm_ok;
8for my $dbm ( @dbms ) {
9    eval "use $dbm";
10    if(! $@) {
11	$dbm_ok = $dbm;
12#	print STDERR $dbm_ok."\n";
13	last;
14    }
15}
16return unless $dbm_ok;
17
18&Apache::ASP::CGI::do_self(
19			   CacheSize => '1K',  # auto cleanup after test
20			   CacheDB => $dbm_ok,
21			   UseStrict => 1,
22			   NoState => 1,
23#			   Debug => -3,
24			   # CacheDir can be set separately from StateDir
25			   StateDir => '.state',
26			   CacheDir => '.cache',
27);
28
29__END__
30
31<%
32my $asp = $Server->{asp};
33my $cache_lock = ".cache/cache/Response.lock";
34
35my $reset_cache_counts = sub { map { $asp->{'cache_count_'.$_} = 0 }
36			       qw( fetch miss store expires last_modified_expires )
37			       };
38my $check_cache_counts = sub {
39    my($error, %args) = @_;
40    for my $key ( keys %args ) {
41	my $asp_key = 'cache_count_'.$key;
42	$t->eok($asp->{$asp_key} == $args{$key},
43		"$error cache test: $asp_key is $asp->{$asp_key}, should be $args{$key}"
44		);
45
46    }
47};
48
49my $out_length = 2000;
50my $script = qq[<\%\=
51		"1234" x 500
52		%\>];
53
54# BASIC
55for(1..3) {
56    my $out = $Response->TrapInclude({
57	File => \$script,
58	Cache => 1,
59	Expires => 3600,
60	LastModified => time()-10,
61	Key => $0,
62    });
63    $t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
64}
65
66&$check_cache_counts("BASIC", fetch => 2, miss => 1, store => 1);
67&$reset_cache_counts;
68
69$t->eok(-e $cache_lock, "Cache lock test");
70
71# EXPIRES PAST
72for(1..3) {
73    my $out = $Response->TrapInclude({
74	File => \$script,
75	Cache => 1,
76	Expires => -1,
77	Key => $0,
78    });
79    $t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
80}
81&$check_cache_counts("EXPIRES", expires => 3, store => 3);
82&$reset_cache_counts;
83
84# EXPIRES FUTURE, first is new, second should be cached, third should expire
85for(1..3) {
86    my $out = $Response->TrapInclude({
87	File => \$script,
88	Cache => 1,
89	Expires => 2,
90	Key => [ 'EXPIRES FUTURE' ],
91    });
92    if($_ == 2) { sleep 2; };
93    $t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
94};
95&$check_cache_counts("EXPIRES FUTURE", miss => 1, fetch => 1, expires => 1, store => 2);
96&$reset_cache_counts;
97
98# LAST MODIFIED EXPIRE/CACHE
99for my $last_modified ( time + 10, Apache::ASP::Date::time2str(time + 10), time-10, Apache::ASP::Date::time2str(time-10) ) {
100    my $out = $Response->TrapInclude({
101	File => \$script,
102	Cache => 1,
103	Key => [ 'EXPIRES FUTURE' ],
104	LastModified => $last_modified,
105    });
106    $t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
107}
108&$check_cache_counts("LAST MODIFED EXPIRES", last_modified_expires => 2, store => 2, fetch => 2);
109&$reset_cache_counts;
110
111# CLEAR
112for (1,0,1,0,1) {
113    my $out = $Response->TrapInclude({
114	File => \$script,
115	Cache => 1,
116	Key => [ 'EXPIRES FUTURE' ],
117	Clear => $_,
118    });
119    $t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
120}
121&$check_cache_counts("CLEAR", store => 3, fetch => 2);
122&$reset_cache_counts;
123
124# KEY
125for (1,0,1,0,1) {
126    my $out = $Response->TrapInclude({
127	File => \$script,
128	Cache => 1,
129	Key => { 'KEY TEST' => $_ },
130    });
131    $t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
132}
133&$check_cache_counts("CLEAR", miss => 2, store => 2, fetch => 3);
134&$reset_cache_counts;
135
136# NORMAL + RV
137for my $arg (1,0,1,0,1,0,1) {
138    my @rv = $Response->Include({
139	File => 'cache_test.inc',
140	Cache => 1,
141    }, $arg, $arg);
142    $Response->Debug("return values from cached include: ",@rv);
143    $t->eok((grep($_ eq $arg, @rv)) == 2, "Return values from caching include");
144    my $out = $Response->{BinaryRef};
145    $$out =~ s/\s+//isg;
146    $t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
147    $Response->Clear;
148}
149&$check_cache_counts("CLEAR", miss => 2, store => 2, fetch => 5);
150&$reset_cache_counts;
151
152# KEY CHECK 2
153for my $arg ({ arg => 1 }, { arg => 1 }, { arg => 1 }, { arg => 2 }) {
154    my @rv = $Response->Include({
155	File => 'cache_test.inc',
156	Cache => 1,
157	Key => $arg
158	}, $arg );
159    my $out = $Response->{BinaryRef};
160    $$out =~ s/\s+//isg;
161    $t->eok(length($$out) == $out_length, "Output length from include should be $out_length, found: ".length($$out));
162    $Response->Clear;
163}
164&$check_cache_counts("CLEAR", miss => 2, store => 2, fetch => 2);
165&$reset_cache_counts;
166
167$asp->{r}->register_cleanup(sub { -e $cache_lock && die("cache lock $cache_lock still exists after cleanup") });
168
169%>
170
171
172