#!/usr/local/bin/perl

#====================================================================================================
# コメント部
#====================================================================================================

#==================================================
# 変更履歴(20060203以降)
# 200602032115 関係項目ハイライト
# 200602032225 文字列外部読み込み
# 200602032310 総プレイヤー数表示、チーム成績中チーム表示部を右寄せ
# 200602032320 POST情報取得処理変更、プレイヤー名末尾空白除去
# 200602040000 注目プレイヤー用文字列投稿ルーチン
# 200602040010 ハイライト部分微調整
# 200602041130 特殊文字処理変更、最終更新日表示
# 200602041400 登録文字列集へのリンク追加
# 200602041605 リザルト保存
# 200602041740 保存バグ修正
# 200602041830 resultstat.cgi へのリンク追加
# 200602050100 不完全なリザルト入力への対処
# 200602051445 リザルト保存順のバグ修正
# 200602051800 全面的ルーチン整理、エラー制御強化、一部表示方法の変更
# 200602061350 ちょっとしたfix
# 200602231210 個人戦バージョンへのリンク
# 200602232300 テスト
# 200603072200 ファイルロック処理を厳密にした
# 200603141300 リザルト保存時等のルーチンを主に判別効率面から見直し
#==================================================


#====================================================================================================
# メイン
#====================================================================================================

#==================================================
# 初期設定
#==================================================

use Fcntl qw(:DEFAULT :flock);
use POSIX;
use strict;
use vars qw (%FORM @playerinfo @playerinfosort @chumokusiru @blue @red $lastupdate $debug);

$lastupdate = '<font color=red>0603141300</font>';
$debug = 0;


#==================================================
# POST情報取得,整形,汚染除去(null)
#==================================================

{
	my ($name, $value, $buffer);

	read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
	foreach (split /&/,$buffer) {
		($name, $value) = split /=/;
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2',$1)/eg;
#		$value =~ s/&/&amp;/g;
		$value =~ s/</&lt;/g;
		$value =~ s/>/&gt;/g;
		$value =~ s/"/&quot;/g;
		$value =~ tr/ / /s;
		DispError('エラー：不正な入力です') if ($value =~ /\x00/);
		$FORM{$name} = $value;
	}
}


#==================================================
# 不正排除（必要に応じて）
#==================================================

&DispError('エラー') if ($debug == 99);


#==================================================
# 機能分岐、メイン終了処理
#==================================================

{
	$FORM{'result'} = "Blue 1284 - Red 0\n\nPLAYER                   HITS      SHOTS KILLS DIED SUIC FLAGS/TRIES/SAVES   \nGP-VIP坂下             [red]0 (0%)   50    0     1110   251    0/14/0               \nFamicomUchujin2 (DJ) [blue]640 (800%)  80    859     0    0    85/85/14               " if($debug == 1);

	if($FORM{'result'}){
		&showresult;
	}elsif($FORM{'word0'} || $FORM{'word1'} || $FORM{'word2'}){
		&addwords;
	}else{
		&showmain;
	}
	exit;
}


#====================================================================================================
# 一次サブルーチン
#====================================================================================================

#==================================================
# リザルト表示ルーチン
#==================================================

