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

Reply via email to