#!/usr/bin/perl -w
#-----------------------------------------------------------------------------------------------------------------------
# Xie's Cards 1.23 by Lilia [2004-06-09]
#-----------------------------------------------------------------------------------------------------------------------
# 任意のディレクトリ内にある画像ファイルをアルバム風に一覧表示し
# スライドショー風の閲覧も可能にするCGIスクリプト
# the most recent version is available at:
# http://nursery.s8.xrea.com/R=vindex
use 5.004; # not sure... but use a modern perl
use CGI::Carp qw(carpout fatalsToBrowser);
use strict;
use SelfLoader;
my %ini = (
# ユーザー設定..
#-----------------------------------------------------------------------------------------------------------------------
# 基本項目
Title => 'index', # ページのタイトル
ImgDir => './img', # 画像ディレクトリのパス (カレントディレクトリなら '.')
ImgExt => 'jpg|gif|png', # 画像とみなす拡張子 (大・小文字は区別しない)
ViewSub => 0, # 下位ディレクトリにも対応する { 0:無効 / 1:有効 }
# 表示関係
VMax => 4, # 横にならぶ画像の個数
HMax => 2, # 縦にならぶ画像の個数 (1ページあたりの最大列数)
ImgWidth => 100, # 縮小表示時の画像の幅
ImgHeight => 75, # 縮小表示時の画像の高さ
SortType => 2, # { 0:日付の古い順 / 1:新しい順 / 2:名前順 } にならべる
# advanced
Slideshow => 1, # スライドショー風の表示を可能にする { 0:無効 / 1:有効 / 2:画像が複数ある場合のみ }
NoUserSort => 0, # 閲覧者によるファイルのソートを許可しない { 0:無効 / 1:有効 }
NameWidth => 0, # ファイル名表示の長さ { n:n(>5)バイト / 0:自動 / -1:短縮せず } *長いファイル名は短縮される
IgnoRE => qr/^$/, # 一覧から除外するファイルの正規表現 (とくに問題なければこのまま) * qr/^\./ は組込み済
RLastMod => 0, # ファイルの最終更新時刻をもとに Last-Modified や 304 等を返す { 0:無効 / 1:有効 }
# *NPHスクリプトとしての実行を推奨 (ファイル名が 'nph-' で始まっていれば自動認識)
# extra
NoImgWin => 0, # 画像ファイル名のリンクを別のウィンドウで開かない { 0:無効 / 1:有効 }
VaryMode => 0, # prev<->next の代わりに new<->old と表記する { 0:無効 / 1:有効 }
# *更新日時または初期設定の順およびその逆順でソートされている場合のみ (NoUserSort 有効を推奨)
#-- 以下はスタイルシートやリンク等の追加設定 (不要なら # でコメントアウト可)
# body タグ
Body => '',
# スタイルシート
Style => '', # 設定しなければデフォルトのスタイル (スクリプト末尾の例から選択も可能)
# # 記述例 (デフォルト)
# Style => q`
# body { background-color:#ffffff; color:#333333; font-family:Arial,Tahoma,Helvetica,Verdana,'MS PGothic',Osaka,sans-serif; }
# small { font-size:80%; line-height:140%; }
# .tall { line-height:200%; }
# .note { background-color:transparent; color:#ff0000; }
# a:link, a:visited { background-color:transparent; color:#666666; text-decoration:none; }
# a:hover,a:active { background-color:transparent; color:#333333; text-decoration:underline; }
# a.ex:link, a.ex:visited { background-color:transparent; color:#333333; text-decoration:none; }
# a.ex:hover,a.ex:active { background-color:transparent; color:#333333; text-decoration:underline; }
# table.index img { border:1px solid #cccccc; margin-bottom:5px; }
# table.index img:hover { border-color:#999999; }
# /* table.index em.dir:hover { border:1px solid #999999; padding:12px; } */
# `,
# ナビゲーション用のタグ
# Metas => q`
#
# `,
# 掲示板等へのリンクをつけたければタグで指定
# GoLink => '<< back',
# 特殊オプション - for XREA users
XreaIns => 0, # XREA.com のバナーを挿入する { 0:無効 / 1:有効 }
# ..ここまで
#-----------------------------------------------------------------------------------------------------------------------
# more advanced
RelLink => 0, # 画像に関連するURIへのリンクを表示 { 0:無効 / 1:スライドショー表示時のみ / 2：一覧表示時のみ 3:1+2 }
N2RLink => sub { # ファイル名から関連URIへのリンクを生成するサブルーチン (RelLink が有効な場合)
my $uri = shift; # ファイル名を受取る
my $short = shift; # この値は次のいずれか { 0:スライドショー表示時 / 1:一覧表示時 }
my($f_path,$f_size,$f_mtime) = @_; # ファイルのパス, サイズ, 最終更新時刻 (後2者は (stat $f_path)[7,9] と等しい)
# *不要ならコメントアウト可
my $text = !$short ? '~*rel?' : '~*'; # 'スライドショー表示時のアンカー文字列' : '一覧表示時のアンカー文字列'
my $r = 0; # replaced or not
#--
# 正規表現をつかった単純な方式の例 (わかりにくいかもしれないけど s/// を x修飾子つきで2行に分けているだけ)
# a) 日記 - (s)YYYYMMDD_N.jpg → /diary/YYYYMMDD.html
$r = $uri =~ s{^s?(\d\d\d\d)(\d\d)(\d\d).*$}
{$text}ix; # or "/diary/?$1"
# b) 画像掲示板 - {pre}{time}.jpg → bbs.cgi?date=YMD_HMS
# require POSIX; # use POSIX qw(strftime); としてスクリプト冒頭に移してもいい
# $r = $uri =~ s{^[^\d]*(\d+).*$} # or ^(?:pre)?(\d+).*$
# {'$text'}iex;
# *参考: POSIX::strftime() の代わりにスクリプト後部に用意した _mytime2s() も自由に編集して利用できる … _mytime2s($1 + 9*60*60) 等
# その他の例 (RelLink > 1 の場合何度も呼び出されるのであまり重いのはNG)
# a) 外部CGI
# $uri = qq{$text};
# $r = 1;
# b) 過去ログ検索 (ファイルの最終更新時刻を利用)
# require POSIX;
# $uri = '$text';
# $r = 1;
#--
return $r ? $uri : ''; # 関連URIがあるならそれを、なければ空の値を返す
},
# 日本語環境に依存しない
NoJP => 0, # ISO-8859-1(en) で出力 (出力に日本語が含まれていないなら有効にしてもいい)
# ファイル名の先頭に 'nph-' が付いていれば NPHスクリプトとして実行される
NPH => ($0 =~ m|\bnph-[^/\\ ]+$|i) || 0,
);
#-----------------------------------------------------------------------------------------------------------------------
&xview(%ini);
exit;
#-----------------------------------------------------------------------------------------------------------------------
# BEGIN { # maybe useful when you run this script as NPH
# return unless($0 =~ m|\bnph-[^/\\ ]+$|i);
# open(ERR, ">>error.log") or
# die("Unable to open error.log: $!");
# carpout(\*ERR);
# }
use vars qw($VERSION %INF);
use vars qw(%f_d %f_s %f_m);
BEGIN {
$VERSION = '1.23';
%INF = (
Script => q{Xie's Cards},
Sign => q{script by Lilia(*'-')~},
Dist => q{http://nursery.s8.xrea.com/},
# スクリプトが改造済みであることをごく控えめかつ手軽に主張したい人のための用意
# Plus => q{+}, # or +
);
# make the path safe for the -T switch
# $ENV{PATH} = '/bin:/usr/bin:/usr/local/bin'; # if ${^TAINT}
}
sub xview (;%) { # メイン処理
my %Ini = @_;
# 設定の確認と調整
{
my %_ini = ( # デフォルト値
Title => 'index', ImgDir => '.', ImgExt => 'jpg|gif|png',
VMax => 4, HMax => 2, ImgWidth => 80, ImgHeight => 100,
SortType => 2, Slideshow => 1, NameWidth => 0,
);
foreach(qw/Title ImgDir ImgExt/) { $Ini{$_} = $_ini{$_} unless defined $Ini{$_}; }
foreach(qw/VMax HMax ImgWidth ImgHeight
SortType Slideshow NameWidth/) { $Ini{$_} = defined $Ini{$_} ? int $Ini{$_} : $_ini{$_}; }
}
$Ini{ImgDir} =~ s|(?!^)/$||; # 末尾に '/' が付いていたら消しておく
$Ini{Body} ||= '';
foreach($INF{Plus},$Ini{Style},$Ini{Metas},$Ini{GoLink}) { $_ = '' unless defined; }
$Ini{IgnoRE} = '(?-xism:^$)' if(!defined $Ini{IgnoRE} || $Ini{IgnoRE} eq '' || $Ini{IgnoRE} eq '(?-xism:)');
$Ini{RelLink} = 0 unless($Ini{RelLink});
$Ini{SortKey} = ($Ini{SortType} < 2) ? 'M' : 'N'; # SortType は実はわかりやすい形をとった簡易設定であって...
$Ini{SortOrder} = ($Ini{SortType} == 1) ? 'D' : 'A'; # ...ここで本来の設定 SortKey と SortOrder に分解する
my $time = time;
my($myself) = $0 =~ m|([^/\\ ]+)$|;
my($self_uri) = $ENV{REQUEST_URI} || $ENV{SCRIPT_NAME} || $myself;
s/\?.*// foreach($myself,$self_uri); # lose any query part
my $img_dir = $Ini{ImgDir};
my $title_max = ($Ini{NameWidth} - 3 > 2) ? ($Ini{NameWidth} - 3) : int($Ini{ImgWidth} / 5.5); # 3 for '...'
my $target = $Ini{NoImgWin} ? '' : ' target="img"';
my $n2rlink = (!$Ini{RelLink} || !defined $Ini{N2RLink} || $Ini{N2RLink} eq '') ? sub { ''; } : $Ini{N2RLink};
my $sort_key = $Ini{SortKey};
my $sort_order = $Ini{SortOrder};
my $no_css = 0;
my $page_nr = 1;
my $req_dir = '';
my $s_file_nr = 0;
my $srch_key = '';
my $no_cache = 0;
my $get_dirinfo = 1; # 表示対象の下位ディレクトリを File::Find でサーチ (不具合があれば無効可)
my @info;
# HTTPヘッダ
my($proto,$nl,$head_gen) = $Ini{NPH}
? ($ENV{SERVER_PROTOCOL},"\015\012",'Date: ' . time2rfcdate($time) . "\015\012Server: $ENV{SERVER_SOFTWARE}\015\012")
: ('Status:', "\012", '');
my $status = '200 OK';
my $head_lm = '';
my($charset,$cont_opt,$lang) = !$Ini{NoJP}
? ('; charset=Shift_JIS', "Content-Language: ja$nl",' lang="ja"')
: ('; charset=ISO-8859-1',"Content-Language: en$nl",' lang="en"');
# HTML断片
my $banner = ''; # 一覧表示時のバナー (ページ下部に挿入されるHTML断片)
my $sbanner = ''; # スライドショー表示時のバナー
my $post_head_s = ''; # の直後に挿入されるHTML断片
my $post_html_e = ''; # の直後に挿入されるHTML断片 (特殊)
# XREA広告 (メイン画面だけの表示でいい)
($banner,$post_head_s) = ("\n" . <<"_XREA_", '') if($Ini{XreaIns} && $ENV{SERVER_NAME} && $ENV{SERVER_NAME} ne 'localhost');
- xrea ad banner -
_XREA_
# バナー消し (旧 参考)
# $post_html_e = ($ENV{SERVER_NAME} && $ENV{SERVER_NAME} =~ /(?:virtualave|hypermart)\.net/i) ? "<![CDATA[\n\n" : '';
# スタイルシート
my $css = ($Ini{Style} eq '') ? q`
body { background-color:#ffffff; color:#333333; font-family:Arial,Tahoma,Helvetica,Verdana,'MS PGothic',Osaka,sans-serif; }
small { font-size:80%; line-height:140%; }
.tall { line-height:200%; }
.note { background-color:transparent; color:#ff0000; }
a:link, a:visited { background-color:transparent; color:#666666; text-decoration:none; }
a:hover,a:active { background-color:transparent; color:#333333; text-decoration:underline; }
a.ex:link, a.ex:visited { background-color:transparent; color:#333333; text-decoration:none; }
a.ex:hover,a.ex:active { background-color:transparent; color:#333333; text-decoration:underline; }
table.index img { border:1px solid #cccccc; margin-bottom:5px; }
table.index img:hover { border-color:#999999; }
/* table.index em.dir:hover { border:1px solid #999999; padding:12px; } */
` : ($Ini{Style} =~ /^([\w\-]+)$/) ? _style(uc($1)) : $Ini{Style};
# クエリ処理
my %Qs;
my @current_qs;
my $known_q = q[COXDPIQR]; # 後から追加しやすいようにまとめておく
# C=N ファイル名 C=M 更新日時 C=S サイズ C=T 種類
# O=A 昇順 O=D 降順
# X=1 スタイルシート除去 X=0 デフォルト
# D=dirname 下位ディレクトリ
# P=n nページ目
# I=n n番目のアイテム *スライドショー表示
# Q=filename ファイル名(の一部) *簡易検索
# R=1 キャッシュ無視 R=0 デフォルト
if($ENV{QUERY_STRING}) {
foreach(split(/;/, $ENV{QUERY_STRING})) {
next unless(/=.+/);
my($name,$value) = split /=/;
next unless($name =~ s/^([$known_q]).*$/\u$1/io); # 不明なクエリは受付けない
$Qs{$name} = $value;
}
}
# C { N:ファイル名 / M:更新日時 / S:サイズ / T:種類 }
$sort_key = $Qs{C} if(!$Ini{NoUserSort} && $Qs{C} && $Qs{C} =~ s/^([NMST]).*$/\u$1/i);
push @current_qs, "C=$sort_key" if($sort_key ne $Ini{SortKey});
# O { A:昇順 / D:降順 }
$sort_order = $Qs{O} if(!$Ini{NoUserSort} && $Qs{O} && $Qs{O} =~ s/^(A|D).*$/\u$1/i);
push @current_qs, "O=$sort_order" if($sort_order ne $Ini{SortOrder});
# X { 1:スタイルシート除去 / 0:デフォルト }
$no_css = 1 if($Qs{X});
push @current_qs, "X=1" if($no_css != 0);
# P { n:nページ目 }
$page_nr = $Qs{P} if($Qs{P} && $Qs{P} =~ s/^(\d+).*$/$1/);
# D { dirname:下位ディレクトリ }
$req_dir = $Qs{D} if($Ini{ViewSub} && exists $Qs{D});
$req_dir =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
# I { n:n番目のアイテム } * P とは共存しない
$s_file_nr = $Qs{I} if($Ini{Slideshow} && $Qs{I} && $Qs{I} =~ s/^(\d+).*$/$1/);
# Q { filename:ファイル名(の一部) }
if(exists $Qs{Q}) {
if(($srch_key = $Qs{Q}) =~ s|^.*?([\w\-\.]+).*$|$1|) {
push @current_qs, "Q=$srch_key";
} else {
$srch_key = '';
push @info, "! mal-formed QArg, 'Q=filename'.";
}
}
# R { 1:キャッシュ無視 / 0:デフォルト }
$no_cache = 1 if($Qs{R});
# ラベル変更
my %t = (
prev => 'prev',
next => 'next',
);
if($Ini{VaryMode}) {
my $o_to_n = ($sort_key eq 'M') ? ($sort_order eq 'A') ? 1 : -1 : 0;
my $s_to_l = ($sort_key eq 'S') ? ($sort_order eq 'A') ? 1 : -1 : 0;
if($o_to_n || $sort_key eq $Ini{SortKey}) {
($t{prev},$t{next}) = ($o_to_n < 0 || $sort_order eq $Ini{SortOrder})
? ('new','old') : ('old','new');
} elsif($Ini{VaryMode} == 2 && $s_to_l) { # reserved
($t{prev},$t{next}) = ($s_to_l > 0)
? ('small','large') : ('large','small');
}
}
# 下位ディレクトリ内のファイル表示を要求された場合の下処理
my @upper_dirs;
if($req_dir ne '') {
if($req_dir =~ m|[^\./ ]| && $req_dir !~ m%(?:^|/)\.*(?:/|$)% && $req_dir !~ /\\/ && -d "$img_dir/$req_dir") { # 有効性をチェック
$img_dir = "$img_dir/$req_dir";
@upper_dirs = ($req_dir !~ m|/|) ? qw(/) : qw(/ ..); # 上位ディレクトリは便宜上このようにしておく (ファイルリスト中の他の要素はこれらの値をとらない)
} else {
$req_dir = '';
push @info, "! mal-formed QArg, 'D=dirname'.";
}
}
s/&/&/g, s/</</g, s/>/>/g, s/"/"/g foreach($req_dir); # 一応
push @current_qs, "D=$req_dir" if($req_dir ne '');
my $not_files = @upper_dirs;
# 画像ディレクトリを開きファイルのリストを取得
my @files;
my $lmtime = 0; # リスト中で最新のファイルの最終更新時刻
$f_m{$myself} = (stat $myself)[9]; # スクリプト本体の最終更新時刻
$f_d{'/'} = $f_d{'..'} = 1;
opendir(DIR, $img_dir) or
die("Unable to opendir $img_dir: $!");
foreach(grep(!/^\./, readdir(DIR))) {
next if($_ eq $myself || /$Ini{IgnoRE}/o || !(m|[^\./\\ ]| && -e "$img_dir/$_")); # 無効なファイルを除外
next if(-d _ && !$Ini{ViewSub});
next if(-f _ && !/\.(?:$Ini{ImgExt})$/io);
next if($srch_key ne '' && !/\Q$srch_key\E/io);
$not_files++ if($f_d{$_} = -d _);
($f_s{$_},$f_m{$_}) = (stat _)[7,9];
$lmtime = $f_m{$_} if($f_m{$_} > $lmtime);
push @files, $_;
}
closedir(DIR);
$lmtime = (stat $img_dir)[9] unless($lmtime);
$lmtime = $f_m{$myself} if($f_m{$myself} > $lmtime);
# Last-Modified とキャッシュの検証
if($Ini{RLastMod}) {
my $cached = $no_cache ? undef : rfcdate2time($ENV{HTTP_IF_MODIFIED_SINCE});
$cached = undef if($cached && $time <= $cached);
$status = '304 Not Modified' if($cached && $lmtime <= $cached);
$head_lm = 'Last-Modified: ' . time2rfcdate($lmtime) . $nl;
}
my $http_header = "$proto $status$nl"
. "$head_gen$head_lm"
. "Connection: close$nl"
. "Content-Type: text/html$charset$nl$cont_opt$nl";
# 全レスポンスを送る必要がない場合
if($status eq '304 Not Modified' || $ENV{REQUEST_METHOD} eq 'HEAD') {
print $http_header;
return; # ここで終了
}
# ソート
my $by_rule = "by_$sort_key$sort_order";
@files = sort $by_rule @files;
# FoldersFirst
sub folder { $f_d{$b} cmp $f_d{$a}; }
# 昇順 - N:ファイル名 M:更新日時 S:サイズ T:種類
sub NameA { uc($a) cmp uc($b); } # secondary key: C=N,O=A (always)
sub by_NA { folder or NameA; }
sub by_MA { folder or $f_m{$a} <=> $f_m{$b} or NameA; }
sub by_SA { folder or $f_s{$a} <=> $f_s{$b} or NameA; }
sub by_TA { folder or tof($a) cmp tof($b) or NameA; }
# 降順
sub by_ND { folder or uc($b) cmp uc($a); }
sub by_MD { folder or $f_m{$b} <=> $f_m{$a} or NameA; }
sub by_SD { folder or $f_s{$b} <=> $f_s{$a} or NameA; }
sub by_TD { folder or tof($b) cmp tof($a) or NameA; }
@files = (@upper_dirs,@files);
my $all_files = @files;
$s_file_nr = 0 if($s_file_nr < 0 || $s_file_nr > $all_files || !defined $files[$s_file_nr - 1] || !-f "$img_dir/$files[$s_file_nr - 1]");
push @info, "! mal-formed and/or invalid QArg, 'I=n'." if($Qs{I} && !$s_file_nr); # 無効なスライドショー要求
# 基本ヘッダ・フッタ
$css = $no_css
? qq`<meta http-equiv="content-style-type" content="text/nocss">`
: qq`<meta http-equiv="content-style-type" content="text/css">
<style type="text/css">
<!--$css-->
</style>`;
my $page_header = qq`<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html$lang>
<head>$post_head_s
<meta name="robots" content="NONE">
<meta name="generator" content="$INF{Script} $VERSION">
<meta http-equiv="content-type" content="text/html$charset">
$css`;
$banner = $sbanner if($s_file_nr);
my $page_footer = qq`<small class="tall">:: Generated by <a href="$INF{Dist}" title="$INF{Sign}" class="ex">$INF{Script}</a>$INF{Plus} ::<br></small>
</div>
$banner
<br>
</body>
</html>$post_html_e`;
if($s_file_nr) { # スライドショー表示
push @current_qs, "I=$s_file_nr";
push @info, "! invalid QArg, 'P=n': 'I=$s_file_nr' is set." if($page_nr != 1);
my $img_name = $files[$s_file_nr - 1];
my $img_src = "$img_dir/$img_name";
my $img_size = size2s($f_s{$img_name});
my $prev_file = (defined $files[$s_file_nr - 2] && -f "$img_dir/$files[$s_file_nr - 2]") ? $s_file_nr - 1 : 0;
my $next_file = (defined $files[$s_file_nr] && -f "$img_dir/$files[$s_file_nr]") ? $s_file_nr + 1 : 0;
my $prev_uri_qs = $prev_file ? ("$self_uri?" . xjoin(';', '^I' => "I=$prev_file", @current_qs)) : '';
my $next_uri_qs = $next_file ? ("$self_uri?" . xjoin(';', '^I' => "I=$next_file", @current_qs)) : '';
my $index_uri_qs = ("$self_uri?" . xjoin(';', '^I' => undef, @current_qs));
my($prev_navi,$prev_anchor) = $prev_file
? (qq`\n<link rel="prev" href="$prev_uri_qs" title="$t{prev}">`,
qq`<a href="$prev_uri_qs"><< $t{prev}</a> `)
: ('','<!-- no prev -->');
my($next_navi,$next_anchor) = $next_file
? (qq`\n<link rel="next" href="$next_uri_qs" title="$t{next}">`,
qq`<a href="$next_uri_qs">$t{next} >></a>`)
: ('','<!-- no next -->');
my $opt_query_s = $no_css
? qq`<br>\n<a href="$self_uri?@{[xjoin(';', '^X' => undef, @current_qs)]}" title="Cascading Style Sheets">*CSS on</a>`
: qq`<br>\n<a href="$self_uri?@{[xjoin(';', '^X' => 'X=1', @current_qs)]}" title="NO Cascading Style Sheets">*CSS off</a>`;
my $rel_anchor = ($Ini{RelLink} && $Ini{RelLink} != 2) ? &$n2rlink($img_name,0,$img_src,$f_s{$img_name},$f_m{$img_name}) : '';
$rel_anchor = " \n$rel_anchor" if($rel_anchor);
my $err_notes = njoinf(' ', qq`\n<em class="note" title="%s">!%d!</em>`, 1, @info);
$err_notes = "<br>$err_notes" if($err_notes);
# $img_src =~ s|([^a-z0-9\-_./])|'%' . unpack('H2', $1)|ieg; # URIエスケープ
s/&/&/g, s/</</g, s/>/>/g, s/"/"/g foreach($img_name,$img_src); # 一応
print $http_header, <<"_SLID_";
$page_header
<link rel="index" href="$index_uri_qs" title="index">$prev_navi$next_navi
<title>$s_file_nr/$all_files $img_name, $img_size</title>
</head>
$Ini{Body}
<div align="center">
<small>
$prev_anchor
<a href="$index_uri_qs">index</a>
$next_anchor$rel_anchor$err_notes
</small>
<hr>
@{[$next_navi ? qq(<a href="$next_uri_qs" title="$t{next}">) : qq(<a href="$index_uri_qs" title="index">)
]}<img src="$img_src" border=0 alt="$img_name"></a>
<hr>
<small>
$prev_anchor
<a href="$index_uri_qs">index</a>
$next_anchor$rel_anchor$opt_query_s
</small><br>
$page_footer
_SLID_
return; # スライドショー表示の場合はこれで処理終了
}
my $p_item_max = $Ini{VMax} * $Ini{HMax}; # 1ページの表示可能数 = 横 x 縦
my $all_pages = ($all_files / $p_item_max) || 1; # 全部で何ページになるか = 全アイテム数 ÷ 1ページの表示可能数
$all_pages = ($all_pages == int($all_pages)) ? $all_pages : int($all_pages + 1); # 余りの分で+1ページ
if($page_nr > $all_pages || $page_nr <= 0) { # ページ数を超える要求・0ページ以下の要求は無効
$page_nr = 1;
push @info, "! mal-formed QArg, 'P=n'.";
}
push @current_qs, "P=$page_nr" if($page_nr > 1);
my $p_end = $p_item_max * $page_nr; # このページには何番目のアイテムまでを表示するか
$p_end = $all_files if($p_end > $all_files);
my $p_start = $p_end ? ($p_item_max * ($page_nr - 1) + 1) : 0; # 何番目から (アイテムがなければ 0 になる)
my($page_link,$head_navi,$bottom_navi) = ('','','');
if($all_pages > 1) { # 複数ページにわたるとき
my($prev_pages,$next_pages) = ('','');
my $prev_remain = $page_nr - 1; # このページの前に何ページあるか
my $next_remain = $all_pages - $page_nr; # このページの後に何ページあるか
while($prev_remain > 0) { # 先行ページへのリンク 例: $page_nr = 4 … 3ページある -> 3, 2, 1
$prev_pages = qq`<a href="$self_uri?@{[xjoin(';', '^P' => "P=$prev_remain", @current_qs)]}">$prev_remain</a> $prev_pages`;
$prev_remain--;
}
while($next_remain > 0) { # 後続ページへのリンク 例: $page_nr = 4 … 3ページある -> 7, 6, 5
$next_pages = qq` <a href="$self_uri?@{[xjoin(';', '^P' => ('P=' . ($next_remain + $page_nr)), @current_qs)]}">@{[$next_remain + $page_nr]}</a>$next_pages`;
$next_remain--;
}
# ページ上部に表示する各ページへのリンク (先行_現在_後続)
$page_link = qq`<br>\n\n<small class="tall">$prev_pages<strong>$page_nr</strong>$next_pages</small>`;
# ページ下部に表示する前後ページへのリンク およびヘッダ内のナビゲーション
my $prev_uri_qs = ($page_nr - 1 > 0) ? ("$self_uri?" . xjoin(';', '^P' => ('P=' . ($page_nr - 1)), @current_qs)) : '';
my $next_uri_qs = ($page_nr + 1 <= $all_pages) ? ("$self_uri?" . xjoin(';', '^P' => ('P=' . ($page_nr + 1)), @current_qs)) : '';
my($prev_navi,$prev_link) = $prev_uri_qs
? (qq`\n<link rel="prev" href="$prev_uri_qs" title="$t{prev}">`,
qq`<a href="$prev_uri_qs">$t{prev} <<</a> `)
: ('','<!-- no prev -->');
my($next_navi,$next_link) = $next_uri_qs
? (qq`\n<link rel="next" href="$next_uri_qs" title="$t{next}">`,
qq` <a href="$next_uri_qs">>> $t{next}</a>`)
: ('','<!-- no next -->');
$head_navi = $prev_navi . $next_navi;
$bottom_navi = qq`\n<small>$prev_link$p_start - $p_end of $all_files$next_link</small><br>\n`;
}
# ソートとスタイルシート切替の機能を提供するリンク
my $opt_query = $all_files ? ($all_files >= 2) ? "($all_files items) " : "($all_files item) " : '(no item) ';
if($all_files >= 2 && !$Ini{NoUserSort}) { # ソート用リンクは複数ある場合だけ表示
my(%qs,%in,%sw);
# 昇順が基本
($qs{$_},$in{$_},$sw{$_}) = ("C=$_;O=A",'ascending', '+') foreach qw(N M S T);
# 現在昇順でソートされている項目のみ降順に反転
($qs{$sort_key},$in{$sort_key},$sw{$sort_key}) = ("C=$sort_key;O=D",'descending','-') if($sort_order eq 'A');
$opt_query.= qq`
<a href="$self_uri?@{[xjoin(';', '^(?:C|O|P)' => "$qs{N}", @current_qs)]}" title="sort by name ($in{N})">*name$sw{N}</a>
<a href="$self_uri?@{[xjoin(';', '^(?:C|O|P)' => "$qs{M}", @current_qs)]}" title="sort by date ($in{M})">*date$sw{M}</a>
<a href="$self_uri?@{[xjoin(';', '^(?:C|O|P)' => "$qs{S}", @current_qs)]}" title="sort by size ($in{S})">*size$sw{S}</a>
<a href="$self_uri?@{[xjoin(';', '^(?:C|O|P)' => "$qs{T}", @current_qs)]}" title="sort by type ($in{T})">*type$sw{T}</a>`;
}
$opt_query.= $no_css
? qq` \n<a href="$self_uri?@{[xjoin(';', '^X' => undef, @current_qs)]}" title="Cascading Style Sheets">*CSS on</a>`
: qq` \n<a href="$self_uri?@{[xjoin(';', '^X' => 'X=1', @current_qs)]}" title="NO Cascading Style Sheets">*CSS off</a>`;
my $p_img_dir = $img_dir; # 'index of 〜' の表示用
if($p_img_dir eq '.') { # カレントディレクトリの場合 できればパスの表示を少し工夫
require Cwd;
$p_img_dir = Cwd::cwd() || Cwd::getcwd() || '';
$p_img_dir = $1 if($p_img_dir eq '' && $ENV{SCRIPT_NAME} && $ENV{SCRIPT_NAME} =~ m|^(.*)/[^/]+$|);
$p_img_dir =~ s/^\QENV{DOCUMENT_ROOT}\E//i if($ENV{DOCUMENT_ROOT});
$p_img_dir =~ s|^/?|/|; $p_img_dir =~ s|/$||; $p_img_dir =~ s|^.*/|../|;
$p_img_dir = '/' if($p_img_dir eq '');
}
my $slide_link = 1 if($Ini{Slideshow} && $all_files - $not_files >= $Ini{Slideshow});
{ # スライドショー用のリンク
my $first_file = (defined $files[$not_files] && -f "$img_dir/$files[$not_files]") ? $not_files + 1 : 0;
my $first_uri_qs = $first_file ? ("$self_uri?" . xjoin(';', '^(?:I|P)' => "I=$first_file", @current_qs)) : '';
$Ini{GoLink}.= $slide_link
? qq` \n<a href="$first_uri_qs">#slideshow</a>`
: '<!-- no slideshow -->';
$Ini{GoLink} = "\n<small>$Ini{GoLink}</small><br>\n";
}
my $err_notes = njoinf(' ', qq`\n<em class="note" title="%s">!%d!</em>`, 1, @info);
$err_notes = " $err_notes" if($err_notes);
# 一覧表示
print $http_header, <<"_HTML_";
$page_header$Ini{Metas}$head_navi
<title>$Ini{Title}</title>
</head>
$Ini{Body}
$Ini{GoLink}
<div align="center">
index of <a href="$img_dir/" class="ex">$p_img_dir</a> <small>@{[
($srch_key ne '') ? (qq`<a href="$self_uri?` . xjoin(';', '^Q' => undef, @current_qs) . qq`" title="clear">[Q:$srch_key]</a> `) : ''
]}$opt_query$err_notes</small>$page_link<br><br>
<table align="center" border=0 cellpadding=8 summary="images" class="index">
_HTML_
my $img_remain = @files ? 1 : 0;
my $h_nr = 0;
require File::Find if($not_files && $get_dirinfo);
while(@files) {
last if($img_remain <= 0 || $h_nr == $Ini{HMax}); # 表示する画像がなくなった or ページの最大列数を超えたらやめる
my $v_start = ($Ini{VMax} * $h_nr) + ($p_item_max * ($page_nr - 1)); # 横にならぶ個数 x 現在何列目か (6x0, 6x1, 6x2, ...) + 先行ページ分
my $v_end = $v_start + $Ini{VMax} - 1; # 0〜5, 6〜11, 12〜17, ... というふうにしたいので -1
$v_end = $#files if($v_end > $#files);
print "<tr>\n";
my $file_nr = $v_start + 1;
foreach(@files[$v_start .. $v_end]) { # 1列分ずつ出力
if($f_d{$_}) { # ディレクトリ
my($dir_label,$dir_title,$dir_path,$dir_qs) = ('sub',"$_/","$img_dir/$_","D=$_");
if($_ eq '/') { # 初期ディレクトリ
($dir_label,$dir_title,$dir_path,$dir_qs) = ('base','TOP',$Ini{ImgDir},'');
} elsif($_ eq '..') { # 親ディレクトリ (of $req_dir)
my($p_dir) = $req_dir =~ m|^(.+)/[^/]+$|;
($dir_label,$dir_title,$dir_path,$dir_qs) = ('parent','UP',"$Ini{ImgDir}/$p_dir","D=$p_dir"); # 'UP' or '../'
} elsif($req_dir ne '') { # 現在既に下位ディレクトリを開いている
$dir_qs = "D=$req_dir/$_";
}
my $dir_info = '';
if($get_dirinfo) {
my($indir_dirs,$indir_files,$dir_size) = (0,0,0);
File::Find::find({ wanted => sub { if(-f) { $dir_size += -s; $indir_files++; } elsif(-d) { $indir_dirs++; } }, no_chdir => 1 }, $dir_path);
$indir_dirs &&= $indir_dirs - 1; # 自分自身も数に入っているので
$dir_info = " (d=$indir_dirs, f=$indir_files, " . size2s($dir_size) . ")";
}
print <<"_DIR_";
<td align="center" width=$Ini{ImgWidth} height=$Ini{ImgHeight}><em class="dir" title="$file_nr/$all_files$dir_info">[DIR]</em><br><br>
<small><a href="$dir_path/" title="OPEN $dir_label directory">$dir_title</a> <a href="$self_uri?@{[xjoin(';', '^(?:D|P)' => ($dir_qs ? $dir_qs : undef), @current_qs)]}" title="VIEW $dir_label directory">>></a></small></td>
_DIR_
} else { # ファイル
my $img_info = size2s($f_s{$_});
my $img_title = $_;
$img_title =~ s/^(.{$title_max}).{4,}$/$1.../o unless($Ini{NameWidth} < 0); # LongName...
$img_info = "$_, $img_info" if($img_title ne $_); # ファイル名を短縮した場合はアンカータグの title でフル表示
my $img_src = "$img_dir/$_";
my $rel_anchor = ($Ini{RelLink} > 1) ? &$n2rlink($_,1,$img_src,$f_s{$_},$f_m{$_}) : '';
# $img_src =~ s|([^a-z0-9\-_./])|'%' . unpack('H2', $1)|ieg; # URIエスケープ
s/&/&/g, s/</</g, s/>/>/g, s/"/"/g foreach($img_info,$img_title,$img_src);
my($img_link_s,$img_link_e) = $slide_link
? (qq`<a href="$self_uri?@{[xjoin(';', '^(?:I|P)' => "I=$file_nr", @current_qs)]}" title="slideshow $file_nr/$all_files">`,'</a>')
: ('','');
print <<"_IMG_";
<td align="center">$img_link_s<img src="$img_src" width=$Ini{ImgWidth} height=$Ini{ImgHeight} border=1 alt="$file_nr/$all_files">$img_link_e<br>
<small><a href="$img_src" title="$img_info"$target>$img_title</a>$rel_anchor</small></td>
_IMG_
}
$file_nr++;
}
print "</tr>\n";
$img_remain = $#files - $v_end; # 残り画像数 = 全画像数 - 表示した分
$h_nr++;
}
print <<"_HTML_";
</table><br>
$bottom_navi
$page_footer
_HTML_
} # xview end
# オリジナルの小関数群
#-----------------------------------------------------------------------------------------------------------------------
sub tof (;$) {
my $filename = shift;
return '' if(!defined $filename || $filename !~ /\.([^\.]+)$/);
uc($1);
} # tof end
sub size2s (;$) { # an abbreviated display of the number kilobytes, megabytes or gigabytes
my $size = shift or return 0;
my($gb,$mb,$kb) = ($size / 1073741824, $size / 1048576, $size / 1024);
($gb >= 100) ? sprintf("%.0fGB", $gb) :
($gb >= 10) ? sprintf("%.1fGB", $gb) :
($mb >= 1000) ? sprintf("%.2fGB", $gb) :
($mb >= 100) ? sprintf("%.0fMB", $mb) :
($mb >= 10) ? sprintf("%.1fMB", $mb) :
($kb >= 1000) ? sprintf("%.2fMB", $mb) :
($kb >= 100) ? sprintf("%.0fKB", $kb) :
($kb >= 10) ? sprintf("%.1fKB", $kb) :
sprintf("%.2fKB", $kb);
} # size2s end
sub xjoin ($$$@) { # $single_str = xjoin($", '^unwanted$' => 'newvalue', @array_or_LIST);
my $s = shift;
my $x = shift || '^$';
my $new = shift;
defined $new ? join($s, grep(!/$x/, @_),$new)
: join($s, grep(!/$x/, @_));
} # xjoin end
sub njoinf ($$$@) { # $single_str = njoinf($", "ex %d: %s<br>\n", $[, @array_or_LIST);
my($s,$f,$nr,@list) = @_;
my $str = '';
my $r = 1 if($f =~ /.*?%s.*?%[\d\-\.+ ]*d/); # if not satisfied, specify an explicit fmt like: "%2\$s #%1\$02d"
foreach(@list) {
$str.= $s if($str ne '');
$str.= $r ? sprintf($f, $_,$nr) : sprintf($f, $nr,$_);
$nr++;
}
$str;
} # njoinf end
sub time2rfcdate (;$) { # a faster version of time2s()
my $time = shift || time;
sprintf("%s, %02d %s %04d %s GMT", (split(/\s+/, gmtime($time)))[0,2,1,4,3]);
} # time2rfcdate end
# より汎用性の高い関数群
#-----------------------------------------------------------------------------------------------------------------------
use vars qw(@DoW @MoY %MoY);
BEGIN {
@DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
@MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
@MoY{@MoY} = (1..12);
}
__DATA__
sub rfcdate2time ($) { # converts an RFC compliant HTTP header line into a UNIX timestamp
# my @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
# my %MoY;
# @MoY{@MoY} = (1..12);
require Time::Local;
my $str = shift or return undef;
my $t = -1;
if($str =~ /^[FMSTW][a-z][a-z], (\d\d) ([ADFJMNOS][a-z][a-z]) (\d\d\d\d) (\d\d):(\d\d):(\d\d) GMT.*$/) {
$t = Time::Local::timegm_nocheck($6,$5,$4,$1,$MoY{$2}-1,$3-1900);
return ($t < 0) ? undef : $t;
} else {
return undef;
}
} # rfcdate2time end
sub time2s (;$) { # converts a UNIX timestamp into an RFC compliant HTTP header line (for reference)
# my @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
# my @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my $time = shift || time;
my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
$DoW[$wday],$mday,$MoY[$mon],$year+1900,$hour,$min,$sec);
} # time2s end
# カスタマイズ用の私的関数群
#-----------------------------------------------------------------------------------------------------------------------
sub _mytime2s (;$) { # UNIXのタイムスタンプを好みの日時表記に書式化 (自由に設定可)
my @DoW = ('日','月','火','水','木','金','土'); # 曜日名の設定
my $time = shift || time;
my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
sprintf("%04d/%02d/%02d($DoW[$wday])%02d:%02d:%02d",
$year+1900,$mon+1,$mday,$hour,$min,$sec);
} # _mytime2s end
sub _style (;$) { # スタイルシート
my %CSS = ( # キーは大文字の単語構成文字で
# default - do not modify or delete
DEFAULT => q`
body { background-color:#ffffff; color:#333333; font-family:Arial,Tahoma,Helvetica,Verdana,'MS PGothic',Osaka,sans-serif; }
small { font-size:80%; line-height:140%; }
.tall { line-height:200%; }
.note { background-color:transparent; color:#ff0000; }
a:link, a:visited { background-color:transparent; color:#666666; text-decoration:none; }
a:hover,a:active { background-color:transparent; color:#333333; text-decoration:underline; }
a.ex:link, a.ex:visited { background-color:transparent; color:#333333; text-decoration:none; }
a.ex:hover,a.ex:active { background-color:transparent; color:#333333; text-decoration:underline; }
table.index img { border:1px solid #cccccc; margin-bottom:5px; }
table.index img:hover { border-color:#999999; }
/* table.index em.dir:hover { border:1px solid #999999; padding:12px; } */
`,
# Shin M.'s lite style
LITE => q`
body { background-color:#f0f0f0; color:#333333; font-family:Arial,Tahoma,Helvetica,Verdana,'MS PGothic',Osaka,sans-serif; }
small { font-size:80%; line-height:140%; }
.tall { line-height:200%; }
.note { background-color:transparent; color:#2080a0; }
a:link,a:visited { background-color:transparent; color:#666666; text-decoration:none; }
a:hover { background-color:transparent; color:#1775a2; text-decoration:underline; }
a:active { background-color:transparent; color:#cc0000; text-decoration:underline; }
a.ex:link, a.ex:visited { background-color:transparent; color:#333333; text-decoration:none; }
a.ex:hover,a.ex:active { background-color:transparent; color:#1775a2; text-decoration:underline; }
table.index img { border:1px solid #888888; margin-bottom:5px; }
table.index img:hover { border-color:#666666; }
/* table.index em.dir:hover { border:1px solid #888888; padding:12px; } */
`,
# Shin M.'s friendly style
TAIYAKI => q`
body { background-color:#333333; color:#d0d0d0; font-family:Arial,Tahoma,Helvetica,Verdana,'MS PGothic',Osaka,sans-serif; }
small { font-size:80%; line-height:140%; }
.tall { line-height:200%; }
.note { background-color:transparent; color:#ff69b4; }
a:link,a:visited { background-color:transparent; color:#d0d0d0; text-decoration:none; }
a:hover { background-color:transparent; color:#d0d0d0; text-decoration:underline; }
a:active { background-color:transparent; color:#cc0000; text-decoration:underline; }
table.index img { border:1px solid #d0d0d0; margin-bottom:5px; }
/* table.index em.dir:hover { border:1px solid #d0d0d0; padding:12px; } */
`,
# for the people of Str*ngeworld
STRANGE => q`
body { background-color:#004040; color:#ffffff; font-family:Arial,Tahoma,Helvetica,Verdana,'MS PGothic',Osaka,sans-serif; }
small { font-size:80%; line-height:140%; }
.tall { line-height:200%; }
.note { background-color:transparent; color:#ff0000; }
a:link, a:visited { background-color:transparent; color:#eeffee; text-decoration:none; }
a:hover,a:active { background-color:transparent; color:#ff0000; text-decoration:underline; }
a.ex:link, a.ex:visited { background-color:transparent; color:#ffffff; text-decoration:none; }
a.ex:hover,a.ex:active { background-color:transparent; color:#dddddd; text-decoration:underline; }
table.index img { border:1px solid #dddddd; margin-bottom:5px; }
table.index img:hover { border-color:#eeffee; }
/* table.index em.dir:hover { border:1px solid #eeffee; padding:12px; } */
`,
# for the people in Nazo area (Str*ngeworld)
NAZO => q`
body { background-color:black; color:red; font-family:Arial,Tahoma,Helvetica,Verdana,'MS PGothic',Osaka,sans-serif; }
small { font-size:80%; line-height:140%; }
.tall { line-height:200%; }
.note { background-color:transparent; color:red; }
a:link,a:visited { background-color:transparent; color:green; text-decoration:none; }
a:hover { background-color:transparent; color:green; text-decoration:underline; }
a:active { background-color:transparent; color:green; text-decoration:underline; }
a.ex:link, a.ex:visited { background-color:transparent; color:red; text-decoration:none; }
a.ex:hover,a.ex:active { background-color:transparent; color:green; text-decoration:underline; }
table.index img { border:1px solid red; margin-bottom:5px; }
table.index img:hover { border-color:green; }
/* table.index em.dir:hover { border:1px solid red; padding:12px; } */
`,
# 自由に追加編集
CUSTOM => q`
body { background-color:#ffffff; color:#333333; }
small { font-size:80%; } /* etc. */
`,
);
my $s = shift;
(defined $s && exists $CSS{$s}) ? $CSS{$s} : $CSS{DEFAULT};
} # _style end
# Script END
]]>