@lay:3473l2

Listing 2: print-label.pl

#!/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";
}

