On Sun, Aug 23, 2009 at 6:47 PM, boll <b...@sonic.net> wrote:

> There is a perl program running on my server  that delivers random images
> to a web page.
> The image on the html page is specified by this html code:
>
>    <img src="http://localhost/cgi/random_image.cgi"/>
>
> I would like to use this program in several places to display images from
> other directories,
> so that one URL might display a random image from the 'vegetables'
> directory,
> and a different URL would call the same program but display an image from
> the 'fruits' directory.
>
> Here's where I'm requesting help-
> I don't understand how to pass the name of the image directory in the URL,
> or how to modify the program to read the directory name.
>
> Here is the program, written to call images from the 'specials' directory:
>
> #! /usr/bin/perl -wT
> #
> # $Id: rand_image.pl,v 1.11 2002/10/21 19:37:36 nickjc Exp $
> #Modified from http://nms-cgi.sourceforge.net
>
> use strict;
> use CGI qw(redirect header);
> use Fcntl qw(:DEFAULT :flock);
> use vars qw($DEBUGGING $done_headers);
>
> # Configuration
>
> # ==================== DEBUGGING: ===================
> BEGIN
> {
> $DEBUGGING = 1;
> }
>
> my $use_redirect = 1; #Use redirect and baseurl on server & localhost
> version.
> my $baseurl = 'http://localhost/specials/';
> my $basedir = '/my-domain.com/specials/';
>
> # =========== image files here: ====================
>
> open LIST, "specials_img_list.txt" #must exist in cgi directory
> or die "Image List filehandle not open: $!\n";
> my @files = <LIST>; #images (thumbs).
>
> # =============== LOGGING: ==================
> my $uselog = 1; # 1 = YES; 0 = NO
> my $logfile = 'randimages.log';
>
> # ================ End configuration.
>
> my %content_types = (
> jpg => 'image/jpeg',
> gif => 'image/gif',
> png => 'image/png'
> );
>
>
> # =================== ERRORS: ==================
>
> BEGIN
> {
> sub fatalsToBrowser
> {
> my ( $message ) = @_;
>
> if ( $DEBUGGING )
> {
> $message =~ s/</&lt;/g;
> $message =~ s/>/&gt;/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 <<EOERR;
> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
> "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd";>
> <html xmlns="http://www.w3.org/1999/xhtml";>
> <head>
> <title>Error</title>
> </head>
> <body>
> <h1>Application Error</h1>
> <p>
> An error has occurred in the program
> </p>
> <p>
> $message
> </p>
> </body>
> </html>
> EOERR
> die @_;
> };
>
> $SIG{__DIE__} = \&fatalsToBrowser;
> }
>
>
> # =============== IMAGE FILE NAME: =======================
>
> my $pic = '';
> while ($pic !~ m/\w+/){
> $pic = $files[rand @files];
> chomp $pic;
> }
>
>
> # Log Image
> if ($uselog) {
> sysopen (LOG, $logfile, O_RDWR|O_APPEND|O_CREAT)
> or die "Can NOT open logfile: $!\n";
> flock(LOG, LOCK_EX)
> or die "Can't lock logfile: $!\n";
> #print LOG "LOG FILE OPENED \n";
> #print LOG "$baseurl$pic\n";
> }
>
> if ( $use_redirect )
> {
> if ( $baseurl !~ m%/$% )
> {
> $baseurl .= '/';
> }
> print LOG qq[specials: redirect("$baseurl$pic")\n];
> 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 = <INFILE>;
> close INFILE;
>
> print header(-type => $ctype),
> $image;
> print LOG "$baseurl$pic\n";
> }
> close (LOG)
> or die "Can't close logfile: $!\n";
>
>
> --
> To unsubscribe, e-mail: beginners-unsubscr...@perl.org
> For additional commands, e-mail: beginners-h...@perl.org
> http://learn.perl.org/
>
>
>
As mentioned before the easiest way is to simply put in your own parameters.
With the <url of CGI script>?key1=value1&key2=value2 or even simpler by
simply doing something like <url of CGI script>?key and check for the value
of the key with your script having the intelligence to see the presence of
the key (even if no value is defined for it) and based on it's presence
return a random file from a certain directory.

So you would have a tag like: <img src="
http://localhost/cgi/random_image.cgi?fruit"/>
and your script will find what key is there:

my @fieldnames = param();
my $type = $fieldnames[0];

That way your variable $type will contain "fruit" and with that I am sure
you can simply figure out how to load a list of URL's related to "fruit" and
pick a random one from that list. Of course you might want to check the
value in $type first to make sure that you get clean data and only data that
you expected.
So first check to make sure you only get actual characters and nothing else:
if ( $type !~ /^\w*$/ ) die "Got some none letter characters";

Then make sure that the word you get is in your list of possible options by
compairing $type with a hash of possible options (or in what ever other way
you like of course it is Perl after all):
unless ( defined $options{ $type } ) die "Option $type does not exist in my
list";

That should pretty much cover it. Oh and don't use die in your CGI scripts
;-) it makes for such nasty to find bugs (The CGI module offers other more
graceful error reporting which will make it much easier for you to identify
why a script faild to produce the expected result)

Regards,

Rob

Reply via email to