--- okuchuu/piclist.ja.cgi 2005/02/25 17:08:30 1.4 +++ okuchuu/piclist.ja.cgi 2005/03/11 11:51:48 1.6 @@ -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,10 @@ } } +unless (-d $dir) { +# $dir =~ s#/+[^/]+$##; +} + opendir DIR, $dir or die "$dir: $!"; my @all_files = sort grep {not /^\./ and /^[A-Za-z0-9._-]+$/} (readdir DIR)[0..1000]; @@ -76,7 +79,7 @@ my $title = '画像一覧'; my $dirpath = escape $ENV{REQUEST_URI}; $dirpath =~ s/\?.*$//; -$dirpath =~ s#/LIST$##; +$dirpath =~ s#/[^/]+$##; $dirpath ||= '/'; print STDOUT "Content-Type: text/html; charset=euc-jp\n\n"; @@ -88,15 +91,38 @@ -$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; @@ -105,12 +131,12 @@ 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="$uri" alt="" class="@{[join ' ', @cls, 's']}" /></a>}; print qq{<dl><dt>URI</dt><dd>}; - print qq{<code class="uri">&lt;<a href="$uri">$uri</a>&gt;</code></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">$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>}; @@ -124,11 +150,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">&lt;<a href="$uri">$uri</a>&gt;</code></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">$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 +170,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,27 +190,29 @@ ['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 '<a href="'.$uri.'"'.$viewtarget.'>'; print '<img src="'.$uri.'" alt="'.$uri.'"'.$imgsattr.' />'; print "</a>\n"; } @@ -195,17 +223,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 +243,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 +254,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 +277,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 +302,4 @@ =cut -# $Date: 2005/02/25 17:08:30 $ +# $Date: 2005/03/11 11:51:48 $