This one seems to come up a lot in Seekers, so I thought I'd drop a simple script in here.

Although this script displays a random image from a specified directory, the principle should be adaptable to any image display code... basically, use a "Location:" redirect... It's worth noting that the version given here depends on the image directory being a sub-directory of the script's location. On most servers, this won't be the case, and you would probably have to manipulate the location parameter to account for this.

...And, as merlyn has pointed out, any implementation of this snippet will probably break at least one standard, or just plain not work, so I've provided two more standard-compliant (but longer) alternatives.

Non-standard-compliant version (and with probable caching):

#!/usr/bin/perl -wT
use strict;

# Call in img tag - e.g.: <img src="randimage.cgi" border="2">
my @files = glob("./jpegs/*.jpg");
print "Location: $files[int(rand @files)]\n\n";

[download]

Standard-compliant version (short, but with potential caching of images):

#!/usr/bin/perl -wT
use strict;
use URI;
my @files = glob("./images/*");
my $file = URI->new_abs($files[int(rand @files)], "http://bugzilla");
print "Status: 307 Temporary redirect\n";
print "Location: $file\n\n";

[download]
<updated>

Standard-compliant version (long - no caching problems):

#!/usr/bin/perl -wT
use strict;

# types where extension <> content-type
my %types = qw(jpg jpeg tif tiff);

# get an array of image-files
my @images = glob("./images/*");
die "No images found\n" unless scalar @images;

# choose an image and and prepare content type extension
my $image = $images[int(rand @images)];
die "No extension for $image\n" unless $image =~ /\.(.+)$/;
my $ctype = $1;
$ctype = $types{$ctype} if exists $types{$ctype};

# read and  print image
open(IMG, $image)||die "Cannot open $image:$!\n";
print "Content-type: image/$ctype\n\n";
binmode (IMG);
binmode (STDOUT);
print while(<IMG>);
close IMG;

[download]
</updated>

Replies are listed 'Best First'.
Re: How to quickly display an image on a webpage via perl
by merlyn (Sage) on Nov 08, 2006 at 04:35 UTC
    This works only if you are using extension-based MIME detection, not path-based MIME detection (like ScriptAlias), because the .jpg files would be interpreted as CGI scripts instead.

    Also, relative "Location:" headers are strongly frowned upon. If a current browser gets it right, it's because it's error-correcting for you.

    -- Randal L. Schwartz, Perl hacker
    Be sure to read my standard disclaimer if this is a reply.

[reply]

      Ah - many thanks. Err, any suggestion of a better, quick, way to do it? (pretty please)

      Tom Melly, tom@tomandlu.co.uk
[reply]
Re: How to display an image on a webpage with minimal code
by bart (Canon) on Nov 15, 2006 at 12:28 UTC
    merlyn's comment about the Location header is spot on, the RFC says that a Location header should use an absolute URI. That's no disaster, with the module URI (that comes with LWP, AFAICT, thus, I think, most perl installs should have it — at least, Bundle::LWP lists it), you can solve several problems at once, such as not having to have the images under the current directory (perhaps even chdir to it before you glob, if you have to). For example: 
    use URI;
print URI->new_abs('../images/t-rex.jpg', 'http://www.example.com/home
+/');

    [download]
    produces:
    http://www.example.com/images/t-rex.jpg

    You must have noticed another problem with redirection: caching. The browser thinks, because that's what the server told it, that the location of the image is permanently moved to the URL it got back once. So next time, the browser won't ask again.

    You can remedy that, at least on HTTP1.1, with a "moved temporarily" status header, status code 307. That way, next time, the browser will repeat the request.

    You might have to find other solutions for browsers that only understand pre-1.1 HTTP, if those still exist.

[reply]
[d/l]
[select]

      Hmm, URI works v. nicely, but Ihad some problems implementing a 307.

      My code was: 

      print "HTTP/1.1 307 temporary redirect\n";
print "Location: " . URI->new_abs($files[int(rand @files)], "http://bu
+gzilla") . "\n\n";

      [download]

      But this didn't redirect me unless I removed the 307 line...

      Tom Melly, tom@tomandlu.co.uk
[reply]
[d/l]
        n.b. I finally got around to test this. Hence the belated reply.

        Wow, hold it, you're doing this too low level. You're not supposed to be doing this the NPH way, there's still a webserver between the CGI scripts and the web browser, and that one is still postprocessing the headers that the CGI script sent to it — for example, adding a content-length header for plain pages. And there's a special pseudo-header for status codes: Status:.

        When I did this on Apache 2 on my laptop: 

        print "Status: 307 Temporary redirect\n";
print "Location: " . URI->new_abs($files[int(rand @files)], "http://lo
+calhost/") . "\n\n";

        [download]
        then the headers that Live HTTP Headers displayed were: 
        HTTP/1.x 307 Temporary redirect
Date: Thu, 16 Nov 2006 19:55:06 GMT
Server: Apache/2.0.50 (Win32) mod_perl/1.99_16 Perl/v5.8.8 PHP/4.3.8
Location: http://localhost/images/060210-leaf.jpg
Content-Length: 0
Keep-Alive: timeout=15, max=100
Connection: Keep-Alive
Content-Type: text/plain; charset=ISO-8859-1

        [download]
        So the headers that got sent to the browser, are looking fine to me.
[reply]
[d/l]
[select]

Back to Cool Uses for Perl