#!/usr/local/bin/perl
#
# @(#) kaccess.cgi
#
#   NO RIGHTS RESERVED
#
######################################################################
# RCSID
#
# $Id: kaccess.cgi,v 2.5 2007/06/16 08:44:08 Sakaguchi Exp Sakaguchi $
######################################################################
#

#
# 参照元リスト
@Referer = (
    'http://'					# 参照元(全世界)
);

#
# ホーム・ポジション
#chdir 'home';

#
# カウンタ情報ファイル用サブフォルダ(事前に作成)
chdir 'accesses';

#
# タイムアウト秒数
$Timeout = 5;

#
# 漢数字定数
@kDigit = (
  '零',	# 零
  '一',	# 一
  '二',	# 二
  '三',	# 三
  '四',	# 四
  '五',	# 五
  '六',	# 六
  '七',	# 七
  '八',	# 八
  '九',	# 九
  '十',	# 十
  '百',	# 百
  '千',	# 千
  '萬',	# 萬
  '億',	# 億
  '祝'	# 祝
);

#
# カウント結果
@kCount = ();

#
# 「祝」クラス
$Congrat = 'KaccessCongrat';

#
# アラーム設定
&setAlarm($Timeout);

#
# クエリー解析
&parseQuery;

if (defined($Cookie)) {
    #
    # クッキー発行
    # 「クッキーを発行しました」
    &html('クッキーを発行しました');
}

#
# カウンタ情報ファイル名取得
$Filename = &getFilename;

#
# カウント現在値取得＆更新
$Count = &getCount($Filename);

#
# 漢数字変換
&kNumeric($Count);
if ($Count % 100 == 0) {
    unshift(@kCount, 15);	# 祝
}

#
# 出力
&begin('javascript');
foreach $_ (@kCount) {
    if (defined($Array)) {
	# Array出力
	&javawrite($Array, '[', $_, ']');
    } else {
	# &#シーケンス出力
	&javawrite('"<SPAN CLASS=\\"', $Congrat, '\\">"') if ($_ == 15);
	&javawrite('"', $kDigit[$_], '"');
	&javawrite('"</SPAN>"') if ($_ == 15);
    }
}
&end('javascript');

#
# アラーム・クロック
sub
setAlarm {
#   global(%SIG);
    $SIG{'ALRM'} = $SIG{'TERM'} = 'timeout';
    alarm($_[0]);
}
sub
timeout {
    # 「タイムアウトしました」
    &javascript('&#x30BF;&#x30A4;&#x30E0;&#x30A2;&#x30A6;&#x30C8;&#x3057;&#x307E;&#x3057;&#x305F;');
}

#
# クエリー解析
sub
parseQuery {
#   global($Array);		# 漢数字配列
#   global($Congrat);		# 「祝」クラス
#   global($Referer);		# 参照元URL
#   global($Cookie);		# 発行クッキー
#   global($Exclude);		# アクセス排除フラグ
    local(@_, $_);

    foreach $_ (split('&', $ENV{'QUERY_STRING'})) {

	if (s/^a=//i) {
	    # 漢数字配列
	    $Array = &decode($_);

	} elsif (s/^c=//i) {
	    # 「祝」クラス
	    $Congrat = &decode($_);

	} elsif (s/^r=//i) {
	    # 参照元URL
	    $Referer = &decode($_);

	} elsif (s/^x-cookie//i) {
	    # クッキ発行
	    $Cookie
		= sprintf('KACCESS_EXCL=1; path=%s; expires=%s',
			  $ENV{'REQUEST_URI'},			# パス情報
			  'Tue, 19-Jan-2038 03:14:07 GMT');	# 遠い先

	} elsif (s/^x//i &&
		 index($ENV{'HTTP_COOKIE'}, 'KACCESS_EXCL=1') >= 0) {
	    # 自己アクセス排除
	    $Exclude = 1;

	}
    }
}

#
# サブ・パス取得
sub
getFilename {
#   global(@Referer);		# 参照元リスト
#   global($Referer);		# 参照元URL
    local($filename, $ref);

    unless (defined($Referer)) {
	# CGI変数から参照元を取得

	# $HTTP_REFERERが示すURLをカウント対象とする
	$Referer = ($ENV{'HTTP_REFERER'} || $ENV{'REFERER_URL'});
    }

    # URLを調整
    $Referer =~ s|\#.*$||;
    $Referer =~ s|\?.*$||;
    if ($Referer =~ m|/$|) {
	$Referer .= 'index.html';
    }

    # 参照元リストと照合してファイル名に変換
    foreach $ref (@Referer) {
	if (index($Referer, $ref) == 0) {
	    $filename = substr($Referer, length($ref));
	    last;
	}
    }

    if (defined($filename)) {
	$filename =~ s|\W|_|g;
	return $filename;

    } else {
	# 「不正な参照元です」
	&javascript('&#x4E0D;&#x6B63;&#x306A;&#x53C2;&#x7167;&#x5143;&#x3067;&#x3059;: '.$Referer);

    }
}

