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