#!/usr/bin/perl
# WebQuest ( http://www.kenmei.ac.jp/~yamamoto/soft/ ) データ集計用CGI
# written by KITA Toshihiro ( http://www.eecs.kumamoto-u.ac.jp/~t-kita/ )
# Time-stamp: <2001-07-23 22:20:03 t-kita>
# ブラウザに簡単な集計結果と,各回答者の回答を表示します。
# 「順位回答」には対応していません。
# 動作確認は Vine Linux 1.1 上の apache, perl, netscape で行っています。
# 転載,改変など御自由にどうぞ。
# 転載の場合は t-kita@eecs.kumamoto-u.ac.jp まで御連絡いただけると嬉しいです。
# 改変して配布する場合は 改変したことを明記してください。
# 非常に便利な WebQuest をお作りになった 山本幹男様に謝意を表します。
# 以下のファイル名を設定してください。
$csvfile= "data/quest.csv"; # デフォルトは /usr/local/www/data/quest.csv
$htmlfile= "quest.html";
# 以下の2つは設定しなくても(コメントアウトしても)動きますが,
# 各人のアンケート結果を見やすく表示したい場合は,適当に設定してください。
@splitpoint=(3,4,5,6,10,13,14); # これらの問の前で改行する
@prepform=(3,4,5,13); # これらの問は改行をちゃんと表示する (preタグを使用)
# 棒グラフ表示用 画像
$barimg="./bar.jpg";
$/= "\r\n"; # MSDOS の改行コードがレコードセパレータ
print "Content-type: text/html\n\n";
print "
){
chop; chop; # 上の $/ を切り落とす。
$_ =~ s/([^,])""([^,])/$1″$2/g; # テキストエリアでの " を全角に。
# CGI&perl ポケットリファレンス pp.263 split (perlfaq4) CSV 分割
@line= ();
push(@line, $+) while $_ =~
m{ "([^\"\\]*(?:\\.[^\"\\]*)*)",? | ([^,]+),?| , }gx;
push(@line,undef) if substr($_,-1,1) eq ',';
if ($lnum==0){
@attr= @line;
}else{
for($col=0; $col<=$#attr; $col++){
$dataline{$lnum,$attr[$col]}= $line[$col];
$sum{$attr[$col]."-".$line[$col]}++;
}
# print "".join(' | ',@attr);
# print " | ".join(' | ',@line);
}
$lnum++;
}
$datanum= $lnum-1;
# 以下でページを生成
$/= "\n"; # UNIX の改行コードがレコードセパレータ
printf ("集計結果 (%s)\n",($tmp=localtime));
# 統計資料を表示
open(HTML,"<$htmlfile");
print ""; #### ダミー
while(){
if ($_ =~ /[<]h3[>](問|Q)[1-9]/){
print "\n \n";
print $_;
print "\n\n";
}
if ($_ =~ /([^<]*)[<]input.*name=(Q[0-9]+)([^ ]+) +value="([0-9]+)"[^>]*>(.+)$/
or
$_ =~ /([^<]*)[<]input.*name=(Q[0-9]+)([^ ]+)([^>]*)>(.+)$/
or
$_ =~ /([^<]*)[<]textarea.*name=(Q[0-9]+)([^ ]+)([^>]*)>(.+)$/){
$qprefix= $1; $qnum= $2; $qtype= $3; $qvalue= $4; $qstr= $5;
$qstr =~ s/<.*?>//; # 選択肢文内のタグは除去
if ($qtype =~/C/){
## printf("%s : %3.1f%% (%d/%d) : %s \n",$qnum, $sum{$qnum."-1"}/$datanum*100, $sum{$qnum."-1"}, $datanum, $qstr);
printf("%s | %3.1f%% | (%d/%d) | | %s | \n",$qnum, $sum{$qnum."-1"}/$datanum*100, $sum{$qnum."-1"}, $datanum, $sum{$qnum."-1"}/$datanum*100, $qstr);
}elsif ($qtype =~/R/){
## printf("%s-%d : %3.1f%% (%d/%d) : %s \n",$qnum, $qvalue, $sum{$qnum."-".$qvalue}/$datanum*100, $sum{$qnum."-".$qvalue}, $datanum, $qstr);
printf("%s-%d | %3.1f%% | (%d/%d) | | %s | \n",$qnum, $qvalue, $sum{$qnum."-".$qvalue}/$datanum*100, $sum{$qnum."-".$qvalue}, $datanum, $sum{$qnum."-".$qvalue}/$datanum*100, $qstr);
}else{
if ($qprefix eq ""){
printf("%s : %s \n",$qnum, $qstr);
}else{
printf("%s : %s □%s \n",$qnum, $qprefix, $qstr);
}
}
}
}
print " \n";
print "\n
\n";
# @splitpoint,@prepform (問番号で指定) を @sp,@pf (配列の添字で指定) に変換
@sp= (0); $j= 0;
@pf= (); $k= 0;
for($i=0; $i<=$#attr; $i++){
if ( $attr[$i]=~ sprintf("Q%02d",$splitpoint[$j]) ){
@sp=(@sp,$i);
$j++;
}
if ( $attr[$i]=~ sprintf("Q%02d",$prepform[$k]) ){
@pf=(@pf,$i);
$k++;
}
}
@sp= (@sp,$#attr+1);
# 各人の結果を全て表示
for($lnum=1; $lnum<=$datanum; $lnum++){
for($i=0; $i<$#sp; $i++){
print "\n";
print "";
for($col=$sp[$i]; $col<$sp[$i+1]; $col++){
print "".$attr[$col];
}
print " | \n";
print "";
for($col=$sp[$i]; $col<$sp[$i+1]; $col++){
$cdata= $dataline{$lnum,$attr[$col]};
if ( found($col,@pf) ){
$cdata =~ s/(\n)+$//;
printf("\n%s ",$cdata);
}else{
printf(" | %s",$cdata);
}
}
print " | \n";
print " ";
}
print "\n
\n";
}
print "\n";
# 覚書 : awk と違い,perl では $a[1] と $a['1'], $a{'1'} は同じではない!
sub found{
# @pf の要素の中に $col と同じ値のものがあるかどうか
local($col, @pf)= @_;
foreach (@pf){
if ($_==$col){
return (1==1);
}
}
return (1==0);
}
|