#
# カウント現在値取得＆更新
sub
getCount {
#   global($Exclude);		# アクセス排除フラグ
    local($path) = @_;
    local($count, $_);

    # 「汚染」モード対策
    if ($path =~ /^(\w+)$/) {
	$path = $1;
    } else {
	die;
    }

    $count = 0;
    if (open(RW, "+<$path")
	|| open(RW, "+>$path")) {

	# ロック(読書)
	flock(RW, 2);

	# 取得
	while (<RW>) {
	    $count += int($_);
	    last;
	}

	unless ($Exclude) {

	    # カウント・アップ
	    ++$count;

	    # 更新
	    seek(RW, 0, 0);
	    print RW $count, "\n";
	}

	# 解除
	close RW;

    } else {
	# 「ファイルに書けません」
	&javascript('&#x30D5;&#x30A1;&#x30A4;&#x30EB;&#x306B;&#x66F8;&#x3051;&#x307E;&#x305B;&#x3093;: '.$path);

    }

    $count;
}

#
# 漢数字変換
sub
kNumeric {
#   global(@kCount);		# カウント結果
    local($count) = @_;
    local($k, $d);
    $k = '';

    if ($count >= 100000000) {
	&kNumeric(int($count / 100000000));
	push(@kCount, 14);	# 億
	$count %= 100000000;
    }

    if ($count >= 10000) {
	&kNumeric(int($count / 10000));
	push(@kCount, 13);	# 萬
	$count %= 10000;
    }

    if ($count >= 1000) {
	$d = int($count / 1000);
	push(@kCount, $d) if ($d > 1);
	push(@kCount, 12);	# 千
	$count %= 1000;
    }

    if ($count >= 100) {
	$d = int($count / 100);
	push(@kCount, $d) if ($d > 1);
	push(@kCount, 11);	# 百
	$count %= 100;
    }

    if ($count >= 10) {
	$d = int($count / 10);
	push(@kCount, $d) if ($d > 1);
	push(@kCount, 10);	# 十
	$count %= 10;
    }

    if (@kCount == 0 || $count > 0) {
	push(@kCount, $count);
    }

    $k;
}

#
# 出力開始
sub
begin {
#   global($Cookie);		# 発行クッキー
#   global($Begun);		# 出力開始済みフラグ
    return if ($Begun);
    local($type) = @_;		# コンテント・タイプ

    # 共通ヘッダ
    print <<EOF;
Content-Type: text/$type\r
Pragma: no-cache\r
Cache-Control: no-cache\r
Expires: 0\r
EOF
    if (defined($Cookie)) {
	# クッキー発行
	print
	    'P3P: CP="NOI"', "\r\n",
	    'Set-Cookie: ', $Cookie, "\r\n";
    }
    print "\r\n";

    if ($type eq 'html') {
	# HTMLのみ
	print "<HTML>\r\n<HEAD>\r\n";
	if (defined($Cookie)) {
	    # クッキー発行
	    printf
		"<META HTTP-EQUV=\"Set-Cookie\" CONTENT=\"%s\" />\r\n",
		$Cookie;
	}
	print "</HEAD>\r\n<BODY>\r\n";
    }	

    $Begun = 1;
}

#
# 出力終了
sub
end {
#   global($Begun);		# 出力開始済みフラグ
    return unless ($Begun);
    local($type) = @_;		# コンテント・タイプ

    if ($type eq 'html') {
	# HTMLのみ
	print "</BODY>\r\n</HTML>\r\n";
    }
    exit 0;
}

#
# JavaScript出力
sub
javascript {
    local($_) = join('', @_);
    &begin('javascript');
    &javawrite('"', $_, '"');
    &end('javascript');
}
sub
javawrite {
    local($_) = join('', @_);
    print 'document.write(', $_, ')', "\r\n";
}

#
# HTML出力
sub
html {
    local($_) = join('', @_);
    &begin('html');
    print $_, "\r\n";
    &end('html');
}

#
# URLデコード
sub
decode {
    local($_) = @_;
    s/\+/ /g;
    s/%(\w\w)/sprintf('%c', hex($1))/ge;
    $_;
}