Michael Peters wrote: > no_cache() should work (or at least it has for me in the past when IE > has given me similar headaches). > That's odd. no_cache should not be sending the 'Expires' header. > Instead it uses the more forceful 'Pragma: no-cache' and > 'Cache-control: no-cache'. These are not showing up in your headers. > The only thing I can think of is that no_cache(1) is not being > executed?
I added some debug logging to see headers_out() before and after calling no_cache(1). no_cache(1) appears to be setting the specified headers and internal_redirect() appears to be ignoring them. Any suggestions? TIA, David -- ####################################################################### # $Id: RandomPicture.pm,v 1.6 2005/07/06 00:56:53 dpchrist Exp $ # # Redirect to random picture per [1] pp. 123-128. # # Copyright 2005 by David Christensen <[EMAIL PROTECTED]> # # References: # # [1] Lincoln Stein & Doug MacEachern, 1999, "Wring Apache Modules # with Perl and C", O'Reilly, ISBN 1-56592-567-X. ####################################################################### # Apache::NavBar package: #---------------------------------------------------------------------- package Apache::RandomPicture; ####################################################################### # uses: #---------------------------------------------------------------------- use strict; use warnings; use Apache::Constants qw(:common REDIRECT DOCUMENT_FOLLOWS); use Data::Dumper; use DirHandle; $Data::Dumper::Indent = 0; ####################################################################### # package globals: #---------------------------------------------------------------------- our $debug = 1; our $picturedir_directive = 'PictureDir'; ####################################################################### # subroutines: #---------------------------------------------------------------------- sub handler { $_[0]->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), Data::Dumper->Dump([EMAIL PROTECTED], [qw(*_)])) if $debug; my $r = shift; my $retval = DECLINED; ##### pessimistic execution my $dir_uri = $r->dir_config($picturedir_directive); unless ($dir_uri) { $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), "unable to find Apache configuration directive ", "'$picturedir_directive'"); goto done; } $dir_uri .= '/' unless $dir_uri =~ m:/$:; $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), Data::Dumper->Dump([$dir_uri], [qw(dir_uri)])) if $debug; my $subr = $r->lookup_uri($dir_uri); my $dir = $subr->filename; $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), Data::Dumper->Dump([$dir], [qw(dir)])) if $debug; my $dh = DirHandle->new($dir); unless ($dh) { $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), "unable to read directory '$dir': $!"); goto done; } my @files; for my $entry ($dh->read) { my $rr = $subr->lookup_uri($entry); my $type = $rr->content_type; next unless $type =~ m:^image/:; push @files, $rr->uri; } $dh->close; unless (scalar @files) { $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), "no image files found in directory '$dir'"); goto done; } $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), Data::Dumper->Dump([EMAIL PROTECTED], [qw(*files)])) if $debug; my $lucky_one = $files[rand scalar @files]; $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), Data::Dumper->Dump([$lucky_one], [qw(lucky_one)])) if $debug; my $lucky_uri = $r->lookup_uri($lucky_one); unless ($lucky_uri->status == DOCUMENT_FOLLOWS) { $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), "error looking up URI '$lucky_one'"); goto done; } $r->content_type($lucky_uri->content_type); if ($r->header_only) { $r->send_http_header; } else { my %headers_out = %{$r->headers_out}; $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), "calling no_cache(1)...", Data::Dumper->Dump([\%headers_out], [qw(*headers_out)])); my @no_cache = $r->no_cache(1); %headers_out = %{$r->headers_out}; $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), "no_cache(1) returned ", Data::Dumper->Dump([EMAIL PROTECTED], [qw(*no_cache)]), Data::Dumper->Dump([\%headers_out], [qw(*headers_out)])); $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), "redirecting to '$lucky_one'"); $r->internal_redirect($lucky_one); } $retval = OK; done: $r->log_error(sprintf("%s (%s %s): ", (caller(0))[3], __FILE__, __LINE__), Data::Dumper->Dump([$retval], [qw(retval)])) if $debug; return $retval; } ####################################################################### # end of code: #---------------------------------------------------------------------- 1; __END__ ####################################################################### [EMAIL PROTECTED]:~$ wget -s -nv http://192.168.254.3/random/picture 18:01:48 URL:http://192.168.254.3/random/picture [32752/32752] -> "pictu re.4" [1] [EMAIL PROTECTED]:~$ head -n 12 picture.4 HTTP/1.1 200 OK Date: Wed, 06 Jul 2005 01:01:10 GMT Server: Apache/1.3.33 (Debian GNU/Linux) mod_perl/1.29 Last-Modified: Wed, 04 Jun 2003 06:53:10 GMT ETag: "1064a-7ff0-3edd9756;42c4b3fd" Accept-Ranges: bytes Content-Length: 32752 Keep-Alive: timeout=15, max=100 Connection: Keep-Alive Content-Type: image/jpeg Expires: Wed, 06 Jul 2005 01:01:10 GMT [EMAIL PROTECTED]:~# tail -n 8 /var/log/apache-perl/error.log | grep no_cache [Tue Jul 5 18:01:10 2005] [error] Apache::RandomPicture::handler (/home /dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 117): calling no_c ache(1)...%headers_out = (); [Tue Jul 5 18:01:10 2005] [error] Apache::RandomPicture::handler (/home /dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 123): no_cache(1) returned @no_cache = (0);%headers_out = ('Cache-control' => 'no-cache',' Pragma' => 'no-cache');