--- okuchuu/piclist.ja.cgi 2005/02/26 04:15:33 1.5 +++ okuchuu/piclist.ja.cgi 2007/11/22 12:50:09 1.8 @@ -8,14 +8,12 @@ =cut -unless ($main::ENV{PATH_TRANSLATED}) { - die "BAD PATH_TRANSLATED"; -} +my $dir = $main::ENV{PATH_TRANSLATED} + or die "BAD PATH_TRANSLATED: $ENV{PATH_TRANSLATED}"; my %Opt; -my $dir = $main::ENV{PATH_TRANSLATED}; -if ($dir =~ s#/LIST$##) { +if ($dir =~ s#/[^/]+$##) { for (split /[&;]/, $ENV{QUERY_STRING}) { my ($name, $val) = split /=/, $_, 2; $Opt{$name} = defined $val ? $val : 1; @@ -56,6 +54,19 @@ } } +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]; @@ -74,11 +85,25 @@ 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 = '画像一覧'; -my $dirpath = escape $ENV{REQUEST_URI}; -$dirpath =~ s/\?.*$//; -$dirpath =~ s#/LIST$##; -$dirpath ||= '/'; print STDOUT "Content-Type: text/html; charset=euc-jp\n\n"; @@ -89,6 +114,7 @@ + @{[$Opt{cframe} ? '' : qq<$dirpath の>]}${title} ${linkelement} @@ -102,8 +128,8 @@ if ($Opt{cframe}) { my $LISTqt = ($LISTq eq 'LIST' ? $LISTq . '?' : $LISTq . ';') . 'target=view'; print qq{ - - + + }; } @@ -124,19 +150,23 @@ for my $file_name (@files) { my $efile = escape $file_name; + my $preview_uri = escape preview_uri $file_name; my $uri = $efile; $uri =~ s/\..+//g; + my $id = uc $uri; my @cls = split /\./, lc $file_name; shift @cls; - print q{<div class="image-with-desc">}; + print qq{<div class="image-with-desc" id="FILE--$id">}; print qq{<a href="$uri"$viewtarget>}; - print qq{<img src="$uri" alt="" class="@{[join ' ', @cls, 's']}"></a>}; + print qq{<img src="$preview_uri" alt="" class="@{[join ' ', @cls, 's']}" /></a>}; print qq{<dl><dt>URI</dt><dd>}; print qq{<code class="uri">&lt;<a href="$uri"$viewtarget>$uri</a>&gt;</code></dd>}; print qq{<dt>ファイル名</dt><dd>}; print qq{<code class="file"><a href="$efile"$viewtarget>$efile</a></code></dd>}; print qq{<dt>日付</dt><dd>}; print rfc3339date ([stat $dir.'/'.$file_name]->[9]); + print qq{<dt>大きさ</dt><dd>}; + print filesize ([stat $dir.'/'.$file_name]->[7]); print qq{</dd>}; print qq{</dl>}; print q{</div>}; @@ -148,7 +178,7 @@ my $uri = $efile; $uri =~ s/\..+//g; print q{<div class="image-with-desc">}; - print qq{<a href="$uri"$viewtarget><img src="/~wakaba/archive/2005/movie-1" alt=""></a>}; + print qq{<a href="$uri"$viewtarget><img src="/~wakaba/archive/2005/movie-1" alt="" /></a>}; print qq{<dl><dt>URI</dt><dd>}; print qq{<code class="uri">&lt;<a href="$uri"$viewtarget>$uri</a>&gt;</code></dd>}; print qq{<dt>ファイル名</dt><dd>}; @@ -168,9 +198,9 @@ print q{<div class="dir dir-with-desc">}; if (-f $dir . '/' . $dir_name . '/favicon.png' or -f $dir . '/' . $dir_name . '/favicon.ico') { - print qq{<img src="$edir/favicon" alt="" class="mini-icon">}; + print qq{<img src="$edir/favicon" alt="" class="mini-icon" />}; } else { - print qq{<img src="/icons/folder" alt="" class="mini-icon">}; + print qq{<img src="/icons/folder" alt="" class="mini-icon" />}; } print qq{<code class="file"><a href="$edir/$LISTq"$listtarget>$edir/</a></code>}; print q{</div>}; @@ -188,14 +218,14 @@ ['current', '現行版']) { if (has_file $_->[0]) { print q{<div class="file file-with-desc">}; - print q{<img src="/icons/layout" alt="" class="mini-icon">}; + print q{<img src="/icons/layout" alt="" class="mini-icon" />}; print qq{<a href="$_->[0]" rel="$_->[2]"$viewtarget>$_->[1]</a>}; print q{</div>}; } } print q{<div class="dir-up dir-with-desc">}; - print q{<img src="/icons/forward" alt="" class="mini-icon">}; + print q{<img src="/icons/forward" alt="" class="mini-icon" />}; print qq{<a href="../$LISTq" rel="up"$listtarget>上の階層</a>}; print q{</div>}; @@ -210,8 +240,9 @@ for my $file_name (@files) { my $uri = escape $file_name; $uri =~ s/\..+$//g; + my $preview_uri = escape preview_uri $file_name; print '<a href="'.$uri.'"'.$viewtarget.'>'; - print '<img src="'.$uri.'" alt="'.$uri.'"'.$imgsattr.' />'; + print '<img src="'.$preview_uri.'" alt="'.$uri.'"'.$imgsattr.' />'; print "</a>\n"; } @@ -231,7 +262,7 @@ if (-d $dir . '/CVS') { if (-f $dir . '/CVS/Root') { open my $root, '<', $dir . '/CVS/Root'; - if (<$root> =~ m#^(/home/cvs|/home/wakaba/pub/cvs)$#) { + if (<$root> =~ m#^(/home/cvs|/home/wakaba/pub/cvs)/?$#) { my $rpath = $1; if (-f $dir . '/CVS/Repository') { open my $repo, '<', $dir . '/CVS/Repository'; @@ -300,4 +331,4 @@ =cut -# $Date: 2005/02/26 04:15:33 $ +# $Date: 2007/11/22 12:50:09 $