Listing 2. print-label.pl with Cookie Check

#!/usr/bin/perl -w
# print-label.pl
# Prints a "new" label in red on any file that 
# is more than one week old
use strict;
use diagnostics;
use CGI;
# Make output hot
$| = 1;
# Create an instance of CGI
my $query = new CGI;
# Print a basic MIME header
print $query->header;
# Under what directory is our Web tree?
my $docroot = '/usr/local/apache/share/htdocs/';
# Get the filename
my $filename = $docroot . $query->param("keywords");
exit unless $filename;
# Make sure the file exists
exit unless -e $filename;
# If the cookie exists, then the user visited 
# within the last week, so we should not print
# any "new" label. If the cookie does not exist,
# then print the label.
my $visited_recently = $query->cookie('RecentVisitor');
# These are useful when debugging
# print "<P>visited_recently = \"$visited_recently\"</P>\n";
# print "<P>raw = ", $query->raw_cookie, "</P>\n";
if (!$visited_recently)
{
    # Indicate that the file is new
    print "<font color=\"red\">(New!)</font>\n";
}