#! /usr/bin/perl -wT ############################################################################## # nms Random Image Displayer Version 1.11 # # Copyright 2001 London Perl Mongers All rights reserved # # Created 11/11/01 Last Modified # # Matt's Script Archive: http://www.scriptarchive.com/ # ############################################################################## # nms Random Image Displayer has been created as a drop in replacement for # # the Random Image Displayer found at Matt's Script Archive. Both the # # original and nms versions of this script can be found at the above URL. # # Support for nms Random Image Displayer is available through: # # nms-cgi-support@lists.sourceforge.net # ############################################################################## # # $Id: rand_image.pl,v 1.11 2002/10/21 19:37:36 nickjc Exp $ # use strict; use CGI qw(redirect header); use Fcntl qw(:DEFAULT :flock); use vars qw($DEBUGGING $done_headers); # Configuration # # $DEBUGGING must be set in a BEGIN block in order to have it be set before # the program is fully compiled. # This should almost certainly be set to 0 when the program is 'live' # BEGIN { $DEBUGGING = 1; } # If this is set to 1 then the program will issue a redirect to the image # and $baseurl must be the beginning of the URI where the images reside. # This might not work on all browsers. # If it is set to 0 then the program will send the image to the browser # directly (which is more costly for the server) in which case $basedir # must be the full system path to the directory where the image files are. # It might be necessary to add new extenstion => content type pairs to # the %content_type below if you are using file extenstions that are not # among the defaults. my $use_redirect = 0; my $baseurl = 'http://ichs.digitalrazor.com/themes/headstart/images/site/rotated2/'; my $basedir = '/domains/indianacountyheadstart.org/docs/themes/headstart/images/site/rotated2/'; # Your image files here. my @files = qw( 134x163.jpg 130x101.jpg 131x190.jpg 132x199.jpg 133x191.jpg ); my $uselog = 0; # 1 = YES; 0 = NO my $logfile = '/path/to/piclog'; # End configuration # Might need to add to content types mapping extensions my %content_types = ( jpg => 'image/jpeg', gif => 'image/gif', png => 'image/png' ); # We need finer control over what gets to the browser and the CGI::Carp # set_message() is not available everywhere :( # This is basically the same as what CGI::Carp does inside but simplified # for our purposes here. BEGIN { sub fatalsToBrowser { my ( $message ) = @_; if ( $DEBUGGING ) { $message =~ s//>/g; } else { $message = ''; } my ( $pack, $file, $line, $sub ) = caller(0); my ($id ) = $file =~ m%([^/]+)$%; return undef if $file =~ /^\(eval/; print "Content-Type: text/html\n\n" unless $done_headers; print < Error

Application Error

An error has occurred in the program

$message

EOERR die @_; }; $SIG{__DIE__} = \&fatalsToBrowser; } my $pic = $files[rand @files]; # Log Image if ($uselog) { sysopen (LOG, $logfile, O_RDWR|O_APPEND|O_CREAT) or die "Can't open logfile: $!\n"; flock(LOG, LOCK_EX) or die "Can't lock logfile: $!\n"; print LOG "$pic\n"; close (LOG) or die "Can't close logfile: $!\n"; } if ( $use_redirect ) { if ( $baseurl !~ m%/$% ) { $baseurl .= '/'; } print redirect("$baseurl$pic"); $done_headers++; } else { if ( $basedir !~ m%/$% ) { $basedir .= '/'; } my ( $extension ) = $pic =~ /\.(\S+)$/; my $ctype = $content_types{$extension} || 'image/png'; open INFILE, "<$basedir$pic" or die "Can't open $basedir$pic - $!"; binmode INFILE; local $/; my $image = ; close INFILE; print header(-type => $ctype), $image; }