sub showresult{
	my $playernum = 0;
	my @listresult = split(/\n/, $FORM{'result'});

	# リザルト情報解析、チーム成績取得
	# @{$playerinfo[x]}: 0:NAME 1:TEAM 2:HITS 3:HITR 4:SHOT 5:KILL 6:DIE 7:SUIC 8:FLAG 9:TRY 10:SAVE

	$red[11] = 0;
	$blue[11] = 0;

	foreach my $line (@listresult) {
		if(reverse($line) =~ /^([^]]+)\]([bdelru]+)\[(.+)$/){
			my $score = reverse($1);
			$playerinfo[$playernum][1] = reverse($2);
			$playerinfo[$playernum][0] = reverse($3);
			$playerinfo[$playernum][0] =~ s/\s*$//g;
			if($score =~ /^\s*(\d+)\s+\((\d+)\%\)\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\/(\d+)\/(\d+)\s*$/){
				@{$playerinfo[$playernum]}[2..10] = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
				if($playerinfo[$playernum][1] eq 'red'){
					$red[2] += $playerinfo[$playernum][2];
					$red[4] += $playerinfo[$playernum][4];
					$red[5] += $playerinfo[$playernum][5];
					$red[6] += $playerinfo[$playernum][6];
					$red[7] += $playerinfo[$playernum][7];
					$red[8] += $playerinfo[$playernum][8];
					$red[9] += $playerinfo[$playernum][9];
					$red[10] += $playerinfo[$playernum][10];
					$red[11]++;
				}else{
					$blue[2] += $playerinfo[$playernum][2];
					$blue[4] += $playerinfo[$playernum][4];
					$blue[5] += $playerinfo[$playernum][5];
					$blue[6] += $playerinfo[$playernum][6];
					$blue[7] += $playerinfo[$playernum][7];
					$blue[8] += $playerinfo[$playernum][8];
					$blue[9] += $playerinfo[$playernum][9];
					$blue[10] += $playerinfo[$playernum][10];
					$blue[11]++;
				}
			}else{
				&DispError("リザルト入力エラー(score)：$score");
			}
			#注目すべき値を適当に設定
			$chumokusiru[0] += $playerinfo[$playernum][3];
			$chumokusiru[1] += $playerinfo[$playernum][2];
			$chumokusiru[2] += $playerinfo[$playernum][4];
			$chumokusiru[3] += $playerinfo[$playernum][6];
			$playernum++;
		}elsif($line =~ /^Blue (\d+) - Red (\d+)/){
			$blue[1] = $1;
			$red[1] = $2;
		}elsif(($line !~ /^\s*$/) && ($line !~ /^PLAYER\s*HITS\s*SHOTS\s*KILLS\s*DIED\s*SUIC\s*FLAGS\/TRIES\/SAVES\s*$/)){
			&DispError("リザルト入力エラー：$line");
		}
	}

	# リザルト情報エラー
	&DispError('リザルト入力エラー：プレイヤーが一人もいません') if(!$playerinfo[0][0]);
	&DispError('リザルト入力エラー：チーム点数が取得できません') if(($blue[1] !~ /^\d+$/) || ($red[1] !~ /^\d+$/));

	# リザルト情報保存
	if(($blue[1] != 1284) || ($playernum != 2)){
		&saveresult;
	}

	# ページ前半HTML
	&print01;
	&print05;

	# チーム成績HTML
	&teamanlys;

	# 各項目別成績HTML
	@playerinfosort = @playerinfo;
	&writetable('Result');

	@playerinfosort = sort { $b->[2] <=> $a->[2] } @playerinfo;
	&writetable('Hits');

	@playerinfosort = sort { $b->[4] <=> $a->[4] } @playerinfo;
	&writetable('Shots');

	# HIT数偏差取得
	@playerinfosort = sort { $b->[2] <=> $a->[2] } @playerinfo;
	my $shotsthr = &shotstouke;

	# HIT数一定数以下の切り捨て
	for ($playernum = 0; $playernum <= $#playerinfosort; $playernum++){
		last if($playerinfosort[$playernum][2] < $shotsthr);
	}
	splice(@playerinfosort, $playernum);

	@playerinfosort = sort { $b->[3] <=> $a->[3] } @playerinfosort;
	&writetable("Hit/Shot (%) (ex. [$shotsthr &gt; hit])");

	@playerinfosort = sort { $b->[5] <=> $a->[5] } @playerinfo;
	&writetable('Kills');

	@playerinfosort = sort { $b->[6] <=> $a->[6] } @playerinfo;
	&writetable('Died');

	@playerinfosort = sort { $b->[8] <=> $a->[8] } @playerinfo;
	&writetable('Flags');

	@playerinfosort = sort { $b->[9] <=> $a->[9] } @playerinfo;
	&writetable('Tries');

	@playerinfosort = sort { $b->[10] <=> $a->[10] } @playerinfo;
	&writetable('Saves');

	# 注目プレイヤー
	&chumoku;

	# フッタ等HTML
	&print09;
}


#==================================================
# 注目プレイヤー用文字列登録ルーチン
#==================================================

