#!/usr/local/bin/perl
#
######################################################################
###
###
###  CGIクイズシステム TakaQ Ver.2.05
###     [2/5] 出題、採点、結果 (tqquiz.cgi)
###                                 (c) 1996-1999 Takahiro Nishida
###                                 http://www.mytools.net/
###
###
######################################################################
#
### 変数設定部 （詳細は上記ページをご覧下さい） ######################

# 正解時の背景
$ataribody = "BGCOLOR=pink";
# 不正解時の背景
$hazurebody = "BGCOLOR=skyblue";
# 正解時のメッセージ
$atarimsg = "<font size=5><B>あたり</B></font>";
# 不正解時のメッセージ
$hazuremsg = "<font size=5><B>はずれ</B></font>";

### 変数設定部 （ここまで）###########################################

$maxplayer = "10";
$answertype = "0";
$atarimark = "<td bgcolor=red><font color=white><B>○</B></font></td>";
$hazuremark = "<td bgcolor=blue><font color=white><B>×</B></font></td>";

require "./tqlib.pl";

print "Content-type: text/html\n\n";

&main;

sub main{
	&tqlib'file_lock;
	srand;
	&parse_form;
	&init_variables;
	&open_sheet;
	&check_sheet;
	&check_answer;
	&show_html;
	&update_sheet;
	&tqlib'unlock;
}

# フォーム入力データの受け取り
sub parse_form{
	if($ENV{'REQUEST_METHOD'} eq "POST"){
	read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
	}
	else{
		$buffer = $ENV{'QUERY_STRING'};
	}
	@pairs = split(/&/, $buffer);
	foreach $pair(@pairs){
		($name, $value) = split(/=/, $pair);
		$FORM{$name} = $value;
	}
}



# 変数の初期化
sub init_variables{
	$ext = $tqlib'ext;
	$basedir = $tqlib'basedir;
	$method = $tqlib'method;
	
	$ginfile = "$basedir/genre.txt";
	$acnfile = "$basedir/log/count.txt";
	$tpfile = "$basedir/tqquiz.html";
	$msgfile = "$basedir/message.txt";
	$logfile = "$basedir/tqlog.txt";
}



