#!/usr/local/bin/perl
#!D:/Perl/bin/perl.exe

#---------------------------------------------------------------------------------
# ファイル一覧のhtml作成用Perlスクリプト
# ＵＲＬ：http://sakaguch.com        電子メール：http://sakaguch.com/cgi/postmail/ より送信して下さい。
# ファイル名：FileList.pl           2003.02.21 作成：鷹の巣
#--------------------------------------------------------------------------------- 
# 参考URL：なし。ただし、C言語では、下記のURLが再帰呼び出しの参考になります。
#	   パソコン基礎知識 C 言語編 (その九) 再帰呼び出し処理 - ディレクトリ検索 - SAK Streets
#	   http://homepage2.nifty.com/sak/w_sak3/doc/syspc/c_k09.htm
#--------------------------------------------------------------------------------- 
# 改版記録：
# 2002.08.04 Rev.0.000 初版
# 2003.01.19 Rev.0.100 ファイル一覧のhtml作成用に変更。
# 2003.02.21 Rev.1.000 コメントを追加して、公開。
# 2003.03.15 Rev.1.001 ファイル形式検出の誤動作のため、一部コメント行に変更。
# 2004.06.05 Rev.1.002 取得する対象ファイル名の拡張子の初期設定値を変更。
$ver = 'FileList.pl   Rev.1.002(作成：鷹の巣)';
#--------------------------------------------------------------------------------- 
# 1.用途
#
# 　このPerlスクリプトは、フリーソフトです。詳細は、項4をご一読願います。
#
# 　このPerlスクリプトは、httpdドキュメントルート以下の全てのディレクトリ内の
# 　ファイル名を取得し、ファイル一覧のhtmlファイルを作成します。
#
# 　元々は、指定ディレクトリ以下の全てのディレクトリ内のファイル名を取得する
# 　再帰呼び出しの練習用スクリプトとして作成しました。
# 　しかし、これだけでは何の役にも立たないので、ロボット検索のクローラ用の
# 　ファイル一覧のhtmlファイルを作成を行なうように変更したものです。
# 　Googleでは、リンク先のURLを100未満にする勧告がありますので、ご注意願います。
#
# 　クライアント機で処理することを前提にしている為、サーバーへの負荷を小さく出来ます。
# 　（というか、サーバー機で実行するものではありません。）
#
# 　この機会に是非、クライアント機にPerlをインストールして、
# 　このスクリプトを実行して下さい。
# 　
#--------------------------------------------------------------------------------- 
# 2.作成されるファイルの表示例と特徴
#
# 　作成されるhtmlファイルの表示例は、以下のURLのリンク先に設置しています。
# 　http://sakaguch.com/AccessUp.html#Crawler
#
# 　○利点：httpdドキュメントルート以下の全てのディレクトリ内のファイル名から、
# 　　　　　ロボット検索のクローラ用のhtmlファイルを作成を一気に行なうので、
# 　　　　　クローラ用のhtmlファイルを作成する手間が多少は、はぶける。
# 　　　　　取得したファイル名をディスクに書き出すので、メモリを要求しない。
#
# 　○欠点：クライアント機にPerlをインストールしなければならない。
# 　　　　　スクリプトの読みやすさに重点を置いているので、処理速度が遅い。
# 　　　　　取得したファイル名をディスクに書き出すので、処理速度が遅い。
#
#--------------------------------------------------------------------------------- 
# 3.ご注意事項
#
# 　このスクリプトは、Windows 2000 Professional
# 　Active Perl 5.8.4.810 built for MSWin32-x86-multi-thread
# 　の環境にて、動作確認を行っております。
# 　基本的にPerl5以降でしか、動作しません。
#
# 　このスクリプトに対するご質問や不具合がございましたら、電子メールで、
# 　webmaster@sakaguch.com まで、お寄せ下さい。
# 　また、「鷹の巣」の自宅サーバー掲示板
# 　http://sakaguch.com/cgi/bbs/
# 　にご投稿して頂いても結構です。
#
#--------------------------------------------------------------------------------- 
# 4.著作権
#
# 　このスクリプトは、鷹の巣が作成しましたが、著作権は放棄しています。
# 　スクリプトの再配布や改造は自由ですが、無償として下さい。
# 　いかなる目的であっても、このスクリプトに付加価値をつけて、
# 　有償配布してはなりません。
#
#--------------------------------------------------------------------------------- 
# 5.起動方法
#
# 　コマンドラインから、perl FileList.plを実行します。
#
#--------------------------------------------------------------------------------- 
# 6.その他
#
# 　サブルーチンでファイルハンドルを局所変数として使用しています。
# 　動作確認は行なっていますが、Perlのベテランの方から怒られるかもしれません。
#
# 　ファイル名の取得だけでしたら、
# 　@FILTERの設定と&out_files ( $first_dir_path , $out_file_name );
# 　の呼び出しだけで、可能です。
#
# 　Perlの練習用として作成していますので、特殊なモジュールは使用していません。
#
#--------------------------------------------------------------------------------- 

