Listing 1. rotate.fcg Script
#!/usr/bin/perl -w
# rotate.fcg -- a script to rotate sponsor ads.
use FCGI;
# The QUERY_STRING is expected to be the name of
# an HTML file in the following directory
my $DOCROOT = "/path/to/files";
# Scope the array that we'll use throughout
# the life of the script.
my @ads = (); # array of ads
# Initialize the %ENV hash so it's not empty...
while (my($key, $val) = each %ENV) { next }
# Force flush after each 'print()'
$| = 1;
# Initialize the array of ads
@ads = initialize();
#
# Now the main show
REQUEST: while (FCGI::accept() >= 0) {
# Catch valid requests to reinitialize
if ($ENV{QUERY_STRING} eq 'reload' and
$ENV{REMOTE_ADDR} =~ /^127\.0\.0/)
{
@ads = initialize();
next REQUEST;
}
# Make sure we can open the file. If not, tell
# the user and wait for the next REQUEST.
unless (open(DOC, "$DOCROOT/$ENV{QUERY_STRING}"))
{
file_not_found();
next REQUEST;
}
# Put file into an array, where we can do some
# text substitutions.
my @doc = <DOC>;
close DOC;
# Get first $ad in line, then move it to the
# back.
$ad = shift @ads;
push @ads, $ad;
# Look for '<!-- Ad Here -->' and put one
# there while sending @doc off.
print
"Content-type: text/html",
"\r\n\r\n",
map { s/<!--\s*Ad\s+Here\s*-->/$ad/i } @doc;
}
# ----- Initialization subroutine -----
sub initialize {
my @ads = ();
# Set the input record separator to null
# because we rely on multi-line records
$/ = "";
# If we can't find the data file, we'll page
# the admin and return an empty array; the
# script will still be able to function.
unless (open(SPONSORS, "/pathto/sponsors.txt"))
{
page_sysadmin();
return ();
}
foreach my $entry (<SPONSORS>) {
# Put the data into a hash for easy
# lookup.
my %sponsor = ();
foreach my $datum (split(/\n/, $entry)) {
my ($key, $val) = split(/=/, $datum, 2);
$key = lc $key; # just in case
$sponsor{$key} = $val;
}
# Format the ad in HTML and push it into
# @ads.
push @ads, join( '',
qq(<A HREF="$sponsor{url}">),
qq(<IMG SRC="$sponsor{image}" ),
qq(ALT="$sponsor{description}" ),
qq(WIDTH=$sponsor{width} ),
qq(HEIGHT=$sponsor{height} ),
qq(BORDER=$sponsor{border}>),
qq(</A>)
);
}
# Clean up after ourselves.
close SPONSORS;
$/ = "\n";
return @ads;
}
# Other functions would follow.