perl-modperl mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "David Christensen" <dpchr...@holgerdanske.com>
Subject Eagle book RandPicture.pm, $r->internal_redirect, and IE 6.0 showing same image every time
Date Fri, 01 Jul 2005 01:23:13 GMT
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

root@p166v:~# 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 <dpchrist@holgerdanske.com>
#
# 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([\@_], [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([\@files], [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):

root@p166v:~# 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;



Mime
View raw message