# 解答用紙の初期化
sub init_sheet{
	local($genre) = @_;
	&tqlib'checkvar($genre);
	
	$dir = "$basedir/data/$genre";
	$summfile = "$dir/summery.txt";
	
	# ジャンル情報の取得
	open(FILE,"$ginfile") || die &tqlib'error("$ginfile",1);
	foreach(<FILE>){
		($_ =~ /^$genre/) && (@gsp = split("\t", $_));
	}
	($zur, $xsh, $jun) = split("", $gsp[$#gsp-1]);
	
	$qno = &tqlib'count_quiz($dir);
	# 出題数か問題数が０だったらエラー
	if(($qno<1)||($gsp[2]<1)){
		&tqlib'error("",10);
	}
	# 出題数が問題数を上回ってるとエラー
	if($qno<$gsp[2]){
		&tqlib'error("",9);
	}
	
	# 出題問題リストの作成
	@tmp=(1..$qno);
	if($jun==0){
		@qls=();
		for(1..$gsp[2]){
			push(@qls,splice(@tmp,rand(@tmp),1));
		}
	}
	else{
		@qls=@tmp;
	}
	
	for(1..$gsp[2]){
		push(@sel,"0");
		push(@res,"-");
	}
	
	# ジャンル別挑戦者No.の取得
	open(FILE,"$summfile") || die &tqlib'error("$summfile",1);
	@summs=split("\t",<FILE>);
	close(FILE);
	$gcn = ++$summs[11];
	open(FILE,">$summfile") || die &tqlib'error("$summfile",0);
	print FILE join("\t",@summs);
	close(FILE);
	
	# 解答用紙No.の取得
	open(FILE,"$acnfile") || die &tqlib'error("$acnfile",1);
	$acn=<FILE>;
	close(FILE);
	if($acn<$maxplayer){ $acn++; } else { $acn=1; }
	open(FILE,">$acnfile") || die &tqlib'error("$acnfile",0);
	print FILE $acn;
	close(FILE);
	
	$fshfile="$basedir/log/$acn.f";
	$mshfile="$basedir/log/$acn.m";
	
	unlink($fshfile);
	unlink($mshfile);
	
	# 解答用紙作成1 ("〜.f" 固定パラメータ)
	$btime=time();
	open(FILE,">$fshfile") || die &tqlib'error("$fshfile",0);
#-------------------
print FILE <<"EOF";
dir:$genre
gnm:$gsp[1]
gcn:$gcn
svr:$ENV{REMOTE_HOST}
xsh:$xsh
zur:$zur
suc:$gsp[4]
tno:$gsp[2]
btm:$btime
EOF
#-------------------
	close(FILE);
	
	# 解答用紙作成2 ("〜.m" 流動パラメータ)
	open(FILE,">$mshfile") || die &tqlib'error("$mshfile",0);
	print FILE join("\t",@qls)."\t\n";
	print FILE join("\t",@sel)."\t\n";
	print FILE join("\t",@res)."\t\n";
	close(FILE);
	
	# 変数のつじつま合わせ
	$FORM{step}=0;
	$FORM{acn}=$acn;
	$body=$ataribody;
	$SHEET{dir}=$genre;
	
	return;
}

# 解答用紙を開く
sub open_sheet{
	if($FORM{genre}){
		&init_sheet($FORM{genre});
		&record_log(0);
	}
	
	if(!($FORM{step} =~ /^\d+$/)){ &tqlib'error("FORM{step}",3); }
	$step=$FORM{step};
	
	if(!$FORM{acn}){ &tqlib'error("FORM{acn}",3); }
	$acn=$FORM{acn};
	
	$fshfile="$basedir/log/$acn.f";
	$mshfile="$basedir/log/$acn.m";
	
	# 解答用紙1 (〜.f)
	open(FILE,"$fshfile") || die &tqlib'error("$fshfile",1);
	foreach(<FILE>){
		if($_=~/(.*):(.*)\n/){
			$SHEET{$1}=$2;
		}
	}
	close(FILE);
	
	# 解答用紙2 (〜.m)
	open(FILE,"$mshfile") || die &tqlib'error("$mshfile",1);
	@buf=<FILE>;
	close(FILE);
	
	@qls=split("\t",$buf[0]);  pop(@qls);
	@sel=split("\t",$buf[1]);  pop(@sel);
	@res=split("\t",$buf[2]);  pop(@res);
	
	$pstep=$step-1;
	$nstep=$step+1;
}

# 不正チェック
sub check_sheet{
	if($SHEET{zur}){ return; }
	if($pstep<0){ return; }
	if($res[$pstep] ne "-"){ &sheet_error; }
}

# 答え合わせ,正答率の更新
sub check_answer{
	if($step==0){ return; }
	if(!$sel[$pstep]){ &tqlib'error("sel[$pstep]",3); }
	
	$pqfile="$basedir/data/$SHEET{dir}/$qls[$pstep].q";
	open(FILE,"$pqfile") || die &tqlib'error("$pqfile",1);
	@pqbuf=<FILE>;
	close(FILE);
	@pqcfg=split("\t",$pqbuf[0]); # 問題別正答率
	$pans=$pqbuf[3]; # 答え
	$pcom=$pqbuf[2]; # コメント
	
	$ratefile="$basedir/data/$SHEET{dir}/rate.txt";
	open(FILE,"$ratefile") || die &tqlib'error($ratefile, 1);
	$rbuf = <FILE>;
	close(FILE);
	($atry, $acor) = split("\t", $rbuf);
	
	$atry++; $pqcfg[0]++;
	
	if($sel[$pstep]==$FORM{ans}){
		$res[$pstep]="o";
		$body=$ataribody;
		$acor++;
		$pqcfg[1]++;
	}
	else{
		$res[$pstep]="x";
		$body=$hazurebody;
	}
	
	# 問題ファイルの更新
	$pqbuf[0]=join("\t",@pqcfg);
	open(FILE,">$pqfile") || die &tqlib'error($pqfile, 0);
	print FILE @pqbuf;
	close(FILE);
	
	# 正答率ファイルの更新
	open(FILE,">$ratefile") || die &tqlib'error($ratefile, 0);
	print FILE "$atry\t$acor\t\n";
	close(FILE);
}

# 解答用紙の更新
sub update_sheet{
	open(FILE,">$mshfile") || die &tqlib'error("$mshfile",1);
	print FILE join("\t",@qls)."\t\n";
	print FILE join("\t",@sel)."\t\n";
	print FILE join("\t",@res)."\t\n";
	print FILE $result;
	close(FILE);
}

# 表示
sub show_html{
	if($step==$SHEET{tno}){ $info="RESULT"; }
	else{ $info="Q$nstep"; }
	
	open(FILE,"$tpfile") || die &tqlib'error("$tpfile",1);
	foreach(<FILE>){
		if($_=~/#MESSAGE(\d)#/){
			if($1==0){ &show_status; }
			if($1==1 && $step>0){ &show_answer; }
			if($1==2){
				if($step<$SHEET{tno}){ &show_question( $SHEET{'dir'}, $qls[$step] ); }
				else { &show_result; }
			}
		}
		else{
			$_ =~ s/#GENREINFO#/$SHEET{gnm} $info/ig;
			$_ =~ s/#BODY#/$body/ig;
			print $_;
		}
	}
}

# 状態の表示
sub show_status{
	$ap=0; @mark=();
	
	push(@mark,"<table border=0 cellpadding=3 cellspacing=0 bgcolor=white>\n<tr>");
	for(0..$pstep){
		if($res[$_] eq "o") { push(@mark,$atarimark); $ap++; }
		               else { push(@mark,$hazuremark); }
		push(@mark,"</tr>\n<tr>") unless ($_+1)%10;
	}
	for($pstep+1..$SHEET{tno}-1){
		push(@mark,"<td>−</td>");
		push(@mark,"</tr>\n<tr>") unless ($_+1)%10;
	}
	push(@mark,"</tr>\n</table>\n");
	
	$rp = &tqlib'calc_rate($ap, $step); # 正答率
	
	# 経過時間
	$ptime = time()-$SHEET{btm};
	$mstime = &tqlib'change_time($ptime);
	
	&tqlib'copyright;
	print "<P>@mark<P>\n";
	print "<font size=3><B>$step問中$ap問正解 (正答率$rp%)</B></font>\n";
	print "<font size=2><B>$mstime経過</B></font><P>\n";
}

# 解答の表示
sub show_answer{
	print "<font size=5><B>A$step</B></font> ";
	if($res[$pstep] eq "o"){
		print "$atarimsg<P>\n";
	}
	else{
		print "$hazuremsg<P>\n";
	}
	
	if($SHEET{xsh}){
		print "<font size=3>正解は $pans でした。</font><P>\n";
	}
	
	if($SHEET{xsh}||$res[$pstep] eq "o"){
		print "<font size=2>$pcom</font>\n";
	}
}

# 問題の表示
sub show_question{
	local( $genre, $qno ) = @_;
	$nqfile="$basedir/data/$genre/$qno.q";
	open(FILE,"$nqfile") || die &tqlib'error("$nqfile",1);
	@nqbuf=<FILE>;
	close(FILE);
	
	# .q ファイルの不正チェック
	if(!($nqbuf[0]=~/^\d+\t\d+\t.*\t/)&&($nqbuf[1] ne "")&&($nqbuf[2] ne "")&&($nqbuf[3] ne "")&&($nqbuf[4] ne "")){
		&tqlib'error($nqfile,2);
	}
	

	
	@nqcfg=split("\t", $nqbuf[0]);
	
	@tmp=(3..$#nqbuf);
	@als=();
	while(@tmp){
		$p=splice(@tmp,rand(@tmp),1);
		push(@als,$p);
		if($p==3){ $sel[$step]=@als; }
	}
	
	$nrate = &tqlib'calc_rate($nqcfg[1],$nqcfg[0]);
	
	print "<font size=5><B>第$nstep問</B></font> ";
	print "<font size=2><I>$nqcfg[0]人中$nqcfg[1]人正解 (正答率$nrate%)</I></font><P>\n";
	print "<font size=3>$nqbuf[1]</font><P>\n";
	print "<form method=\"$method\" action=\"tqquiz.$ext\">\n";
	
	$i=1;
	
	if($answertype){
		print "<OL><font size=3><B>\n";
		while($p=shift(@als)){
			print "<LI><a href=\"tqquiz.$ext?step=$nstep&acn=$acn&ans=$i\">$nqbuf[$p]</a>\n";
			$i++;
		}
		print "</B></font></OL>\n";
	}
	else{
		print "<font size=3><B><OL>\n";
		while($p=shift(@als)){
			print "<LI><input type=\"radio\" name=\"ans\" value=\"$i\">$nqbuf[$p]\n";
			$i++;
		}
		print "</OL>\n";
		print "<input type=\"hidden\" name=\"step\" value=\"$nstep\">\n";
		print "<input type=\"hidden\" name=\"acn\" value=\"$acn\">\n";
		print "<input type=\"submit\" value=\" ----- OK ----- \">\n";
		print "</form></B></font>\n";
	}
}

# 結果の表示
sub show_result{
	$message=&show_message($rp);
	print "<H3>$SHEET{tno} 問中 $ap 問正解</H3>\n";
	print "<H2>正答率 $rp %</H2>\n";
	print "<H4>$message</H4>\n";
	&show_summtable($rp);
	&record_log(1);
	if($rp>=$SHEET{suc}){
		$rank = &get_rank;
		&record_score;
		&show_form( $rank );
	}
	print "[<a href=\"tqindex.$ext\">タイトルへ戻る</a>]\n";
}

# ログの保存
sub record_log{
	local($id) = @_;
	@status = ('started', 'finished');
	local ($date) = &tqlib'get_time;
	
	$mstime = &tqlib'change_time($ptime);
	if($id){ $sco="rate:$rp%, time:$mstime"; }
	
	open(FILE,">>$logfile") || die &tqlib'error($logfile, 0);
	print FILE "[$date] No.$FORM{'acn'} $status[$id] (genre:$SHEET{dir}) $sco [host:$ENV{'REMOTE_HOST'}]\n";
	close(FILE);
	
	return;
}

# 順位の取得
sub get_rank{
	$regfile="$basedir/data/$SHEET{dir}/highscore.txt";
	open(FILE,"$regfile") || die &tqlib'error("$regfile",1);
	@regs=<FILE>;
	close(FILE);
	
	local ($rank) = 1;
	foreach $data(@regs){
		@sps=split("\t",$data);
		if($sps[0]==$rp && $sps[1]>$ptime){ last; }
		elsif($sps[0]<$rp){ last; }
		else{ $rank++; }
	}
	return $rank;
}

# 合格したときの各情報を記録
sub record_score{
	$result="$ptime\t$rp\t\n"; # update_sheet の最後の行に $record が書き込まれるようになっている
}

# 高得点者登録フォームの表示
sub show_form{
	local ( $rank ) = @_;
#--------------------------------------
print <<"EOF";
<HR width=80%>
<form method="$method" action="tqscore.$ext">
<table border="1" cellpadding="1" cellspacing="1" bgcolor=yellow>
<tr><th colspan="2">
  <font size=4 color=green><blink>! HIGHSCORE ! (RANK $rank)</blink></font>
</th></tr>
<tr><th align=right>
  <font size=2>名前</font></th><td><input type="text" name="hname" size="10">
</td></tr>
<tr><th align=right>
  <font size=2>メール</font></th><td><input type="text" name="hmail" size="15">
</td></tr>
<tr><th align=right>
  <font size=2>ＵＲＬ</font></th><td>http://<input type="text" name="hurl" size="20">
</td></tr>
<tr><th align=right>
  <font size=2>コメント</font></th><td><input type="text" name="com" size="40" MAXLENGTH="200">
</td></tr>
</table>
<P>

<input type="hidden" name="acn" value="$acn">
<input type="hidden" name="act" value="reg">
<input type="submit" value="登録">
</form>
EOF
#--------------------------------------
}

# 得点別メッセージの表示
sub show_message{
	local($score)=@_;
	
	$dirmsg="$basedir/data/$SHEET{dir}/message.txt";
	if(!(open(FILE,"$dirmsg")||open(FILE,"$msgfile"))){ &tqlib'error($msgfile,1); }
	@msgs=<FILE>;
	close(FILE);
	
	$score=10-int($score/10);
	return $msgs[$score];
}

# 得点別人数分布の表示、ファイルの更新
sub show_summtable{
	local ( $rate ) = @_;
	$score=int($rate/10);
	
	$summfile="$basedir/data/$SHEET{dir}/summery.txt";
	
	open(FILE,"$summfile") || die &tqlib'error("$summfile",1);
	$sums=<FILE>;
	close(FILE);
	
	@sps=split("\t",$sums);
	$sps[$score]++;
	$sps[12]++;
	if($rate>=$SHEET{suc}){ $sps[13]++; }
	
	print "<table border><tr><th>挑戦</th><th>完答</th>";
	for($a=0;$a<=100;$a+=10){ print "<th>$a%</th>"; }
	print "<th>合格</th></tr>\n<tr>";
	for(11,12,0..10,13){
		if($_==$score){
			print "<th><font size=5 color=red><blink>$sps[$_]</blink></font></th>";
		}else{
			print "<th><font size=3>$sps[$_]</font></th>";
		}
	}
	print "</tr></table><P>\n";
	
	open(FILE,">$summfile") || die &tqlib'error("$summfile",0);
	print FILE join("\t",@sps);
	close(FILE);
}

sub sheet_error{
	print "<html><head><title>TakaQ</title></head><body $hazurebody><font size=3><center>\n";
	print "<font size=5>解答用紙に不正が発見されました。</font><P>\n";
	print "<font size=4>クイズは中断されました。</font><P>";
	print "■ 注意 ■<BR>ＯＫボタンを複数回押すと不正扱いされてしまいます。<BR>サーバー速度が遅くても、ＯＫボタンを押し直したりしないでください。<P>\n";
	print "何もしていないのにこのエラーが出る場合は、管理者に連絡してください。<P>\n";
	print "[<a href=\"tqindex.$ext\">クイズのトップへ戻る</a>]<P>\n";
	&tqlib'copyright;
	print "<HR></center></font></body></html>";
	
	&tqlib'unlock;
	exit;
}