#!/usr/local/bin/perl
use strict;
=head1 NAME
piclist - Making List of Pictures in a Directory
=cut
my $dir = $main::ENV{PATH_TRANSLATED}
or die "BAD PATH_TRANSLATED: $ENV{PATH_TRANSLATED}";
my %Opt;
if ($dir =~ s#/[^/]+$##) {
for (split /[&;]/, $ENV{QUERY_STRING}) {
my ($name, $val) = split /=/, $_, 2;
$Opt{$name} = defined $val ? $val : 1;
}
} else {
die "BAD PATH_TRANSLATED: $ENV{PATH_TRANSLATED}";
}
sub escape ($) {
my $s = shift;
$s =~ s/&/&/g;
$s =~ s//>/g;
$s =~ s/"/"/g;
$s =~ s/'/'/g;
$s;
}
sub rfc3339date ($) {
my @gt = gmtime shift;
sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ',
$gt[5] + 1900, $gt[4] + 1, @gt[3, 2, 1, 0];
}
sub filesize ($) {
my $size = 0 + shift;
if ($size > 2048) {
$size /= 1024;
if ($size > 2048) {
$size /= 1024;
sprintf '%.1f メガオクテット', $size;
} else {
sprintf '%.1f キロオクテット', $size;
}
} else {
$size . ' オクテット';
}
}
my $dirpath = escape $ENV{REQUEST_URI};
$dirpath =~ s/\#.*$//;
$dirpath =~ s/\?.*$//;
$dirpath =~ s/,[^,]*$//g;
unless (-d $dir) {
$dir =~ s#/+[^/]+$##;
$dirpath =~ s#/[^/]+$#/#;
$dirpath ||= '/';
} else {
$dirpath =~ s#/LIST$##;
$dirpath =~ s#/?$#/#;
}
opendir DIR, $dir or die "$dir: $!";
my @all_files = sort grep {not /^\./ and /^[A-Za-z0-9._-]+$/}
(readdir DIR)[0..1000];
close DIR;
my @files = grep {/\.(?:jpe?g|png|ico|gif|mng|xbm|JPE?G)(?:\.gz)?$/} @all_files;
my @dirs = grep {$_ ne 'CVS' and -d $dir.'/'.$_} @all_files;
sub has_file ($) {
my $name = shift;
my $namelen = 1 + length $name;
for (@all_files) {
if ($name.'.' eq substr $_, 0, $namelen) {
return 1;
}
}
return 0;
}
sub preview_uri ($) {
my $original_file_name = shift;
$original_file_name =~ s/\..*$//;
my $file_name = $original_file_name;
if ($file_name =~ /-small$/) {
return $file_name;
} else {
$file_name =~ s/-large$//;
if (has_file $file_name . '-small') {
return $file_name . '-small';
} elsif (has_file $file_name) {
return $file_name;
} else {
return $original_file_name;
}
}
}
my $title = '画像一覧';
print STDOUT "Content-Type: text/html; charset=euc-jp\n\n";
my $linkelement = '';
$| = '';
print <
@{[$Opt{cframe} ? '' : qq<$dirpath の>]}${title}
${linkelement}
EOH
my $LISTq = q<>;
$LISTq .= q<;detail> if $Opt{detail};
$LISTq = substr $LISTq, 1;
$LISTq = 'LIST' . ($LISTq ? '?' . $LISTq : '');
if ($Opt{cframe}) {
my $LISTqt = ($LISTq eq 'LIST' ? $LISTq . '?' : $LISTq . ';') . 'target=view';
print qq{} if $Opt{cframe};
print q{};
1;
__END__
=head1 CHANGES
2005-02-26 Wakaba
- Frame mode implemented.
2005-02-25 Wakaba
- Use external style sheet.
- Detail mode implemented.
2001-06-25 Wakaba
- In default, images are sized by stylesheet. When ?realsize=1,
images are not specified its size.
- Images are linked to itself.
2001-05-17 Wakaba
- New File.
=head1 LICENSE
Public Domain.
=cut
# $Date: 2005/03/26 04:51:41 $