$directoryDelimiter= "/"; $headerDelimiter= "<!-- site-dater.pl header -->\n";
$footerDelimiter= "<!-- site-dater.pl footer -->\n";
$dateTag= "#date"; $meTag= "#me"; $me= "<a href=" . "\"http://www.ayradyss.org/programs/"
. "past.html#site-dater\">site-dater.pl</a>";
push (@INC, 'pwd'); use Getopt::Long; require "ctime.pl";
GetOptions("c|configuration=s" => \$configFile,
"cgi|ssi" => \$cgi,
"d|dir|directory=s" => \$directory,
"l|links|followlinks" => \$links,
"r|rel|relative" => \$relative,
"q|quiet" => \$quiet,
"v|verbose" => \$verbose
);
&Initialize();
%list= (); &ScanDirectory($directory);
print "\n" if $verbose;
print("Finished scan.\n\n") unless $quiet;
print "Generating HTML code...\n\n" unless $quiet;
if (-f $outputFile)
{ &ScanOutputFile();
}
else
{ &SetDefaultHeader();
&SetDefaultFooter();
}
if ($cgi)
{ &GenerateOutput();
print $output;
}
else
{ &GenerateOutputFile();
}
print "Done.\n" unless $quiet;
exit;
sub Initialize
{
$configFile= ".site-dater" unless $configFile;
$directory= `pwd` unless $directory;
chop($directory) if $directory=~ /\n$/;
$directory.= "$directoryDelimiter"
unless $directory=~ /$directoryDelimiter$/;
$configFile= $directory.$configFile unless $configFile=~ /^$directoryDelimiter/;
$quiet= 1 if $cgi; $verbose= 0 if $cgi; $quiet= 0 if $verbose;
$now= time; $date= &ctime($now); chop($date);
print("Starting scan of <$directory> on $date...\n\n")
unless $quiet;
if (-f $configFile)
{ open(CONFIG, $configFile)
|| die "Cannot read configuration from <$configFile>";
while (<CONFIG>)
{ Directives:
{
$outputFile= $2, last Directives
if /^(OUTPUT=\s*)(.*)/;
$urlOffset= $2, last Directives
if /^(URLOFFSET=\s*)(.*)/;
@keep= split(/[ \t\n]+/, $2), last Directives
if /^(KEEP=\s*)(.*)/;
@skip= split(/[ \t\n]+/, $2), last Directives
if /^(SKIP=\s*)(.*)/;
$maxEntries= $2, last Directives
if /^(MAXENTRIES=\s*)(.*)/;
$minAge= $2, last Directives
if /^(MINAGE=\s*)(.*)/;
$table= $2, last Directives
if /^(TABLE=\s*)(.*)/;
$tablePageFont= $2, last Directives
if /^(PAGEFONT=\s*)(.*)/;
$tableDateFont= $2, last Directives
if /^(DATEFONT=\s*)(.*)/;
$tablePathFont= $2, last Directives
if /^(PATHFONT=\s*)(.*)/;
$tableTitleFont= $2, last Directives
if /^(TITLEFONT=\s*)(.*)/;
$tableHeadingFont= $2, last Directives
if /^(HEADINGFONT=\s*)(.*)/;
$tableFooterFont= $2, last Directives
if /^(FOOTERFONT=\s*)(.*)/;
$oneDayFont= $2, last Directives
if /^(ONEDAY=\s*)(.*)/;
$threeDayFont= $2, last Directives
if /^(THREEDAY=\s*)(.*)/;
$weekFont= $2, last Directives
if /^(WEEK=\s*)(.*)/;
$tableTitleBg= $2, last Directives
if /^(TITLEBG=\s*)(.*)/;
$tableHeadingBg= $2, last Directives
if /^(HEADINGBG=\s*)(.*)/;
@tableBg= split(/[ \t\n]+/, $2), last Directives
if /^(TABLEBG=\s*)(.*)/;
$tableFooterBg= $2, last Directives
if /^(FOOTERBG=\s*)(.*)/;
$tableTitle= $2, last Directives
if /^(TITLE=\s*)(.*)/;
$tableFooter= $2, last Directives
if /^(FOOTER=\s*)(.*)/;
}
}
close(CONFIG);
}
else
{
print "Did not find configuration directives; learning default settings.\n"
if $verbose;
}
$outputFile= "site-dater.html" unless $outputFile;
$outputFile= $directory.$outputFile unless $outputFile=~ /^$directoryDelimiter/;
if ($verbose)
{
print "outputFile= $outputFile\n";
print "Keep files matching: ", join(", ", @keep), "\n";
print "Skip files matching: ", join(", ", @skip), "\n";
if (defined($maxEntries))
{
if ($maxEntries == 1)
{ print "Only collecting one entry"; }
else
{ print "Only collecting $maxEntries entries"; }
if (defined($minAge))
{
if ($minAge == 1)
{ print ", yet all entries younger than a day" }
else
{ print ", yet all entries younger than $minAge days" }
}
print ".\n";
}
else
{
print "Collecting all entries.\n";
}
print "\n";
}
}
sub ScanDirectory
{
my($directory)= shift; my(@subDirectories)= (); my(@entries)= ();
opendir(DIR, $directory) || warn "Cannot scan $directory.";
@entries= readdir(DIR); closedir(DIR);
CheckEntries:
foreach $entry (@entries)
{ next if $entry eq '.'; next if $entry eq '..';
if (@skip)
{ foreach $pattern (@skip)
{
if ($entry=~ /$pattern/)
{
print "Skipping <$directory$entry>",
" due to matched pattern <$pattern>.\n" if $verbose;
next CheckEntries;
}
}
}
if ($links)
{ stat($directory.$entry); }
else
{ lstat($directory.$entry); next if -l _; }
if (-d _)
{ print "Descending into $directory$entry$directoryDelimiter...\n"
if $verbose;
&ScanDirectory($directory.$entry.$directoryDelimiter);
print "Returned from $directory$entry$directoryDelimiter.\n"
if $verbose;
next;
}
if (-T _)
{ if (@keep)
{ foreach $pattern (@keep)
{
if ($entry=~ /$pattern/)
{ $key= -M _; print "Found <$directory$entry>\n" if $verbose;
push(@{$list{$key}}, $directory.$entry);
}
}
}
else
{ $key= -M _; print "Found <$directory.$entry>\n" if $verbose;
push(@{$list{$key}}, $directory.$entry);
}
}
}
}
sub ScanOutputFile
{
open(TEMPLATE, $outputFile)
|| die "Cannot scan specified output file <$outputFile>";
$header= ""; while (<TEMPLATE>)
{ $header.= $_; last if (/$headerDelimiter/); }
while (<TEMPLATE>)
{ if (/$footerDelimiter/)
{ $footer= $footerDelimiter; last; }
}
while (<TEMPLATE>)
{ $footer.= $_; }
close(TEMPLATE);
&SetDefaultHeader unless $header=~ /$headerDelimiter$/;
&SetDefaultFooter unless $footer=~ /^$footerDelimiter/;
}
sub SetDefaultHeader
{
print "Using default header.\n" if $verbose;
$header= "<html>\n"
. "<head>\n"
. "<title>site-dater.pl</title>\n"
. "</head>\n"
. "\n"
. "<body>\n"
. $headerDelimiter;
}
sub SetDefaultFooter
{
print "Using default footer.\n" if $verbose;
$footer= $footerDelimiter
. "</body>\n"
. "</html>\n";
}
sub GenerateOutputFile
{
&GenerateOutput();
open(OUTPUT, ">$outputFile") || die "Cannot create an output file <$outputFile>";
print OUTPUT
$header, $output, $footer;
close(OUTPUT);
}
sub GenerateOutput
{
my($row)= 1;
$table= " $table" if $table;
$output= "<table".$table.">\n";
if ($tableTitle)
{ if ($tableTitleBg) { $bgColor= " bgcolor=\"$tableTitleBg\""; }
else { $bgColor= ""; }
if ($tableTitleFont)
{ $font= "<font $tableTitleFont>";
$terminator= "</font>";
}
else { $font= $terminator= ""; }
$output.= "<tr><td colSpan=\"3\"".$bgColor." align=\"center\">"
.$font.$tableTitle.$terminator."</td></tr>\n";
}
if ($tableHeadingBg) { $bgColor= " bgcolor=\"$tableHeadingBg\""; }
else { $bgColor= ""; }
if ($tableHeadingFont)
{ $font= "<font $tableHeadingFont>";
$terminator= "</font>";
}
else { $font= $terminator= ""; }
$output.= "<tr><td align=\"left\"".$bgColor.">".$font
." Title".$terminator."</td>"
."<td align=\"center\"".$bgColor.">".$font
."Date Modified".$terminator."</td>"
."<td align=\"left\"".$bgColor.">".$font
." Path".$terminator."</td></tr>\n";
for ($tableRowBg=0; $tableBg[$tableRowBg]; $tableRowBg++)
{ $tableBg[$tableRowBg]= " bgcolor=\"$tableBg[$tableRowBg]\"";
}
if ($tablePageFont)
{ $titlesFont= "<font $tablePageFont>";
$titlesTerminator= "</font>";
}
else { $titlesFont= $titlesTerminator= ""; }
if ($tableDateFont)
{ $datesFont= "<font $tableDateFont>";
$datesTerminator= "</font>";
}
else { $datesFont= $datesTerminator= ""; }
if ($oneDayFont)
{ $oneDayFont= "<font $oneDayFont>";
$oneDayTerminator= "</font>";
$oneDay= " $oneDayFont"."Within a day</font> ";
}
else { $oneDayFont= $oneDayTerminator= ""; }
if ($threeDayFont)
{ $threeDayFont= "<font $threeDayFont>";
$threeDayTerminator= "</font>";
$threeDay= " $threeDayFont"."Within three days</font> ";
}
else { $threeDayFont= $threeDayTerminator= ""; }
if ($weekFont)
{ $weekFont= "<font $weekFont>";
$weekTerminator= "</font>";
$week= " $weekFont"."Within a week</font> ";
}
else { $weekFont= $weekTerminator= ""; }
if ($tablePathFont)
{ $pathsFont= "<font $tablePathFont>";
$pathsTerminator= "</font>";
}
else { $pathsFont= $pathsTerminator= ""; }
foreach $entry (sort numerically (keys %list))
{
if (defined($maxEntries) && $row > $maxEntries)
{ if (!defined($minAge))
{ print "Row #$row: reached entries limit [$maxEntries].\n" if $verbose;
last;
}
elsif ($minAge < $entry)
{ print "Row #$row: reached entries limit [$maxEntries]",
" at entry aged $entry days.\n" if $verbose;
last;
}
}
print scalar(@{$list{$entry}}), " files with time stamp <$entry>;\n",
"\t @{$list{$entry}}\n"
if $verbose and @{$list{$entry}} > 1;
foreach $candidate (@{$list{$entry}})
{ next if $candidate eq $outputFile;
if ($candidate=~ /^$directory(.*)/)
{ $relativePath= $1;
}
else
{ $relativePath= ""; }
$title= &GetPageTitle($candidate);
print "Row #$row: grabbed title \"$title\" from <$candidate>\n"
if $verbose;
$url= "<a href=\"$urlOffset" . &FixSpecials($relativePath) . "\">$title</a>";
$modificationTime= &TimeStamp($entry);
$days= int($entry); if ($days < 1)
{
$modificationTime=
$oneDayFont.$modificationTime.$oneDayTerminator;
}
elsif ($days < 3)
{
$modificationTime=
$threeDayFont.$modificationTime.$threeDayTerminator;
}
elsif ($days < 7)
{
$modificationTime=
$weekFont.$modificationTime.$weekTerminator;
}
else
{
$modificationTime=
$datesFont.$modificationTime.$datesTerminator;
}
if (@tableBg)
{ $bgColor= $tableBg[$row % @tableBg];
}
else { $bgColor= ""; }
$output.= "<tr><td".$bgColor.">"
.$titlesFont.$url.$titlesTerminator."</td>"
."<td align=\"right\"".$bgColor.">".$modificationTime."</td>"
."<td".$bgColor.">".$pathsFont.$relativePath.$pathsTerminator
."</td></tr>\n";
$row++; }
}
if ($tableHeadingBg) { $bgColor= " bgcolor=\"$tableHeadingBg\""; }
else { $bgColor= ""; }
if ($oneDay || $threeDay || $week)
{ if ($tableHeadingFont)
{ $font= "<font $tableHeadingFont>" ;
$terminator= "</font>";
}
else { $font= $terminator= ""; }
$legend= $font."Age color legend: ".$terminator;
$legend.= " [$oneDay] " if $oneDay;
$legend.= " [$threeDay] " if $threeDay;
$legend.= " [$week] " if $week;
$output.= "<tr><td colSpan=\"3\" align=\"center\"".$bgColor.">"
.$legend."</td></tr>\n";
}
if ($tableFooter)
{ $tableFooter=~ s/$dateTag/$date/; $tableFooter=~ s/$meTag/$me/;
if ($tableFooterBg) { $bgColor= " bgcolor=\"$tableFooterBg\""; }
else { $bgColor= ""; }
if ($tableFooterFont)
{ $font= "<font $tableFooterFont>";
$terminator= "</font>";
}
else { $font= $terminator= ""; }
$output.= "<tr><td colSpan=\"3\"".$bgColor." align=\"center\">"
.$font.$tableFooter.$terminator."</td></tr>\n";
}
$output.= "</table>\n"; }
sub GetPageTitle
{
$path= shift;
open(INPUT, $path) || die "Cannot read <$path>";
while (<INPUT>)
{ if (/<title>(.+)<\/title>/
|| /<TITLE>(.+)<\/TITLE>/
|| /<Title>(.+)<\/Title>/)
{ close(INPUT);
return $1;
}
}
close(INPUT);
print "Failed to find a title within <$path>\n" if $verbose;
return "[no title]"; }
sub TimeStamp
{
my($daysElapsed)= shift; my($amPmLabel); my($weekDay); my($absoluteDate);
unless ($relative)
{ $absoluteDate= &ctime($now-$daysElapsed * 60 * 60 * 24);
chop($absoluteDate); return $absoluteDate;
}
my($eSecond, $eMinute, $eHour, $eMDay, $eMon, $eYear,
$eWeekDay, $eYearDay, $eIsDST)=
localtime($now-$daysElapsed * 60 * 60 * 24);
my($nSecond, $nMinute, $nHour, $nMDay, $nMon, $nYear,
$nWeekDay, $nYearDay, $nIsDST)=
localtime($now);
$daysElapsed= int($daysElapsed); if ($daysElapsed < 1)
{ $eMinute= "0" . $eMinute if $eMinute < 10;
if ($eHour > 12)
{ $amPmLabel= "pm";
$eHour-= 12;
}
else
{ $amPmLabel= "am";
$eHour= 12 if $eHour == 0; }
if ($eMDay == $nMDay)
{ return "Today at $eHour:$eMinute" . $amPmLabel;
}
else
{ return "Yesterday at $eHour:$eMinute" . $amPmLabel;
}
}
elsif ($daysElapsed < 2)
{ if ($eMDay == ($nMDay - 1) )
{ $eMinute= "0" . $eMinute if $eMinute < 10;
if ($eHour > 12)
{ $amPmLabel= "pm";
$eHour-= 12;
}
else
{ $amPmLabel= "am";
$eHour= 12 if $eHour == 0; }
return "Yesterday at $eHour:$eMinute" . $amPmLabel;
}
else
{ $weekDay= (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday)
[$eWeekDay];
return "last $weekDay";
}
}
elsif ($daysElapsed < 7)
{ $weekDay= (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday)
[$eWeekDay];
return "last $weekDay";
}
else
{ my($date)= ($eMon + 1) . "/$eMDay/" . (1900 + $eYear) . " ";
return $date;
}
}
sub FixSpecials
{
my($string)= shift;
print "Original: $string\n" if $verbose;
$string=~ s/%/%25/g; $string=~ s/ /%20/g; $string=~ s/\"/%22/g; $string=~ s/\</%3C/g; $string=~ s/\>/%3E/g; $string=~ s/\#/%23/g; $string=~ s/\{/%7B/g; $string=~ s/\}/%7D/g; $string=~ s/\|/%7C/g; $string=~ s/\\/%5C/g; $string=~ s/\^/%5E/g; $string=~ s/\~/%7E/g; $string=~ s/\[/%5B/g; $string=~ s/\]/%5D/g; $string=~ s/\`/%60/g;
print "Filtered: $string\n" if $verbose;
return $string;
}
sub numerically { $a <=> $b; }