#!/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 "集計結果\n"; print "\n"; open(CSV,"<$csvfile"); $lnum=0; while(){ 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("\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("\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 "
%s %3.1f%% (%d/%d) %s
%s-%d %3.1f%% (%d/%d) %s
\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 "\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\n"; print "
".$attr[$col]; } print "
%s
",$cdata); }else{ printf("
%s",$cdata); } } 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); }