#!/usr/bin/perl -w
#
# $Id: idxcache2html,v 1.10+10 2008/03/03 23:06:07 vogelke Exp $
#
# tag.
# s3: keep the remaining directories for the breadcrumbs, i.e.
# "Home / one / two / three", *unless* URL has been passed in.
$cache = dirname($cache); # s1
my $where = basename($cache); # s2
my $bc = breadcrumbs(length($url) ? $url : $cache); # s3
# Print the HTML header, title, breadcrumbs, and table start.
header($where, $created, $expires, $bc);
# Print the listed files.
my ($bytes, $class, $f, $ftime, $img, $mt, $size, $t);
my $kbyte = 1024;
my $mbyte = $kbyte * $kbyte;
my $count = 0;
my @a = ();
foreach (sort @str) {
my ($ftype, $finfo) = split (/\t/);
foreach (split(/\&/, $finfo)) {
$f = $1 if /^file=\s*(.*)/;
$t = $1 if /^title=\s*(.*)/;
}
next if $f =~ /^index.html*$/;
$t = '' if $t =~ /^File /;
# Get file size.
($bytes, $mt) = (stat("$cache/$f"))[7, 9];
if ($bytes >= $mbyte) {
$size = sprintf("%.1f", $bytes/$mbyte) . 'M';
}
elsif ($bytes >= $kbyte && $bytes < $mbyte) {
$size = int($bytes / $kbyte) . 'k';
}
elsif ($bytes < 512) {
$size = $bytes;
}
else {
$size = '1k';
}
$size = sprintf("%4s", $size);
# Get file type.
$ftime = filetime($mt);
$img = icon($ftype);
# Print the table entry.
$count++;
$class = $count % 2 ? '' : 'class="dark"';
$url = urlencode($f);
print <<"EndEntry";
$img |
$f |
$ftime |
$size |
$t |
EndEntry
}
# Print the footer.
footer();
exit(0);
#---------------------------------------------------------------------
# Escape non-HTML-safe characters.
sub htmlsafe {
my $text = $_[0];
return undef unless defined $text;
# do it in this order, or you get lots of &...
$text =~ s/\&/&/g;
$text =~ s/>/>/g;
$text =~ s/</g;
$text;
}
#---------------------------------------------------------------------
# Return the current version.
sub version {
my $VERSION = sprintf("%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/);
my $DATE =
sprintf("%s", q$Date: 2008/03/03 23:06:07 $ =~ /Date: (.*) /);
return "$myname $VERSION $DATE";
}
#---------------------------------------------------------------------
# Accept an optional date in total seconds since the epoch,
# and return it in HTTP Created/Expires format:
# Wed, 20 Jan 2010 02:14:57 GMT
sub gmdate {
use POSIX qw(strftime);
my $t = shift || time();
return strftime("%a, %d %b %Y %T GMT", gmtime($t));
}
#---------------------------------------------------------------------
# Accept an optional date in total seconds since the epoch,
# and write it in ARPA-mail standard form:
# Fri, 28 Mar 1997 15:40:57 -0500
sub arpadate {
use POSIX qw(strftime);
my $t = shift || time();
return strftime("%a, %d %b %Y %T %z", localtime($t));
}
#---------------------------------------------------------------------
# Create breadcrumbs link to a given page.
# Stolen from Blosxom Plugin: breadcrumbs
# Expects full path to document being displayed,
# including document root, or a URL.
# Relative path will assume starting point at the document root.
sub breadcrumbs {
use Cwd;
my ($path, $p, @p);
# Accept an argument, or use the current directory.
$_ = shift;
$_ = getcwd() if $_ eq '.';
# What divider should I use between path components?
my $divider = " /\n ";
# Strip the document root or homepage if either is present.
my $docroot = '/doc/html/htdocs';
my $homepage = 'http://example.com';
s!^$docroot/!!;
s!^$homepage/!!;
# Get started, then walk the path.
push @p, 'myhost';
$path = $_;
foreach (split /\//, $path) {
$p .= "/$_";
push @p, qq{$_};
}
return join $divider, @p;
}
#---------------------------------------------------------------------
# Store the cache file contents.
# Each array entry is: content-type entry.
sub storecache {
my @a = ();
my $fh;
open($fh, "< $cache") || die "$cache: $!\n";
while (<$fh>) {
next unless /^file=/;
chomp;
m/content=(.*?)[;&]/ && push(@a, "$1\t$_");
}
close($fh);
return (@a);
}
#---------------------------------------------------------------------
# Return file modification time.
sub modtime {
my $path = shift || die;
my $mt = (stat($path))[9];
die unless defined($mt);
return $mt;
}
#---------------------------------------------------------------------
# Page footer.
sub footer {
my @v = split(/\s+/, version());
my $adate = arpadate();
print <<"EndFooter";