#!/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.