#--------------------------- 
#■□■ 基本設定 ■□■
#--------------------------- 

# HTMLドキュメントルートのディレクトリ（フォルダ）の設定
$document_root = "D:/www/public_html";

# HTMLドキュメントルートのURLの設定
# URLを表示する場合は、$Rep_URL = "http://www.example.com";と設定。
# ファイル名だけの表示で良い場合は、$Rep_URL = ".";と設定。
#$Rep_URL = "http://www.example.com";
$Rep_URL = ".";

# html出力ファイル名の指定
#$html_out_file_name = "$document_root/FileList.html";
$html_out_file_name = "./FileList.html";

################# ファイル取得関係の設定 #################
# 取得する対象ファイル名の拡張子（末尾一致文字列）の設定
# 　指定しない場合の記入例：@FILTER = ( "" );
@FILTER = ( ".html" , ".htm" , ".sht" , ".shtml" , ".txt" );

# 開始ディレクトリ（フォルダ）の設定
$first_dir_path = $document_root;

# 出力ファイル名の設定（無指定時は、画面（標準出力）に出力します。）
$out_file_name = "./file.txt";
################# ファイル取得関係の設定おわり #################

#--------------------------- 
#■□■ 基本設定の終わり ■□■
#--------------------------- 

#----------------------------
# HTMLのヘッダーデータの設定
#----------------------------
# 作成されたhtmlファイルをそのままご使用になる場合は、
# 以下のデータもご訂正願います。
sub html_header_set {
	# 作成するHTMLファイルの書式バージョンの設定
	# 　わからなければ、HTML 4.01 strict用を選択すること。
	#$HTMLver = "XHTML 1.1"; 	# XHTML 1.1用
	#$HTMLver = "XHTML 1.0 strict";	# XHTML 1.0 strict用
	$HTMLver = "HTML 4.01 strict";	# HTML 4.01 strict用

	# 作成するHTMLファイル上部に挿入するリンクやバナー
	# 　先頭付近に必ず、<a name="top" id="top">適当な文字</a>というリンクを必ず入れること！！！
	# 　ただし、XHTML 1.1では、<a id="top">とすること。
	# 　<b><i>の等の非推奨タグを使用したり、タグを大文字で書くと、
	# 　Another HTML-lint gatewayの減点対象となりますので、ご注意願います。
	# 　（あらかじめ、上記のサイトで$banner1部分のタグを試験されることを推奨します。）
	$banner = <<'BANNER';
<p class="center"><strong><a name="top" id="top">｜</a><a href="./">目次</a>｜</strong></p>
BANNER

	$charset = "Shift_JIS";
	$description = "サイト内のファイルの一覧を表\示します。";
	$KeyWords = "サイト,ファイル一覧";
	$mailaddress = "webmaster\@example.com";
	$webmaster = "管理者名";
	$prevpage = "./index.html";
	$title = "サイト内ファイル一覧";
	# $sakusei = "20XX年XX月XX日";
	$sakusei = "";
}

#--------------------------- 
#　設定の終わり
#--------------------------- 


&main ( $first_dir_path , $out_file_name , $html_out_file_name );
exit;


#----------------
# 主回路
#----------------
sub main {
	( $first_dir_path , $out_file_name , $html_out_file_name ) = @_;
	print "$ver\n";
	open( $OUT_HANDLE , "> $html_out_file_name" ) || &error ( $file );
		# HTMLのヘッダーデータの設定
		&html_header_set;
		# HTMLのヘッダー作成
		&html_header ($OUT_HANDLE, $HTMLver, $charset, $description, $KeyWords, $mailaddress, $webmaster, $prevpage, $title, $banner, $sakusei);
		# ディレクトリ（フォルダ）階層下の全ファイル名を取得する。
		print "ファイル名を取得中です。\n";
		&out_files ( $first_dir_path , $out_file_name );
		# ファイル名からURLへの変換回路
		&rep_url_anker ($OUT_HANDLE, $out_file_name , $html_out_file_name , $HTMLver , $document_root , $Rep_URL );
		# HTMLのフッター作成
		&html_footer ( $OUT_HANDLE , $HTMLver );
	close ( $OUT_HANDLE );
}

