Listing 2: Second Version of Apache::TagNew
package Apache::TagNew;
use strict;
use Apache::Constants qw(OK DECLINED NOT_FOUND);
sub handler
{
# Get the Apache request object
my $r = shift;
# Only handle text/html files
return DECLINED unless ($r->content_type
eq "text/html");
# Get the file we're trying to send
if (open(FILE, $r->filename))
{
# Send an appropriate MIME header
$r->send_http_header;
# Slurp up files at once
undef $/;
# Grab the file's contents
my ($contents) = (<FILE>);
# Tag hyperlinks as new
$contents =~
s|<a\s+href=['"]?(\S+?)['"]?\s*>([\s\S]+?)</a>
|label_url($r, $1, $2)|eigx;
# Print the contents
$r->print($contents);
# Close the file handle
close FILE;
# Indicate that all went well
return OK;
}
# produce an appropriate error message
else
{
return NOT_FOUND;
}
}
# Subroutine for tagging URLs
sub label_url
{
# Get the URL and the text
my $r = shift;
my $url = shift;
my $text = shift;
my $label;
# If the URL does not begin with "https://",
#then we can assume it
# is on our system
if ($url !~ m|^https://|)
{
# Check the modification date of the file
my $filename = $r->document_root . $url;
my $ctime = -M $filename;
if ($ctime < 7)
{
$label = "<font color=\"red\">New!</font>";
}
}
# Return a value to the caller
return "<a href=\"$url\">$text</a> $label";
}
1;