LJ Archive

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.
LJ Archive