#----------------------------------
# ファイル名取得とハンドル設定回路
#----------------------------------
sub out_files {
	# ディレクトリ（フォルダ）階層下の全ファイル名を取得する。
	# （出力ファイル名が指定されていない場合は、標準出力に出力します。）
	# 
	# 入力：$dir_path - 開始ディレクトリ（フォルダ）名
	# 　　　$file     - 出力ファイル名
	# 出力：$file     - $fileにファイル名を書き出し。

	my ( $dir_path , $file ) = @_;
	if ( $file eq "") {
		# 出力ファイル名が指定されていない場合は、
		# 取得したファイル名を画面（標準出力）に出力する。
		$FILE_NAME_OUT_HANDLE = "STDOUT";
		&get_files ( $dir_path ) ;
	} else {
		# ファイル$fileに出力する場合は、
		# 取得したファイル名をファイルハンドル$OUT_HANDLEに出力する。
		open( $FILE_NAME_OUT_HANDLE , "> $file" ) || &error ( $file );
			&get_files ( $dir_path );
		close ( $FILE_NAME_OUT_HANDLE );
	}
}

#--------------------
# ファイル名取得回路
#--------------------
sub get_files {
	# ディレクトリ（フォルダ）階層下の全ファイル名を取得する。
	# （テキストファイル以外を除外するように指定しています。）
	# 
	# 入力：　　　　　　 $dir_path             - ディレクトリ（フォルダ）名
	# 　　　広域変数　　 @FILTER               - ファイル名末尾の文字列の配列
	# 　　　呼出し側変数 $FILE_NAME_OUT_HANDLE - 出力ファイルハンドル
	# 
	# 出力：ファイルハンドル$FILE_NAME_OUT_HANDLEで指定したファイルファイル名を書き出し。

	my ($dir_path ) = $_[0];
	my ( $IN_HANDLE , $file , @file );
	# ディレクトリ（フォルダ）を指定して、ファイル名を取得する。
	opendir ( $IN_HANDLE , $dir_path ) || &error ( $dir_path );
		@file = readdir ( $IN_HANDLE );
	closedir ( $IN_HANDLE );

	# 取得したファイル名の検査
	foreach $file ( @file ) {
		# カレントディレクトリと親ディレクトリを除外
		if ( ( $file eq "." ) or ( $file eq ".." ) ) { next; }
		# ファイル名にファイルパスを追加する。
		$path_file = "$dir_path/$file";
# バイナリファイルを除外。
# 2003.03.15 誤動作のため、コメント行に変更 if ( -B $path_file ) { next; }
		if ( -d $path_file ) {
			# ファイル名がディレクトリ（フォルダ）の場合、
			# ディレクトリ（フォルダ）のファイル名を取得する。（再帰呼び出し）
			&get_files ( $path_file ) ;
		 } else {
			# ファイル名が通常のファイルの場合、標準出力へ出力する。
# テキストファイル以外を除外。
# 2003.03.15 誤動作のため、コメント行に変更 if ( !( -T $path_file ) ) { next; }
			# ファイル名末尾の文字列を検査し、標準出力へ出力する。
			$flag = 0; foreach $filter ( @FILTER ) { if ( $file =~ /$filter$/ ) { $flag = 1; last; } }
			if ($flag) { print $FILE_NAME_OUT_HANDLE "$path_file\n"; }
		}
	}
}

#-------------------------------
# ファイル名からURLへの変換回路
#-------------------------------
sub rep_url_anker {
	my ( $OUT_HANDLE , $in_file_name , $out_file_name , $HTMLver , $document_root , $Rep_URL ) = @_;
	my ( $IN_HANDLE );
	open ( $IN_HANDLE  , "< $in_file_name" ) || &error("Open Error : $in_file_name" );
		print "$in_file_nameを処理中です。\n";
		$count = 0;
		if ($HTMLver eq "HTML 4.01 strict") { $br = "<br>"; } else { $br = "<br />"; }
		while ( $_ = <$IN_HANDLE> ) {
			# 行末の改行コードを取り除く。
			chomp( $_ );
			$_ =~ s|^$document_root|$Rep_URL|;
			print $OUT_HANDLE "<a href=\"$_\">";
			$_ =~ s|^$Rep_URL/||;
			print $OUT_HANDLE "$_</a>$br\n";
			$count++;
		}
	close ( $IN_HANDLE );
	print "$countのリンク数がありました。\n";
}

