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;


Reply via email to