sub addwords{
	my $addlist;

	$FORM{'word0'} =~ tr/\n\r/ /s;
	$FORM{'word1'} =~ tr/\n\r/ /s;
	$FORM{'word2'} =~ tr/\n\r/ /s;
	$FORM{'word0'} =~ s/[\s　]+$//;
	$FORM{'word1'} =~ s/[\s　]+$//;
	$FORM{'word2'} =~ s/[\s　]+$//;

	if($FORM{'word0'} ne ''){$addlist = "0,$FORM{'word0'}\n";}
	if($FORM{'word1'} ne ''){$addlist .= "1,$FORM{'word1'}\n";}
	if($FORM{'word2'} ne ''){$addlist .= "2,$FORM{'word2'}\n";}

	&DispError('文字列投稿エラー：空白文字列です') if($addlist eq '');

	open(OUT,'>>wordslist.txt');
	flock OUT, LOCK_EX;
	binmode OUT;
	print OUT $addlist;
	close(OUT);

	&print01;

	print <<EOM;
	<hr>
	以下の文字列を登録しました<BR>
	<PRE>$addlist</PRE>
	<A HREF="tankresult.cgi">戻る</A><BR>
	<hr>
EOM

	# フッタ等HTML
	&print09;
}


#==================================================
# デフォルト画面表示ルーチン
#==================================================

sub showmain{
	&print01;
	&print05;
	&print09;
}


#====================================================================================================
# 二次サブルーチン
#====================================================================================================

#==================================================
# ヘッダ部分等HTML表示ルーチン
#==================================================

sub print01{
	print <<EOM;
Content-Type: text/html

<html><head>
	<META http-equiv="Content-Type" content="text/html; charset=EUC-JP">
	<title>FaMiCoM tAnKmAnIa rEsUlT Team</title>
	</head>
	<body>
	<center><h1>FaMiCoM tAnKmAnIa rEsUlT Team</h1></center>
	<A HREF="resultstat.cgi">統計バージョンはこちら</A><BR>
	<A HREF="tankresulti.cgi">個人戦バージョンはこちら</A><BR>
EOM
}


#==================================================
# リザルト入力部分HTML表示ルーチン
#==================================================

sub print05{
	print <<EOM;
	<form method="POST" action="tankresult.cgi"><textarea name="result" cols=60 rows=16>
Blue 1284 - Red 0

PLAYER                   HITS      SHOTS KILLS DIED SUIC FLAGS/TRIES/SAVES   
GP-VIP坂下             [red]0 (0%)   50    0     1110   251    0/14/0               
FamicomUchujin2 (DJ) [blue]640 (800%)  80    859     0    0    85/85/14               
</textarea><BR>
	リザルトが表示されたら、一番最初（点数の部分）から最後までコピーして、ここに貼付け下のボタンを押してください。<BR>
	<input type="submit" name="submit" value="[[ [  [ SHOW RESULT ]  ] ]]">
	</form>
	<hr>
EOM
}


#==================================================
# 作成者情報等（ページ終了部）HTML表示ルーチン
#==================================================

sub print09{
	print <<EOM;
		copyright(c)Famicom Uchu-jin<BR>
		lastupdate: $lastupdate<BR>
		<A HREF="tankresult.txt">ソースコード</A><BR>
	</body>
</html>
EOM
}


#==================================================
# 項目別テーブル吐き出しルーチン
#==================================================

