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');
