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

EndFooter } #--------------------------------------------------------------------- # Page header. Include environment for debug. sub header { my ($where, $created, $expires, $bc) = @_; print <<"EndHeader"; Index of $where

$bc

EndHeader } #--------------------------------------------------------------------- # Accept file modification time, return nicely-formatted time. sub filetime { my $mt = shift; my ($hour, $mday, $min, $mon, $sec, $str, $year); my @names = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ); ($sec, $min, $hour, $mday, $mon, $year) = localtime($mt); $str = sprintf( "%2.2d-%s-%4.4d %2.2d:%2.2d", $mday, $names[$mon], $year + 1900, $hour, $min ); return ($str); } #--------------------------------------------------------------------- # Accept content type, return appropriate icon link. sub icon { my ($content) = @_; my ($t); if ($content eq "text/directory") { $t = '[DIR]'; } elsif ($content eq "text/html") { $t = '[WEB]'; } elsif ($content eq "text/plain") { $t = '[TXT]'; } elsif ($content eq "image/jpeg") { $t = '[JPG]'; } elsif ($content eq "image/gif") { $t = '[GIF]'; } elsif ($content eq "image/png") { $t = '[PNG]'; } elsif ($content eq "audio/wav") { $t = '[WAV]'; } elsif ($content eq "video/x-ms-wmv") { $t = '[WMV]'; } elsif ($content eq "text/x-chdr") { $t = '[H]'; } elsif ($content eq "text/x-csrc") { $t = '[C]'; } elsif ($content eq "application/x-perl") { $t = '[PERL]'; } else { $t = '[UNK]'; } return ($t); } #--------------------------------------------------------------------- # Encode spaces and other foolishness in filenames. # http://www.kluge.net/codesnippets/perl/URLEncode.html sub urlencode { my ($url) = @_; my (@characters) = split(/(\%[0-9a-fA-F]{2})/, $url); foreach (@characters) { if (/\%[0-9a-fA-F]{2}/) # Escaped character set ... { # IF it is in the range of 0x00-0x20 or 0x7f-0xff # or it is one of "<", ">", """, "#", "%", ";", # "/", "?", ":", "@", "=" or "&" # THEN preserve its encoding unless (/(20|7f|[0189a-fA-F][0-9a-fA-F])/i || /2[2356fF]|3[a-fA-F]|40/i) { s/\%([2-7][0-9a-fA-F])/sprintf "%c",hex($1)/e; } } else # Other stuff: 0x00-0x20, 0x7f-0xff, <, >, #, and "..." { s/([\000-\040\177-\377\074\076\042\043]) /sprintf "%%%02x",unpack("C",$1)/egx; } } return join("", @characters); }
  File Last modified Size Description