#!/usr/bin/perl

# --------------------------------------
# テキストカウンタ（CGI+JavaScript）
$ver = 'ffCow v.2.04';
# 2003/7/18
# Copyright (c) 2000 Fortunefield
$auth = 'http://www.gem.hi-ho.ne.jp/fortunefield/';
# --------------------------------------
#   public_html / index.html (トップページ)
#     |
#     +-- cgi-bin [705] / ffcows.cgi [705]
#                         ffcows.dat [606]
#                         ffcows.bak [606]
#                         ffcows.lok [604]
#
# <SCRIPT type="text/javascript" src="_cgi-bin/counter/ffcow.cgi?prn=100"></SCRIPT>
#
# ======================================
# 定数群
# --------------------------------------
# データファイル名
$datafile = "ffcow.dat";

# バックアップファイル名
$backfile = "ffcow.bak";

# ロック機能（0=no, 1=flock, 2=rename）
$lockkey = 1;

# ロックファイル名
$lockfile = "ffcow.lok";

# 重複カウント防止機能（0=no, 1=yes）
$nocountkey = 1;

# 累計表示
$fig_total = "%6d";

# 日計表示（今日）
$fig_today = " Today: %04d";

# 日計表示（昨日）
$fig_yeste = " Yesterday: %04d";

# 時間帯（JST-9=日本時間）
$ENV{'TZ'} = 'JST-9';

# ======================================
# 手続き
# --------------------------------------
if ($ENV{'QUERY_STRING'} eq 'check') { &check; }
&decode;
$lockfile2 = $lockfile . time . $$;

&lock;

open IN, "$datafile" or &error("Open Error: $datafile");
@data = <IN>;
close IN;

$mday = (localtime(time))[3];
$addr = $ENV{'REMOTE_ADDR'};
@new = ();
foreach (@data) {
	@a = split /,/;
	if ($in{'pg'} eq $a[5]) { ($total, $today, $yeste, $lastmday, $lastaddr, $page) = @a; }
	else { push @new, $_; }
}

$flag = 0;
if ($nocountkey) {
	if ($mday eq $lastmday and $addr eq $lastaddr) { $flag = 1; }
}

if ($flag == 0) {
	$total++;
	if ($mday eq $lastmday) { $today++; }
	else { $yeste = $today; $today = 1; }

	if ($today == 1) {
		open IN, "$backfile" or &error("Open Error: $backfile");
		@bak = <IN>;
		close IN;
		foreach (@bak) {
			@a = split /,/;
			if ($in{'pg'} eq $a[5]) { @b = @a; }
			else { push @old, $_; }
		}
		if (@old > @new) { @new = @old; }
		if ($b[0] > $total) { $total = $b[0] + $yeste; }
	}

	push @new, "$total,$today,$yeste,$mday,$addr,$in{'pg'},\n";

	if ($today == 1) {
		open OUT, ">$backfile" or &error("Write Error: $backfile");
		print OUT @new;
		close OUT;
	}

	open OUT, ">$datafile" or &error("Write Error: $datafile");
	print OUT @new;
	close OUT;
}

&unlock;

if ($total > 999999) { $prn_total = $total; }
else { $prn_total = sprintf $fig_total, $total; }
$prn_today = sprintf $fig_today, $today;
$prn_yeste = sprintf $fig_yeste, $yeste;

&header;

@prn = split //, $in{'prn'};
if ($prn[0] ne '') {
	print q{var str = '';};
	if ($prn[0]) { print qq{str += "$prn_total";}; }
	if ($prn[1]) { print qq{str += "$prn_today";}; }
	if ($prn[2]) { print qq{str += "$prn_yeste";}; }
	print q{document.write(str);};
} else {
	print qq{function ffcow() { var a = new Array("$prn_total", "$prn_today", "$prn_yeste"); return a; }};
}

exit;

# ======================================
# 関数群
# --------------------------------------
# パラメータをデコード
sub decode {
	my($query, @params, $param, $key, $val);
	$query = $ENV{'QUERY_STRING'};
	@params = split /&/, $query;
	foreach $param (@params) {
		($key, $val) = split /=/, $param;
		$in{$key} = $val;
	}
}

# --------------------------------------
# ヘッダ出力
sub header {
	print qq{Content-type: application/x-javascript\n\n};
}

# --------------------------------------
# ロック
sub lock {
	if ($lockkey == 1) {
		open LOCK, "$lockfile";
		eval { flock LOCK, LOCK_EX; };
	} elsif ($lockkey == 2) {
		while (glob "$lockfile*") {
			if (/^$lockfile(\d+)/) {
				if (time - (stat $_)[9] > 60) {
					rename $_, $lockfile;
				}
			}
		}
		my $retry = 5;
		while (!rename $lockfile, $lockfile2) {
			if (--$retry <= 0) { &error("Lock is busy"); }
			sleep 1;
		}
	}
}

# --------------------------------------
# ロック解除
sub unlock {
	if ($lockkey == 1) {
		close LOCK;
	} elsif ($lockkey == 2) {
		my $time = time;
		utime $time, $time, $lockfile2;
		rename $lockfile2, $lockfile;
	}
}

# --------------------------------------
# エラー処理
sub error {
	&unlock;
	&header;
	print qq{document.write("$_[0]");\n};
	exit;
}

# --------------------------------------
# チェック
sub check {
	print qq{Content-type: text/html\n\n};
	print qq{<html><head><title>$ver</title></head><body>$ver<ul>\n};

	my @a = ('NG', 'NG');
	if (-e $datafile) { $a[0] = 'OK'; }
	if (-r $datafile and -w $datafile) { $a[1] = 'OK'; }
	print qq{<li>\$datafile: $datafile -- path=$a[0] permission=$a[1]</li>\n};

	@a = ('NG', 'NG');
	if (-e $backfile) { $a[0] = 'OK'; }
	if (-r $backfile && -w $backfile) { $a[1] = 'OK'; }
	print qq{<li>\$backfile: $backfile -- path=$a[0] permission=$a[1]</li>\n};

	@a = ('NG', 'NG');
	if ($lockkey > 0) {
		if (-e $lockfile) { $a[0] = 'OK'; }
		if (-r $lockfile) { $a[1] = 'OK'; }
		print qq{<li>\$lockfile: $lockfile -- path=$a[0] permission=$a[1]</li>\n};
		if ($lockkey == 1) {
			if ($a[0] eq 'OK' and $a[1] eq 'OK') {
				open LOCK, "$lockfile";
				eval { flock LOCK, LOCK_EX; };
				if ($@) { print qq{<li>\$lockkey: $lockkey -- NG</li>\n}; }
				close LOCK;
			}
		}
	} else { print qq{<li>\$lockfile: $lockfile -- OFF</li>\n}; }

	print qq{</ul></body></html>};
	exit;
}