<%init>
my $hide_files = qr(images|lib|robots.txt|favicon.ico|thumbnail|dhandler|autohandler|.+\.footer);
my $index_files = qr!^index\.([xpms]?html?|php[34]?|stm|cgi|pl)$!;
my $icons_dir = 'lib/icons'; # Usually 'icons';
my @icon_size = qw(16 16);
my @column_sizes = qw(80 55 23 17);
my $type_text = 'extension'; # Use "extension" or "mimetype" (default is extension)
#my $date_format = '%a %b %e %H:%M:%S %Y'; # %d/%m/%Y %R # %a %b %e %H:%M:%S %Y
my $date_format = '%d/%m/%Y %R'; # %d/%m/%Y %R # %a %b %e %H:%M:%S %Y
</%init>
<%doc>
# vim:ts=4:sw=4:tw=78
=pod
=head1 NAME
dhandler - XHTML 1.1 Strict Compliant Directory Listing DHandler
=head1 VERSION
$Revision: 1.3 $
=head1 AUTHOR
Nicola Elizabeth Worthington <nicolaworthington@msn.com>
http://www.nicolaworthington.com
$Author: nicolaw $
=cut
</%doc>
<%filter>
s,^([^/]),\t\t\t$1,mg;
s,^/,,mg;
</%filter>
<%method dhIndexCSS>\
<style type="text/css">
div.dhIndex {
font-family: Tahoma, sans-serif;
font-size: 8pt;
}
div.dhIndex img {
margin-bottom: 1px;
vertical-align: middle;
border: 0px;
width: 16px;
height: 16px;
}
div.dhIndex a {
position: relative;
}
div.dhIndex a span {
display: none;
}
div.dhIndex a:hover span {
display: block;
background: #ffffe1;
border: 1px #000000 solid;
padding: 7px 7px 7px 7px;
position: absolute;
top: 7px;
left: 30px;
z-index: 1;
width: 210px;
filter:alpha(opacity=50);
-moz-opacity:0.5;
opacity: 0.5;
}
div.dhIndex a, div.dhIndex a:visited {
color: #000000;
text-decoration: none;
white-space: nowrap;
}
div.dhIndex img.denied {
filter:alpha(opacity=50);
-moz-opacity:0.5;
opacity: 0.5;
}
div.dhIndex a:hover {
text-decoration: underline;
}
</style>\
</%method>
<table cellspacing="0" cellpadding="0" border="0">
<tr>
<td align="left" valign="top">
<div class="dhIndex">
% for (my $i = 0; $i < @raw; $i++) {
% my $file = $raw[$i];
% my $fileInfoTooltip = genFileInfo($file,$format,$type_text,$ft,$date_format);
% (my $fileInfoStatusbar = $fileInfoTooltip) =~ s/<br \/>/ /g;
<a href="<% $file |u %><% (-d "$dir/$file" ? '/' : '') %>">\
<img src="/<% $icons_dir %>/<% file2icon("$dir/$file",$index) %>.gif" width="<% $icon_size[0] %>" height="<% $icon_size[1] %>" alt="<% $file |h %>" <% checkPerms("$dir/$file") %>/></a>\
<a href="<% $file |u %><% (-d "$dir/$file" ? '/' : '') %>" onmouseover="window.status='<% $fileInfoStatusbar %>'; return true" onmouseout="window.status='';return true"><% $file |h %><span><% $fileInfoTooltip %></span></a><br />
% if ($columns > 1 && ($i+1) % $itemsPerColumn == 0 && @raw > 10) {
</div>
</td>
<td style="width: 50px;"> </td>
<td align="left" valign="top">
<div class="dhIndex">
% }
% }
</div>
</td>
</tr>
</table>\
<%init>
(my $uri = $r->uri) =~ s,^/,,;
(my $uri_file = $uri) =~ s,.*/,,;
my $path_info = $r->path_info;
my $dhandler_arg = $m->dhandler_arg;
my $dir = sprintf('%s/%s',$r->document_root,$dhandler_arg);
# Ensure directory URLs always have a trailing slash
if (-d $dir && $r->uri !~ m/\/$/) {
my $s = $r->server;
$m->clear_buffer;
$m->redirect(sprintf('http://%s%s/', $s->server_hostname, $r->uri));
}
# Decline to handle the location (or redirect) if we cannot open the directory
unless (-d $dir && chdir $dir && opendir(DH,$dir)) {
my $s = $r->server;
$m->clear_buffer;
$m->redirect(sprintf('http://%s', $s->server_hostname));
}
# Read the dorectory contents
my @raw = grep(!/^(\.\.?([^\.].*)?|$hide_files|$uri_file)$/,readdir(DH));
closedir(DH) || warn "Unable to close directory '$dir': $!";
# Redirect to any readable index files if they exist instead of doing a listing
if (my @indexes = grep(/$index_files/,@raw)) {
for my $index (@indexes) {
next unless -r "$dir/$index";
$m->clear_buffer;
$m->redirect($index);
}
}
$r->content_type('text/html');
my (@dirs,@files);
for (@raw) {
if (-d "$dir/$_") { push @dirs,$_ }
else { push @files,$_ }
}
@dirs = sort {lc $a cmp lc $b} @dirs;
@files = sort {lc $a cmp lc $b} @files;
unshift @dirs, '..' if $uri !~ m|^/?$|;
@raw = (@dirs,@files);
my ($columns, $maxFilenameLength) = (1,0);
for (@raw) { $maxFilenameLength = length($_) if length($_) > $maxFilenameLength; }
for my $threshold (@column_sizes) {
$columns++ if $maxFilenameLength <= $threshold;
}
my $itemsPerColumn = @raw % $columns ? int(@raw/$columns)+1 : @raw/$columns;
my $index = {};
if (opendir(DH,sprintf('%s/%s',$r->document_root,$icons_dir))) {
foreach my $icon (grep(/^[a-z0-9]+\.(png|gif)$/i,readdir(DH))) {
(my $ext = $icon) =~ s/\..+$//;
$index->{$ext} = $ext;
}
closedir(DH);
}
similar_icons: {
my $similar = {
xsl => [ qw(xml xslt) ],
htm => [ qw(html shtml) ],
ra => [ qw(rm ram) ],
zip => [ qw(tgz tar gz bz2 arj lhz rar) ],
xls => [ qw(csv tab) ],
};
for my $icon (keys %{$similar}) {
for my $ext (@{$similar->{$icon}}) {
$index->{$ext} = $icon unless exists $index->{$ext};
}
}
}
if (open(FH,sprintf('%s/%s/extensions.map',$r->document_root,$icons_dir))) {
while (<FH>) { next if /^\s*#/;
if (/^(\S+)\s+(\S+)\s*$/) {
$index->{$1} = $2;
}
}
close(FH);
}
my $ft;
if (lc($type_text) eq 'mimetype') {
eval { require File::Type; };
$ft = new File::Type;
}
my $format = new Number::Format();
sub checkPerms {
my $file = shift;
if (!-r $file || (-d $file && !-x $file)) {
return ' class="denied" ';
}
return '';
}
sub genFileInfo {
my ($file,$format,$type_text,$ft,$date_format) = @_;
(my $ext = $file) =~ s/.*\.//;
my $size = $format->format_bytes(-s $file,2).'B';
$size =~ s/([A-Z]+)/ $1/;
my $output = sprintf("Type: %s<br />Date Modified: %s<br />Size: %s",
(-d $file ? 'Directory' :
(lc($type_text) eq 'mimetype' ? $ft->checktype_filename($file) :
uc($ext).' File')),
Date::Format::time2str($date_format, (stat($file))[9]),
$size
);
return $output;
}
sub file2icon {
my ($file,$index) = @_;
#my $icon = -d $file ? (-x $file ? '__dir' : '__dir_nox') : (-r $file ? '__unknown' : '__broken');
my $icon = -d $file ? '__dir' : '__unknown'; # We now have proper fading of icons
$icon = '__broken' if -l $file && !-e readlink($file);
$icon = '__back' if $file =~ m/\.\.$/;
if (-d $file) {
if ($file =~ m|/My Pictures$|i) { $icon = '__my_pictures'; }
elsif ($file =~ m|/My Videos$|i) { $icon = '__my_videos'; }
elsif ($file =~ m|/My Documents$|i) { $icon = '__my_documents'; }
elsif ($file =~ m|/My Music$|i) { $icon = '__my_music'; }
}
(my $ext = lc($file)) =~ s/.*\.//;
$icon = $index->{$ext} if exists $index->{$ext};
return $icon;
}
</%init>
<%once>
require Number::Format;
require Date::Format;
</%once>