--- okuchuu/piclist.ja.cgi 2005/02/25 17:08:30 1.4 +++ okuchuu/piclist.ja.cgi 2005/03/26 04:51:41 1.7 @@ -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; @@ -31,6 +29,7 @@ $s =~ s//>/g; $s =~ s/"/"/g; + $s =~ s/'/'/g; $s; } @@ -55,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]; @@ -73,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"; @@ -88,31 +114,58 @@ -$dirpath の${title} + +@{[$Opt{cframe} ? '' : qq<$dirpath の>]}${title} ${linkelement} - -

${title}

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{ + + + }; +} + +my $viewtarget = ''; +my $listtarget = ''; +my $parenttarget = ''; +if ($Opt{target} =~ /^([a-z]+)$/) { + $viewtarget = qq{ target="$1"}; + $listtarget = q{ target="_self"}; + $LISTq .= $LISTq eq 'LIST' ? qq{?target=$1} : qq{;target=$1}; + $parenttarget = q{ target="_parent"}; +} + if ($Opt{detail}) { - print q{<div class="pictures detail">}; + print qq{<body@{[$Opt{target}?' class="has-target"':'']}> + <h1>${title}</h1> + <div class="pictures detail">}; 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 @cls = split /\./, lc $file_name; shift @cls; print q{<div class="image-with-desc">}; - print qq{<a href="$uri">}; - print qq{<img src="$uri" alt="" class="@{[join ' ', @cls, 's']}"></a>}; + print qq{<a href="$uri"$viewtarget>}; + print qq{<img src="$preview_uri" alt="" class="@{[join ' ', @cls, 's']}" /></a>}; print qq{<dl><dt>URI</dt><dd>}; - print qq{<code class="uri"><<a href="$uri">$uri</a>></code></dd>}; + print qq{<code class="uri"><<a href="$uri"$viewtarget>$uri</a>></code></dd>}; print qq{<dt>ファイル名</dt><dd>}; - print qq{<code class="file"><a href="$efile">$efile</a></code></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>}; @@ -124,11 +177,11 @@ my $uri = $efile; $uri =~ s/\..+//g; print q{<div class="image-with-desc">}; - print qq{<a href="$uri"><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"><<a href="$uri">$uri</a>></code></dd>}; + print qq{<code class="uri"><<a href="$uri"$viewtarget>$uri</a>></code></dd>}; print qq{<dt>ファイル名</dt><dd>}; - print qq{<code class="file"><a href="$efile">$efile</a></code></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{</dd>}; @@ -144,11 +197,11 @@ 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/LIST?detail">$edir/</a></code>}; + print qq{<code class="file"><a href="$edir/$LISTq"$listtarget>$edir/</a></code>}; print q{</div>}; } @@ -164,28 +217,31 @@ ['current', '現行版']) { if (has_file $_->[0]) { print q{<div class="file file-with-desc">}; - print q{<img src="/icons/layout" alt="" class="mini-icon">}; - print qq{<a href="$_->[0]" rel="$_->[2]">$_->[1]</a>}; + 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{<a href="../LIST?detail" rel="up">上の階層</a>}; + print q{<img src="/icons/forward" alt="" class="mini-icon" />}; + print qq{<a href="../$LISTq" rel="up"$listtarget>上の階層</a>}; print q{</div>}; print q{</div>}; -} else { - print q{<div class="pictures">}; +} else { ## Normal Listing Mode + print qq{<body@{[$Opt{target}?' class="has-target"':'']}> + <h1>${title}</h1> + <div class="pictures">}; my $imgsattr = ' class="s"'; for my $file_name (@files) { my $uri = escape $file_name; $uri =~ s/\..+$//g; - print '<a href="'.$uri.'">'; - print '<img src="'.$uri.'" alt="'.$uri.'"'.$imgsattr.' />'; + my $preview_uri = escape preview_uri $file_name; + print '<a href="'.$uri.'"'.$viewtarget.'>'; + print '<img src="'.$preview_uri.'" alt="'.$uri.'"'.$imgsattr.' />'; print "</a>\n"; } @@ -195,17 +251,17 @@ for my $dir_name (@dirs) { my $edir = escape $dir_name; print q{<li class="dir">}; - print qq{<code class="file"><a href="$edir/LIST">$edir/</a></code>}; + print qq{<code class="file"><a href="$edir/$LISTq"$listtarget>$edir/</a></code>}; print q{</li>}; } - print q{<li class="dir-up"><a href="../LIST" rel="up">上の階層</a></li></ul>}; + print qq{<li class="dir-up"><a href="../$LISTq" rel="up"$listtarget>上の階層</a></li></ul>}; } my $cvslink = ''; 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'; @@ -215,7 +271,7 @@ $cvslink = qq{ <a href="/gate/cvs/$reppath/@{[ {q[/home/cvs] => '', q[/home/wakaba/pub/cvs] => '?cvsroot=Wakaba'}->{$rpath} - ]}" rel="history">この階層の履歴</a>}; + ]}" rel="history"$parenttarget>この階層の履歴</a>}; } } } @@ -226,16 +282,21 @@ <div class="footer"> <div class="navigation"> -[<a href="/" rel="home">/</a>] -[<a href="." rel="contents">この階層</a>$cvslink] -[<a href="LIST" rel="alternate">画像一覧</a> -<a href="LIST?detail" rel="alternate">画像一覧 (詳細)</a>] +[<a href="/" rel="home"$parenttarget>/</a>] +[<a href="." rel="contents"$parenttarget>この階層</a>$cvslink] +[画像一覧 (<a href="LIST" rel="alternate"$parenttarget>簡易</a>, +<a href="LIST?cframe" rel="alternate"$parenttarget>簡易・横分割</a>, +<a href="LIST?detail" rel="alternate"$parenttarget>詳細</a>, +<a href="LIST?detail;cframe" rel="alternate"$parenttarget>詳細・横分割</a>)] </div> </div> </body> -</html> EOH +print q{} if $Opt{cframe}; + +print q{}; + 1; __END__ @@ -244,9 +305,14 @@ =head1 CHANGES +2005-02-26 Wakaba + + - Frame mode implemented. + 2005-02-25 Wakaba - Use external style sheet. + - Detail mode implemented. 2001-06-25 Wakaba @@ -264,4 +330,4 @@ =cut -# $Date: 2005/02/25 17:08:30 $ +# $Date: 2005/03/26 04:51:41 $