sub writetable{
	my ($a, $check, $bgcolor, @bghilight, $playerrnk);

	($a) = @_;

	# 0:NAME 1:TEAM 2:HITS 3:HITR 4:SHOT 5:KILL 6:DIE 7:SUIC 8:FLAG 9:TRY 10:SAVE
	if($a eq 'Result'){$check = 0;}
	elsif($a eq 'Hits'){$check = 2;}
	elsif($a =~ /^Hit\/Shot.*/){$check = 3;}
	elsif($a eq 'Shots'){$check = 4;}
	elsif($a eq 'Kills'){$check = 5;}
	elsif($a eq 'Died'){$check = 6;}
	elsif($a eq 'Flags'){$check = 8;}
	elsif($a eq 'Tries'){$check = 9;}
	elsif($a eq 'Saves'){$check = 10;}

	@bghilight = ('>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>');
	$bghilight[$check] = ' bgcolor=#bbbbbb>';

	# 項目部分HTML
	print <<EOM;
		<H2>$a</H2>
		<table border=2>
		<tr bgcolor="#cccccc" align=center>
		<th width=32>No.</th>
		<th>Name</th>
		<th width=48>Team</th>
		<th width=32></th>
		<th width=32$bghilight[2]Hit</th>
		<th width=32$bghilight[3]%</th>
		<th width=32$bghilight[4]Sht</th>
		<th width=32></th>
		<th width=32$bghilight[5]Kill</th>
		<th width=32$bghilight[6]Die</th>
		<th width=32$bghilight[7]Sui</th>
		<th width=32></th>
		<th width=32$bghilight[8]Flg</th>
		<th width=32$bghilight[9]Try</th>
		<th width=32$bghilight[10]Sav</th>
		</tr>
EOM
	# 項目部分終了

	for(my $count = 0; $count <= $#{@playerinfosort}; $count++){
		#表示処理中の項目がFlags Tries Savesの場合、数値が0の人からは表示せずに
		last if(($a eq 'Flags' || $a eq 'Tries' || $a eq 'Saves') && ($playerinfosort[$count][$check] == 0));

		# 色決定
		if($playerinfosort[$count][1] eq 'red'){$bgcolor = '#FFC8C8'; $bghilight[$check] = ' bgcolor=#FFA8A8>'}
		else{$bgcolor = '#C8C8FF'; $bghilight[$check] = ' bgcolor=#A8A8FF>'}

		# 同順位
		if(($playerinfosort[$count][$check] != $playerinfosort[$count-1][$check]) || ($a eq 'Result')){
			$playerrnk = $count + 1;
		}else{
			$playerrnk = '　';
		}

		# 各プレイヤー成績HTML
		print <<EOM;
	<tr bgcolor="$bgcolor">
	<td align=right>$playerrnk</td>
	<td align=left>$playerinfosort[$count][0]</td>
	<td align=right>$playerinfosort[$count][1]</td>
	<td></td>
	<td align=right$bghilight[2]$playerinfosort[$count][2]</td>
	<td align=right$bghilight[3]$playerinfosort[$count][3]</td>
	<td align=right$bghilight[4]$playerinfosort[$count][4]</td>
	<td></td>
	<td align=right$bghilight[5]$playerinfosort[$count][5]</td>
	<td align=right$bghilight[6]$playerinfosort[$count][6]</td>
	<td align=right$bghilight[7]$playerinfosort[$count][7]</td>
	<td></td>
	<td align=right$bghilight[8]$playerinfosort[$count][8]</td>
	<td align=right$bghilight[9]$playerinfosort[$count][9]</td>
	<td align=right$bghilight[10]$playerinfosort[$count][10]</td>
	</tr>
EOM
		# 各プレイヤー成績HTML終了
	}

	# テーブル閉じ
	print <<EOM;
		</table>
		<hr>
EOM
	# テーブル閉じ終了
}


#==================================================
# チーム成績ルーチン
# @blue: 0:RESULT 1:SCORE 2:HITS 3:HITRATE 4:SHOT 5:KILL 6:DIE 7:SUIC 8:FLAG 9:TRY 10:SAVE 11:NUM
#==================================================

