LJ Archive

Listing 1. print-label.pl

#!/usr/bin/perl -w
# print-label.pl
# Prints a "new" label in red for 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 an appropriate MIME header
print $query->header("text/html");
# 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;
# Get the creation and modification dates
my $ctime = -M $filename;
# If it was created recently, print such a label
if ($ctime < 7)
{
    # Indicate that it is a new file
    print "<font color=\"red\">(New!)</font>\n";
}

LJ Archive