#--------------------
# HTMLのヘッダー作成
#--------------------
sub html_header {
	my ($OUT_HANDLE, $HTMLver, $charset, $description, $KeyWords, $mailaddress, $webmaster, $prevpage, $title, $banner, $sakusei) = @_;
	if ($HTMLver eq "HTML 4.01 strict") {
		# HTML 4.01 strict用
		print $OUT_HANDLE <<"HTML";
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html lang="ja">
HTML

	} elsif ($HTMLver eq "XHTML 1.0 strict") {
		# XHTML 1.0 strict用
		print $OUT_HANDLE <<"HTML";
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja" lang="ja">
HTML

	} else {
		# XHTML 1.1用
		print $OUT_HANDLE <<"HTML";
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja">
HTML

	}

	$sakusei = &get_time ( $sakusei );

	$hed = <<"HTML";
<head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=$charset" />
<meta http-equiv="Content-Language" content="ja" />
<meta http-equiv="Content-Style-Type" content="text/css" />
<meta http-equiv="Content-Script-Type" content="text/javascript" />
<meta name="description" content="$description" />
<meta name="KeyWords" content="$KeyWords" />
<meta name="robots" content="INDEX,FOLLOW" />
<style type="text/css">
HTML

if ($HTMLver eq "HTML 4.01 strict") { $hed = $hed . "<!-- style sheet\n"; }

	$hed = $hed . <<"HTML";
a:link    {font-weight:normal; color:blue ; text-decoration:underline;}
a:active  {font-weight:normal; color:red  ; text-decoration:underline;}
a:visited {font-weight:normal; color:green; text-decoration:underline;}
a:hover   {font-weight:normal; color:black; text-decoration:underline; background-color:aqua;}
body      {background-color:#white; text-align:left; color:#black;}
.center   {text-align:center;}
.red      {color:red;}
HTML

if ($HTMLver eq "HTML 4.01 strict") { $hed = $hed . "//  -->\n"; }

	$hed = $hed . <<"HTML";
</style>
<link rev="made" href="mailto:$mailaddress" />
<link rel="index" href="/index.html" />
<link rel="contents" href="/index.html" />
<link rel="prev" href="$prevpage" />
<title>$title</title>
</head>
<body>
<div>
$banner<address><span class="red">$sakusei　作成：<a href="mailto:$mailaddress">$webmaster</a></span></address>
$description<br />
<hr />
<div class="center"><input type="button" value="　戻　る　" onclick="history.go(-1)" onkeypress="history.go(-1)" style="font-size: 14pt;background-color: #000080; color: white; font-weight: bold; border-style: solid" tabindex="100" accesskey="R" />
</div>
<h1>$title</h1>
HTML

	$hed = &TagRep ( $hed , $HTMLver );
	print $OUT_HANDLE "$hed\n";

}

#--------------------
# HTMLのフッター作成
#--------------------
sub html_footer {
	my ( $OUT_HANDLE , $HTMLver ) = @_;
		$foot = <<"HTML";
<br />
<strong>｜<a href="#top">▲頁先頭</a>｜</strong>
<hr />
</div>
<div class="center"><input type="button" value="　戻　る　" onclick="history.go(-1)" onkeypress="history.go(-1)" style="font-size: 14pt;background-color: #000080; color: white; font-weight: bold; border-style: solid" tabindex="100" accesskey="R" />
</div>
<hr />
</body>
</html>
HTML

	$foot = &TagRep ( $foot , $HTMLver );
	print $OUT_HANDLE "$foot\n";

}

#------------------
# HTMLタグの置換
#------------------
sub TagRep {
	my ( $HTMLtag , $HTMLver ) = @_;
	if ($HTMLver eq "HTML 4.01 strict") {
		$HTMLtag =~ s|\s/>|>|g;
	} else {
		$HTMLtag =~ s|<hr>|<hr />|g;
		$HTMLtag =~ s|<br>|<br />|g;
	}
	return $HTMLtag;
}

#--------------
# 時間の取得
#--------------
sub get_time {
	my ( $date ) = $_[0];
	my ( $day , $mon , $year , $date );
	if ( $date eq "") {
		( $sec, $min, $hour, $day , $mon , $year ) = localtime ( time() );
		$date = "作成日：" . sprintf ( "%04d年%02d月%02d日" , $year+1900 , $mon+1 , $day );
	}
	return $date;
}

#------------------
# エラー内容表示
#------------------
sub error {
	# エラーの内容を表示して終了する。
print "$_[0]\n";
	die "$_[0] : $!";
}