sub teamanlys{
	# チーム勝敗
	if($red[1] > $blue[1]){
		$red[0] = 'WIN';
		$blue[0] = 'LOSE';
	}elsif($red[1] < $blue[1]){
		$blue[0] = 'WIN';
		$red[0] = 'LOSE';
	}else{
		$red[0] = 'DRAW';
		$blue[0] = 'DRAW';
	}

	# チーム別HIT率
	$red[3] = int(($red[2]/$red[4])*1000)/10;
	$blue[3] = int(($blue[2]/$blue[4])*1000)/10;

	# 総プレイヤー数
	my $playernum = $#{@playerinfo} + 1;

	# テーブル吐き出し
	print <<EOM;
	<H2>TOTAL ($playernum players)</H2>
	<table border=2>
	<tr bgcolor="#cccccc" align=center>
		<th width=32>Result</th>
		<th>Team(Num)</th>
		<th width=48>Score</th>
		<th width=32></th>
		<th width=32>Hit</th>
		<th width=32>%</th>
		<th width=32>Sht</th>
		<th width=32></th>
		<th width=32>Kill</th>
		<th width=32>Die</th>
		<th width=32>Sui</th>
		<th width=32></th>
		<th width=32>Flg</th>
		<th width=32>Try</th>
		<th width=32>Sav</th>
	</tr>
	<tr bgcolor="#C8C8FF">
		<td align=left>$blue[0]</td>
		<td align=right>BLUE($blue[11])</td>
		<td align=right>$blue[1]</td>
		<td></td>
		<td align=right>$blue[2]</td>
		<td align=right>$blue[3]</td>
		<td align=right>$blue[4]</td>
		<td></td>
		<td align=right>$blue[5]</td>
		<td align=right>$blue[6]</td>
		<td align=right>$blue[7]</td>
		<td></td>
		<td align=right>$blue[8]</td>
		<td align=right>$blue[9]</td>
		<td align=right>$blue[10]</td>
	</tr>
	<tr bgcolor="#FFC8C8">
		<td align=left>$red[0]</td>
		<td align=right>RED($red[11])</td>
		<td align=right>$red[1]</td>
		<td></td>
		<td align=right>$red[2]</td>
		<td align=right>$red[3]</td>
		<td align=right>$red[4]</td>
		<td></td>
		<td align=right>$red[5]</td>
		<td align=right>$red[6]</td>
		<td align=right>$red[7]</td>
		<td></td>
		<td align=right>$red[8]</td>
		<td align=right>$red[9]</td>
		<td align=right>$red[10]</td>
	</tr>
	</table>
	<hr>
EOM
	# テーブル吐き出し終了
}


#==================================================
# 注目プレイヤー
#==================================================

