#!/usr/bin/perl -w

#-----------------------------------------------------------------------------------------------
# Lx    by Lilia [2003-10-20]
#-----------------------------------------------------------------------------------------------

# カレントディレクトリのインデックスを表示するスクリプト
# * SSI 対応版

# デバッグ用
#-----------------------------------------------------------------------------------------------
# BEGIN {
# 	use CGI::Carp qw(carpout);
# 	open(ERR, ">>error.log") or
# 	  die("Unable to open error.log: $!");
# 	carpout(\*ERR);
# }
#-----------------------------------------------------------------------------------------------

use strict;
use CGI::Carp qw(fatalsToBrowser);
use Cwd;
use POSIX qw(strftime);
use vars qw(%Ini);

%Ini = (
	Script      =>  q[Lx],
	Sign        =>  q[script by Lilia],
	Dist        =>  q[http://nursery.s8.xrea.com/],

#-----------------------------------------------------------------------------------------------

	# タイトルの書式1 -- <title> 〜 </title> 内
	# %s にディレクトリのパスが入る
	Title1      =>  'Index of %s',
	# タイトルの書式2 -- ページ上部
	Title2      =>  'Index of %s',

	# サブディレクトリは上にまとめる { 0:無効 / 1:有効 }
	Folders1st  =>  1,

	# 一覧から除外するファイルの正規表現（わからなければこのまま）
	IgnoRE      =>  qr/^\./,
# 	IgnoRE      =>  qr/^\.|^(?:error\.log|go\.cgi)$/i, # 参考

	#-- 次は環境によっては動作しないのでエラーが出たら設定を見直す
	# ディレクトリの最終更新日時を変更して最新のファイルに一致させる { 0:無効 / 1:有効 }
	TLastMod    =>  0,

	#-- 次は特殊な設定なのでとくに問題がなければコメントアウト
	# 実際のホームディレクトリの絶対パス（タイトル内のカレントディレクトリ表記が不要なパスを含んでいる場合に設定）
# 	MyDocRoot   =>  '/y/u/l/yulilia', # 参考

	#-- 以下は出力する HTML のオプション的な設定なので不要ならすべてコメントアウト可
	# スタイルシート
	Style      =>  q`
<meta http-equiv="content-style-type" content="text/css">
<style type="text/css">
<!--
body    { font-size:90%; font-family:Arial,Helvetica,Verdana,'MS PGothic',Osaka,sans-serif; }
small   { font-size:90%; }
-->
</style>`,

	# メタタグの追加等
	Metas      =>  q`
<link rel="start" href="/" title="home">
<link rel="up" href="../">`,

	# 下部に挿入するバナー等
	Footer      =>  ($ENV{SERVER_NAME} && $ENV{SERVER_NAME} =~ /xrea\.com/i)
	  ? qq`
<!-- xrea banner --><br>
<small>[ xrea ad banner ]<br></small>
<a href="http://ad.xrea.com/ad_click.fcg?site=$ENV{SERVER_NAME}" target="_blank"><img src="http://ad.xrea.com/ad_img.fcg?site=$ENV{SERVER_NAME}" width=468 height=60 border=0 alt="xrea ad banner"></a><br>
`
	  : '',
# 	# 単純な例
# 	Footer      =>  qq`
# <!-- xrea banner --><br>
# <small>[ xrea ad banner ]<br></small>
# <a href="http://ad.xrea.com/ad_click.fcg?site=$ENV{SERVER_NAME}" target="_blank"><img src="http://ad.xrea.com/ad_img.fcg?site=$ENV{SERVER_NAME}" width=468 height=60 border=0 alt="xrea ad banner"></a><br>
# `,

	#-- 最後は利用法自体を変更する設定なので必要がなければ説明ごと無視して可
	# SSI を使用して実行する { 0:無効 / 1:有効 / 2:リストアイテムのみ出力 }
	SSI         =>  0,
	# 簡単な（必ずしもわかりやすくはない）説明:
	#  このオプションが有効なとき、SSI を使用して実行した場合には、スクリプト本体の置かれているディレクトリではなく
	#  その SSI ディレクティブが記述されたファイルの置かれているディレクトリのインデックスを出力する
	#  たとえば /sub にアクセスされたときにそのディレクトリのインデックスをこのスクリプトを利用して表示したい場合
	#  「<!--#include virtual="../cgi-bin/pub/index.cgi" -->」というような1行だけの index.shtml
	#  を /sub に置けばいい（コマンドおよびファイル名等は環境による）
	#  表示する HTML の前後の部分は自分で用意し、リスト項目である <li> 〜 </li> の部分だけを出力させたいならば
	#  2 をセットすればいいが、この部分的出力には前後の <ul> および </ul> タグも含まれないことに注意
	#  なおこの例の場合、普通に /cgi-bin/pub/index.cgi として直接このスクリプトにアクセスされ実行されたときには
	#  /cgi-bin/pub のインデックスを表示する
	#  つまりあるディレクトリのインデックスを表示させるためにこのスクリプトを設置しておきながら、他のディレクトリから
	#  SSI を使用して実行することによって複数ディレクトリのインデックス表示にも利用できるということ
	#  このオプションが有効になっていても SSI を使用せずに実行する通常の利用には支障がない（はず）

#-----------------------------------------------------------------------------------------------
);

# 設定の確認と修正
foreach($Ini{Title1},$Ini{Title2},$Ini{Style},$Ini{Metas},$Ini{Footer}) { $_  = '' unless(defined); }
$Ini{IgnoRE} = '(?-xism:^$)' if(!defined $Ini{IgnoRE} || $Ini{IgnoRE} eq '' || $Ini{IgnoRE} eq '(?-xism:)');

my $dir_path = '.';                 # ディレクトリのパス
my($myself) = $0 =~ m|([^/\\]+)$|;  # このスクリプト自身のファイル名

my $dir_name = $dir_path;
my $pub = (defined $Ini{MyDocRoot}) ? $Ini{MyDocRoot} : '';
$pub =~ s|^/?|/| if($pub ne '');
$pub =~ s|/?$||;
$pub =~ s/^\Q$ENV{DOCUMENT_ROOT}\E//i if($ENV{DOCUMENT_ROOT});

my $li_only = 0;
my $ssi_mode = ($Ini{SSI} && ($ENV{SERVER_PROTOCOL} =~ /INCLUDED/ || (exists $ENV{DOCUMENT_NAME} && exists $ENV{DOCUMENT_URI} && exists $ENV{LAST_MODIFIED})))
             ? $Ini{SSI} : 0;
if($ssi_mode) { # 呼出し元ディレクトリのパスを取得
	my $doc_uri = $ENV{DOCUMENT_URI} ? $ENV{DOCUMENT_URI} : $ENV{REQUEST_URI};  # REQUEST_URI もないサーバは知らない
	my $doc_name = (defined $ENV{DOCUMENT_NAME}) ? quotemeta($ENV{DOCUMENT_NAME}) : qr([^/\\]*);
	($dir_path = $doc_uri) =~ s|/($doc_name)$||i;
	$myself = $1;
	$li_only = 1 if($ssi_mode == 2);
	$dir_name = $dir_path;
	$dir_path = $ENV{DOCUMENT_ROOT} . $dir_path if($ENV{DOCUMENT_ROOT});
	$dir_path = _alt($dir_path,$pub) if(!-d $dir_path && $dir_path ne '');  # そのままで開けない場合ちょっと頑張る
	$dir_path = '/' if($dir_path eq '');
} else { # タイトル表示用にカレントディレクトリの絶対パスを取得 (unless you specified another dir)
	$dir_name = $1 if($dir_name eq '.' && $ENV{SCRIPT_NAME} && $ENV{SCRIPT_NAME} =~ m|^(.*)/[^/]+$|);
	$dir_name = $1 if($dir_name eq '.' && $ENV{REQUEST_URI} && $ENV{REQUEST_URI} =~ m|^(.*)/[^/]*$|);
	$dir_name = cwd || getcwd if($dir_name eq '.');
}
$dir_name =~ s/^\Q$ENV{DOCUMENT_ROOT}\E//i if($ENV{DOCUMENT_ROOT});
$dir_name =~ s/^\Q$pub\E//i;
$dir_name =~ s|/?$||;
$dir_name = '/' if($dir_name eq '');

$Ini{Title1} = sprintf($Ini{Title1}, $dir_name);
$Ini{Title2} = sprintf($Ini{Title2}, $dir_name);

# ディレクトリ内のファイルリストを取得
my @files;
opendir(DIR, $dir_path) or
  die("Unable to opendir $dir_path: $!");
foreach(grep(!/$Ini{IgnoRE}/o, readdir(DIR))) {
	next if($_ eq $myself || !/\w/);  # 無効なファイルを除外
	push @files, $_;
}
closedir(DIR);

if($Ini{Folders1st}) {
	@files = sort {(-d "$dir_path/$b") cmp (-d "$dir_path/$a") or lc($a) cmp lc($b)} @files;
} else {
	@files = sort {lc($a) cmp lc($b)} @files;
}

print "Content-Type: text/html; charset=Shift_JIS\n\n";
print <<"_HTML_" unless($li_only);
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja">
<head>
<meta name="robots" content="NONE">
<meta http-equiv="content-type" content="text/html; charset=shift_jis">$Ini{Style}$Ini{Metas}
<title>$Ini{Title1}</title>
</head>
<body>

<h1>$Ini{Title2}</h1>

<a href="../">Parent Directory</a>

<hr><ul>
_HTML_

my $lmtime = 0;  # リスト中で最新のファイルの最終更新日時
foreach(@files) { # 最終更新時間の表記は timefj 内で自由に設定できる
	my $mtime = (stat("$dir_path/$_"))[9];
	$lmtime = ($lmtime > $mtime) ? $lmtime : $mtime;
	print +(-d _) ? qq(<li><a href="$_/" title="DIR, @{[timefj($mtime)]}">$_/</a></li>\n)
	              : qq(<li><a href="$_" title="@{[sizef(-s _) . ', ' . timefj($mtime)]}">$_</a></li>\n);
}

print "</ul><hr>\n" unless($li_only);

# ディレクトリの最終更新日時を最新のものに変更
my @touched = dtouch($lmtime,$dir_path,1) if($Ini{TLastMod} && $lmtime);
exit if($li_only);
printf("<em>&gt;&gt; %s(%d,%d, '%s') successful!</em>\n", @touched) if($touched[0]);

print <<"_HTML_";
<p>
* generated by $Ini{Script}<a href="$Ini{Dist}" title="$Ini{Sign}">.</a>
</p>
$Ini{Footer}
</body>
</html>
_HTML_

exit;

sub timef {
	my $time = shift || time;
	$time = scalar localtime($time);
	return $time;
} # timef end

sub timefj { # for Japanese users
	my $time = shift || time;

	# 1. POSIX::strftime をつかう方法
	$time = strftime("%Y/%m/%d (%a) %H:%M:%S %Z", localtime($time));  # %H:%M:%S は環境により %T でも可

	# 2. 普通の sprintf
# 	my @wstr = qw(Sun Mon Tue Wed Thu Fri Sat);  # 曜日名の設定
# 	my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time + 9 * 60 * 60);  # gmtime で確実に
# 	$time = sprintf("@{[$year + 1900]}/%02d/%02d ($wstr[$wday]) %02d:%02d:%02d JST", $mon + 1,$mday,$hour,$min,$sec);

	return $time;
} # timefj end

sub sizef {
	my $size = shift || 0;
	my($gb,$mb,$kb) = ($size / 1073741824,$size / 1048576,$size / 1024);
	$size = ($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);
	return $size;
} # sizef end

sub dtouch {
	my($mtime,$dir,$report) = @_;
	$mtime ||= time;
	$dir = '.' unless(defined $dir);
	my $now = time;
	return 0 unless($mtime > (stat($dir))[9]);  # 既に最新なら変更しない
	utime($now,$mtime, $dir) or
	  die("Unable to touch $dir: $!");  # die to tell you
	return('utime',$now,$mtime,$dir) if($report);
} # dtouch end

sub _alt {
	my($dir_path,$pub) = @_;
	my $s_dir_path = $dir_path;
	$s_dir_path =~ s/^\Q$ENV{DOCUMENT_ROOT}\E//i if($ENV{DOCUMENT_ROOT});
	return $dir_path if(-d $s_dir_path);
	if($pub ne '') {
		$s_dir_path =~ s/^\Q$pub\E//i;
		return $dir_path if(-d $s_dir_path);
		return $dir_path if(-d "$pub$s_dir_path");
		return $dir_path if($ENV{DOCUMENT_ROOT} && -d "$ENV{DOCUMENT_ROOT}$pub$s_dir_path");
	}
	my $rel_path = _rel($s_dir_path,$pub);  # 相対パスへの変換を試みる
	return ($rel_path && -d $rel_path) ? $rel_path : $dir_path;
} # _alt end

sub _rel {
	my($dir_path,$pub) = @_;
	my $doc_root = $ENV{DOCUMENT_ROOT} || '';
	my $r_dir_path = $dir_path;
	eval { require File::Spec };
	return undef if($@ || !defined File::Spec->abs2rel);
	my @self_paths = ($ENV{SCRIPT_FILENAME},$ENV{SCRIPT_NAME},'');
	foreach(@self_paths) {
		next unless(defined);
		s|^(.*)/[^/]+$|$1|;
		return '.' if(/^(?:\Q$dir_path\E|\Q$pub$dir_path\E|\Q$doc_root$pub$dir_path\E)$/i);
		$r_dir_path = File::Spec->abs2rel($dir_path, $_);
		return $r_dir_path if(-d $r_dir_path);
		$r_dir_path = File::Spec->abs2rel("$pub$dir_path", $_);
		return $r_dir_path if(-d $r_dir_path);
		$r_dir_path = File::Spec->abs2rel("$doc_root$pub$dir_path", $_);
		return $r_dir_path if(-d $r_dir_path);
	}
	return $dir_path;
} # _rel end

# Script END