modperl:
I'm a mod_perl newbie working my way through the Eagle book
(http://www.modperl.com/), and have implemented RandPicture.pm per pp. 126-127.
Everything works as expected using $r->header_out(Location => $lucky_one) and
REDIRECT, and also using the $subr->run optimization per p. 128.
When I implement the $r->internal_redirect optimization per p. 129 (see source
code, below), IE 6.0 displays the same image every time, even though
RandPicture.pm seems to be selecting different images (see debugging information
in error log, below).
I have tried clearing the browser's cache and turning caching off, but the issue
remains.
Any suggestions?
TIA,
David
--
host: Debian 3.1r0
[EMAIL PROTECTED]:~# apt-cache showpkg apache-perl
Package: apache-perl
Versions:
1.3.33-6(/var/lib/apt/lists/ftp.us.debian.org_debian_dists_stable_main_binary-i3
86_Packages)(/var/lib/dpkg/status)
Reverse Depends:
zoph,apache-perl
webmin-virtual-server,apache-perl
webmin-apache,apache-perl
slash,apache-perl
scoop,apache-perl
request-tracker3.4,apache-perl
request-tracker3,apache-perl
piwi,apache-perl
phpmyadmin,apache-perl
phpix,apache-perl
otrs,apache-perl
opendb,apache-perl
myphpmoney,apache-perl 1.3.29.0.1-1
mantis,apache-perl 1.3.29.0.2-2
lxr-cvs,apache-perl
libmasonx-request-withapachesession-perl,apache-perl
libhtml-mason-perl-examples,apache-perl
libhtml-embperl-perl,apache-perl 1.3.14
libapache-reload-perl,apache-perl
libapache-mod-ssl,apache-perl
libapache-mod-jk,apache-perl
libapache-mod-encoding,apache-perl
libapache-mod-auth-radius,apache-perl
libapache-db-perl,apache-perl
libapache-authensmb,apache-perl
irm,apache-perl
ilohamail,apache-perl
gforge-web-apache,apache-perl 1.3.29.0.1-1
gforge-lists-mailman,apache-perl 1.3.9
gforge-cvs,apache-perl 1.3.9
gallery,apache-perl
fibusql,apache-perl 1.3.29.0.1-1
eskuel,apache-perl
egroupware-core,apache-perl 1.3.29.0.1
drupal,apache-perl
diatheke,apache-perl
cacti,apache-perl
bugzilla,apache-perl
backuppc,apache-perl
axyl,apache-perl 1.3
apache-doc,apache-perl
apache-dev,apache-perl
apache-dbg,apache-perl
apache-common,apache-perl
Dependencies:
1.3.33-6 - libc6 (2 2.3.2.ds1-21) libdb4.2 (0 (null)) libexpat1 (2 1.95.8)
libperl5.8 (2 5.8.4) mime-support (0 (null)) apache-common (2 1.3.33-6)
apache-common (3 1.3.34-0) libapache-mod-perl (2 1.29.0.2-9) libapache-mod-perl
(3 1.30) debconf (0 (null)) dpkg (4 1.9.0) libmagic1 (0 (null)) logrotate (2
3.5.4-1) apache-doc (0 (null)) apache-modules (0 (null)) jserv (1 1.1-3)
Provides:
1.3.33-6 - httpd httpd-cgi
Reverse Provides:
perl.conf:
<Location /random/picture>
SetHandler perl-script
PerlHandler Apache::RandomPicture
PerlSetVar PictureDir /images
</Location>
RandomPicture.pm:
#######################################################################
# $Id: RandomPicture.pm,v 1.3 2005/06/30 03:52:18 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 {
$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__
#######################################################################
apache-perl error log sample after browsing to
http://192.168.254.3/random/picture, hitting refreshing, going back, and
browsing again (2075_1.jpg was displayed all three times):
[EMAIL PROTECTED]:~# tail -n 22 /var/log/apache-perl/error.log
[Thu Jun 30 18:10:29 2005] [notice] SIGUSR1 received. Doing graceful restart
[Thu Jun 30 18:10:33 2005] CGI.pm: Constant subroutine CGI::XHTML_DTD redefined
at /usr/share/perl/5.8/constant.pm line 108.
[Thu Jun 30 18:10:33 2005] [notice] Apache/1.3.33 (Debian GNU/Linux)
mod_perl/1.29 configured -- resuming normal operations
[Thu Jun 30 18:10:33 2005] [notice] Accept mutex: sysvsem (Default: sysvsem)
[Thu Jun 30 18:10:37 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 46): @_ = (bless(
do{\\(my $o = 139092700)}, 'Apache' ));
[Thu Jun 30 18:10:37 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 63): $dir_uri =
'/images/';
[Thu Jun 30 18:10:37 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 69): $dir =
'/home/dpchrist/eagle-book/images';
[Thu Jun 30 18:10:37 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 94): @files =
('/images/2075_1.jpg','/images/2075_2.jpg','/images/2075_3.jpg','/images/2075_4.
jpg');
[Thu Jun 30 18:10:37 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 99): $lucky_one =
'/images/2075_1.jpg';
[Thu Jun 30 18:10:38 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 122): $retval = 0;
[Thu Jun 30 18:10:39 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 46): @_ = (bless(
do{\\(my $o = 139092700)}, 'Apache' ));
[Thu Jun 30 18:10:39 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 63): $dir_uri =
'/images/';
[Thu Jun 30 18:10:39 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 69): $dir =
'/home/dpchrist/eagle-book/images';
[Thu Jun 30 18:10:39 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 94): @files =
('/images/2075_1.jpg','/images/2075_2.jpg','/images/2075_3.jpg','/images/2075_4.
jpg');
[Thu Jun 30 18:10:39 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 99): $lucky_one =
'/images/2075_3.jpg';
[Thu Jun 30 18:10:39 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 122): $retval = 0;
[Thu Jun 30 18:10:42 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 46): @_ = (bless(
do{\\(my $o = 139092700)}, 'Apache' ));
[Thu Jun 30 18:10:42 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 63): $dir_uri =
'/images/';
[Thu Jun 30 18:10:42 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 69): $dir =
'/home/dpchrist/eagle-book/images';
[Thu Jun 30 18:10:42 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 94): @files =
('/images/2075_1.jpg','/images/2075_2.jpg','/images/2075_3.jpg','/images/2075_4.
jpg');
[Thu Jun 30 18:10:42 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 99): $lucky_one =
'/images/2075_2.jpg';
[Thu Jun 30 18:10:43 2005] [error] Apache::RandomPicture::handler
(/home/dpchrist/eagle-book/lib/perl/Apache/RandomPicture.pm 122): $retval = 0;
