){
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[>](問|Ｑ)[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);
}
|