#!/usr/bin/perl -w
use strict;

# ------------------------------------------------------------------------
# index.fet - Server Side FindF
# Copyright (C) 2001-2005 mxproject. All rights reserved.
# ------------------------------------------------------------------------
# 2002/08/03    1.00    CGI 化。md5 形式での出力対応。ただし鬼遅い。
# 2002/08/24    1.01    Last-Modified ヘッダを吐くようにした。
# 2003/04/19    1.02    細部の修正。
# 2005/04/11    2.00    大幅書き直し。Digest::MD5 を使用するように。
# 2006/03/01    2.01    HTTP ヘッダの Sun が Sat になっているのに今更気づいた
# ------------------------------------------------------------------------
# このスクリプトは Web サーバ上で CGI として動作します。
# 呼び出された時点で指定されたディレクトリを走査し、index.fet を出力します。
# これにより、ペルソナの更新作業時にローカルで FindF を実行させる手間を
# 省くことができます。
#
# 拡張子 fet のファイルを CGI として動作させる設定が必要です。
# 例えば、 .htaccess に
# <Files index.fet>
# 	SetHandler cgi-script
# </Files>
# と書いて置くなど。
# 詳しくは Web サーバのマニュアルを御覧ください。
# ------------------------------------------------------------------------

# Fetch 対象ディレクトリ
# 通常 index.fet は更新データディレクトリの
# ルートに位置するので、変更不要なはず
my $fetchdir = '.';

# 次回更新日時
#
# フォーマット:
#   1) y年m月d日 h時s分                          → 'y m d h s'
#   2) 毎週n曜日 h時s分 (1:日, 2:月, ... , 7:土) → 'w n h s'
#   3) 毎月d日   h時s分                          → 'm d h s'
#
# カンマ区切りで複数指定可能。
my @nextupdate = (
	'm 1 9 0',
);

# データセット指定 (パス区切りは '/', 複数指定可)
my @dataset = (
);

# 出力フォーマット [date|md5|auto]
# 通常は auto で問題ない
my $outformat = 'md5';

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

# 出力形式の決定
if($outformat eq 'auto')
{
	if($ENV{'HTTP_USER_AGENT'} =~ /^PersonaWare\/[01]/i)
	{
		# PWS 0.9x / 1.xx なら date 形式
		$outformat = 'date';
	}
	else
	{
		# 2.x 以降は md5 形式
		$outformat = 'md5';
	}
}
if($outformat eq 'md5')
{
	eval('require Digest::MD5;');
	if($@)
	{
		# Digest::MD5 が使用できない場合、旧形式のフォーマットを使用
		$outformat = 'date';
	}
}

# 文字列末の '\', '/' を削除
$fetchdir =~ s/[\/\\]$//;


# ファイルリストを作成
my @fet_list = ();
my $lastmod = &get_fetlist($fetchdir, \@fet_list);

# HTTP ヘッダ出力
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdat) = gmtime($lastmod);
print "Content-Type: text/html\n";
printf "Last-Modified: %s, %02d %s %04d %02d:%02d:%02d GMT\n\n",
	('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$wday],
	$mday,
	('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$mon],
	$year+1900, $hour, $min, $sec;

# 次回更新日時の出力
print "#NextUpdate ";
foreach(@nextupdate)
{
	if($_ ne $nextupdate[$#nextupdate])
	{
		print "$_,";
	}
	else
	{
		print "$_\r\n";
	}
}

# フィールド情報の出力
if($outformat eq 'md5')
{
	print "#FieldInfo md5 32 attr 1 bsize 10\r\n";
}
else
{
	print "#FieldInfo date 12 attr 1 size 5\n";
}

# ファイル・ディレクトリ情報出力
foreach(@fet_list)
{
	print "$_\r\n";
}

exit;



sub get_fetlist($\@;$$)
{
	my $dir = shift;
	my $list_ref = shift;
	my $level = shift || 0;
	my $lastmodtime = shift || 0;

	local *DH;

	opendir(DH, $dir) or die "Can't open directory $dir: $!\n";
	foreach(readdir(DH))
	{
		# ".*", "*.fet" は追加しない
		next if(/(?:^(\.)|\.fet$)/);

		my $name = $_;
		my $path = $dir.'/'.$name;

		# ファイル情報を取得
		my($dev, $inode, $mode, $nol, $userid, $grpid, $rdev,
		   $size, $atime, $mtime, $ctime, $blksize, $nob) = stat($path);
		my($sec, $min, $hour, $date, $month, $year, $day, $isdst) = gmtime($mtime);

		# ファイル or ディレクトリ
		my $type = (-f $path) ? 'f' : 'd';
		if($type eq 'd')
		{
			$size = 0;
		}

		# 全ファイルの中で一番新しいファイルのタイムスタンプを得る
		if($type eq 'f')
		{
			$lastmodtime = $mtime if($lastmodtime < $mtime);
		}

		# データセット
		foreach(@dataset)
		{
			my $dset = $_;
			my $npath = $path;
			$npath =~ s/^\Q$fetchdir\/\E//;

			if($dset eq $npath)
			{
				$dset =~ s/\//\\/g;

				push(@$list_ref, '#DataSet '.$dset);
			}
		}

		# 行を生成
		my $line;
		if($outformat eq 'md5')
		{
			my $md5sum = 0;

			if($type eq 'f')
			{
				open(FH, $path) or die "Can't open $path: $!\n";
				binmode(FH);

				my $md5 = Digest::MD5->new;
				$md5->addfile(*FH);
				$md5sum = $md5->hexdigest;

				close(FH) or die "Can't close $path: $!\n";
			}
			$line = sprintf('%032s%s%010d%s+%s',
							$md5sum,
							$type, $size, '|' x $level, $name);
		}
		else
		{
			$line = sprintf('%04d%02d%02d%02d%02d%s%05d%s+%s',
							$year+1900, $month+1, $date, $hour, $min,
							$type, $size/1024, '|' x $level, $name);
		}

		# 行を追加
		push(@$list_ref, $line);

		# サブディレクトリ内の走査
		if($type eq 'd')
		{
			$lastmodtime = &get_fetlist($path, $list_ref, $level+1, $lastmodtime);
		}
	}
	closedir(DH) or die "Can't close directory $dir: $!\n";

	return $lastmodtime;
}