sub chumoku{
	my ($chumokuda, $bgcolor, @wordsinput0, @wordsinput1, @wordsinput2);

	# 注目プレイヤー決定
	$chumokuda = $chumokusiru[0] % ($#{@playerinfo} + 1);

	# 背景色
	if($playerinfo[$chumokuda][1] eq 'red'){
		$bgcolor = '#FFC8C8';
	}else{
		$bgcolor = '#C8C8FF';
	}

	# 注目プレイヤー用文字列取得
	open(IN,'wordslist.txt');
	foreach (<IN>){
		chomp;
		if ($_ =~ /^([0-2]{1}),(.*)$/) {
			if($1 == 0){push(@wordsinput0, $2);}
			elsif($1 == 1){push(@wordsinput1, $2);}
			elsif($1 == 2){push(@wordsinput2, $2);}
		}
	}
	close(IN);

	my $ahonum0 = ($chumokusiru[1] + $chumokusiru[0]) % ($#wordsinput0 + 1);
	my $ahonum1 = ($chumokusiru[2] + $chumokusiru[0]) % ($#wordsinput1 + 1);
	my $ahonum2 = ($chumokusiru[3] + $chumokusiru[0]) % ($#wordsinput2 + 1);

	# 注目プレイヤーHTML
	print <<EOM;
	<center>
	<H2>今回の注目プレイヤー</H2>
	<H3>$wordsinput0[$ahonum0]$wordsinput1[$ahonum1]、$wordsinput2[$ahonum2]プレイヤー</H3>
	<table border=2>
	<tr bgcolor="#cccccc" align=center>
		<th>Name</th>
		<th width=48>Team</th>
		<th width=32></th>
		<th width=32>Hit</th>
		<th width=32>%</th>
		<th width=32>Sht</th>
		<th width=32></th>
		<th width=32>Kill</th>
		<th width=32>Die</th>
		<th width=32>Sui</th>
		<th width=32></th>
		<th width=32>Flg</th>
		<th width=32>Try</th>
		<th width=32>Sav</th>
	</tr>
	<tr bgcolor="$bgcolor">
		<td align=left>$playerinfo[$chumokuda][0]</td>
		<td align=right>$playerinfo[$chumokuda][1]</td>
		<td></td>
		<td align=right>$playerinfo[$chumokuda][2]</td>
		<td align=right>$playerinfo[$chumokuda][3]</td>
		<td align=right>$playerinfo[$chumokuda][4]</td>
		<td></td>
		<td align=right>$playerinfo[$chumokuda][5]</td>
		<td align=right>$playerinfo[$chumokuda][6]</td>
		<td align=right>$playerinfo[$chumokuda][7]</td>
		<td></td>
		<td align=right>$playerinfo[$chumokuda][8]</td>
		<td align=right>$playerinfo[$chumokuda][9]</td>
		<td align=right>$playerinfo[$chumokuda][10]</td>
	</tr>
	</table>
	</center>
	<hr>
	<BR>
	注目プレイヤー用文字列の登録（<A HREF="wordsreadme.txt">細かい説明</A>）更新しますた：
	<form method="POST" action="tankresult.cgi">
		<input name="word0" size=20><input name="word1" size=20>、<input name="word2" size=20>プレイヤー　<input type="submit" name="submit" value="[[登録]]"><BR>
	</form>
	（登録済の文字列は<A HREF="wordslist.txt">こちら</A>）<BR>
	<HR>
EOM
	# 注目プレイヤーHTML終了
}


#==================================================
# 一定偏差に達するHIT数の計算ルーチン
#==================================================

sub shotstouke{

	my (@shotslist, $sumshots, $aaa, $aveshots, $standard_dev, $shotsthr);

	@shotslist = map {$_->[2]} @playerinfo;
	$sumshots = 0;
	$aaa = 0;

	# 合計求める
	foreach my $i (@shotslist){
		$sumshots += $i;
	}

	# 平均求める
	$aveshots = $sumshots / $#shotslist;

	# それぞれの値から平均値をひいた値を二乗したものを$aaaに足してく
	foreach my $i (@shotslist){
		$aaa += ($i - $aveshots) ** 2;
	}

	# 標準偏差求める
	$standard_dev = sqrt($aaa / $#shotslist);

	# 最終的にこうなる
	$shotsthr = $aveshots - 1.96 * $standard_dev / sqrt($#shotslist);
	#ついでに小数点は第1位まで
	$shotsthr = int($shotsthr*10)/10;
}


#==================================================
# リザルト保存ルーチン
# DATARECORD:/^$DATE<$BLUE<$RED<$NAME>$TEAM>$HITS>$HITR>$SHT>$KILL>$DIE>$SUI>$FLG>$TRY>$SAV<$NAME>$TEAM>$HITS>$HITR>$SHT>$KILL>$DIE>$SUI>$FLG>$TRY>$SAV>....\n$/
#==================================================

sub saveresult{
	my ($line, @oldresult, $dummy);

	$dummy = 0;
	$line = "<$blue[1]<$red[1]";

	for(my $count = 0; $count <= $#playerinfo; $count++){
		$line .= "<$playerinfo[$count][0]>$playerinfo[$count][1]>$playerinfo[$count][2]>$playerinfo[$count][3]>$playerinfo[$count][4]>$playerinfo[$count][5]>$playerinfo[$count][6]>$playerinfo[$count][7]>$playerinfo[$count][8]>$playerinfo[$count][9]>$playerinfo[$count][10]";
	}

	&DispError('リザルト保存エラー：保存内容が短すぎます') if(length($line) < 10);

	open(IN,'+>>resultlist.txt');
	flock IN, LOCK_EX;
	@oldresult=<IN>;

	foreach(reverse @oldresult){
		chomp $_;
		$dummy = 1 if(substr($_, 14, 60) eq substr($line, 0, 60));
		last if $dummy == 1;
	}

	if($dummy == 0){
		substr($line, 0, 0) = strftime("%y/%m/%d %H:%M", localtime(time));
		$line .= "\n";

		binmode IN;
		print IN $line;
	}
	close(IN);
}


#====================================================================================================
# 制御用サブルーチン
#====================================================================================================

#==================================================
# 不正時処理
#==================================================

sub DispError{
	my ($topic)=@_;
	print qq|Content-type: text/html; charset=euc_jp\n\n<html><head><meta http-equiv="Content-Type" content="text/html; charset=EUC-JP"><title>$topic</title></head><body text="#000000" bgcolor="#efefef">$topic<br>\n</body></html>|;
	exit;
}