#!/usr/bin/perl ############################################################ #LS Profileアンケート #redhat7.2 & perl5.6 #charset=ISO-8859-1対策済 ############################################################ use Global; use strict; use vars qw($query %form @ans1 @ans2 @ans3 @ans4 @ans5 %a501 %a502 %a503 %a504 %a505 %a506 @ansall %sum_for_result); # use CGI qw(:standard); $query = new CGI; require "./jcode.pl"; @ans1 = ('a1011'..'a1015', 'a1021'..'a1025', 'a1031'..'a1035', 'a1041'..'a1045', 'a1051'..'a1055', 'a1061'..'a1065', 'a1071'..'a1075', 'a1081'..'a1085', 'a1091'..'a1095', 'a1101'..'a1105'); @ans2 = ('a201'..'a212'); @ans3 = ('a301'..'a317'); @ans4 = ('a401'..'a420'); @ans5 = ('a501'..'a510'); #パート5の選択肢ハッシュ %a501 = ('a','静かである','b','雑音がある','c','音楽がかかっている','d','人々が話しをしている'); %a502 = ('a','ドアを閉めて一人でいる','b','静かにしている人々と一緒にいる','c','おしゃべりをしているか、何かを行なっている人々と一緒にいる','d','ペットと一緒にいる'); %a503 = ('a','勉強机または食卓の前に座る','b','床の上に座る','c','ベッド、床、ソファーの上に横たわる','d','黒板または背の高い机のところに立つ'); %a504 = ('a','明るい照明','b','暗い照明','c','太陽の光（戸外）','d','窓を通した光','e','照明の種類はいとわない'); %a505 = ('a','すぐに寒くなる','b','すぐに暑くなる','c','窓を空けておくことを好む','d','窓を閉めておくことを好む','e','しばしばセーターまたはトレーナーが必要である','f','短パンをいつもはいているのが好きである','g','気温はたいてい私にとって快適である'); %a506 = ('a','昼食までにお腹が空く','b','昼食と夕食の間にお腹が空く','c','たいてい学校から帰る頃にお腹が空いている','d','夕食と就寝時間の間にお腹が空く','e','よくのどが渇く','f','お腹が空く、のどが渇くことはあまりない'); #################################### #各ページから送られてくる$form{'part'}値（入り口は0、以降各パートの数字）によって処理分岐。 #（入り口以外はデータスプールしてから）次ページ表示へ。$form{'part'} == 5なら集計計算と結果表示へ。 #各ページは1.html〜6.htmlをcgiで読み込んで表示しているので、変更修正は直接htmlを書き換える。 #ただしパート5の設問選択肢については上の代入用ハッシュで書き換える。 #2度打ち対策のため、tmpファイル作成＆集計後消去 #################################### #unless (param) { # print "Location: ../../success/\n\n"; # exit; #} print "Content-type: text/html; charset=x-sjis\n\n"; &parse; &survey if ($form{'stid'} eq $G_ls{'surveyid'} and $form{'passwd'} eq $G_ls{'surveypass'}); &showall if ($form{'show'} eq 'all'); &idnamemeet($form{'stid'}); &make_result if ($form{'stid'} and $form{'show'} eq 'result'); &passcheck($form{'stid'}, $form{'passwd'}) or &error('Wrong Password.') unless ($form{'part'}); # 入り口ならばpasscheck &confirm unless ($form{'part'} or $form{'confirm'}); # dataディレクトリ確認＆$G_ls{'datafile'}が既にある人なのかどうか &check_item if ($form{'part'}); # 回答の整合性チェック &data_spool if ($form{'part'}); # データ書き込み # $form{'part'} == 5なら書き込み後&make_resultへ。 &showpage; exit; ##################################### sub parse { my @name = param; foreach (@name) { my @dummy; # part2の回答だけ個数がほしいのでダミー ((param('part') == 2) and (/^a\d+/)) ? ($form{$_} = @dummy = param($_)) : ($form{$_} = param($_)); # part2の回答だけ個数に } if ($form{'part'} == 3 or $form{'part'} == 5) { # part3と5はjcodeをかける（5は前半のラジオボタン分は飛ばす） no strict 'refs'; foreach (@{'ans' . $form{'part'}}) { next if ($form{'part'} == 5 and $. < 7); if ($form{$_}) { $form{$_} =~ s/\r\n\n|\r\n|\n|\r//g; $form{$_} =~ s/,/\,\;/g; jcode::convert(\$form{$_}, 'sjis'); } } } # print "name : @name
\n";#for debug # print "part : $form{'part'}
\n";#for debug # print dump;#for debug } sub showall { print qq( LS Profile Part1
ラーニングスタイル・プロフィール・アセスメント
$G_img{'alt1'}

設問一覧


); for (1..5) {#各html内でフラグ使い。でフラグを立ててで外す my $flag = 0; my $part = $_; print "第$part調査\n"; open (DATA, "$G_ls{'successdir'}/$part.html") or &error('File Open Error.', "$part.html"); while () { $flag = 1 if (//); $flag = 0 if (//); next if (/FORM/); if ($flag) { s/\$\w+(\{'.+'\})?/$&/eeg if ($part == 5); print ; } } close (DATA); print "

\n"; } print qq(); exit; } sub survey { if (open(FILE, $G_path{'idnamedata'})) { while () { next if (/^#/); ($sname) = /^(\w+):?/; if (-e "$G_path{'datadir'}/$1/data/$G_ls{'datafile'}") { print "$1," . `cat $G_path{'datadir'}/$1/data/$G_ls{'datafile'}` . "\n"; } } close (FILE); } exit; } sub confirm { my $fileflag; # すでに$G_path{'datadir'}/$form{'stid'}/data/$G_ls{'datafile'}があるか if (-d "$G_path{'datadir'}/$form{'stid'}/data") { $fileflag = (-e "$G_path{'datadir'}/$form{'stid'}/data/$G_ls{'datafile'}"); } else{ mkdir ("$G_path{'datadir'}/$form{'stid'}/data", 0755) or &error('Make Directory Error.', "/$form{'stid'}/data"); } if ($fileflag) { print qq( LS Profile

$sname様のデータ作成の準備はできています。
以前にテストされた方は、データが上書きされてしまいますが、よろしいですか？

); exit; } } sub check_item { my $setsumon = 0; # 設問番号 if ($form{'part'} == 1) { my $set5 = 0; # 5回答刻みでチェック my $ansnum = 0; # 真値回答数 my $anssum = 0; # 回答数値合計 foreach (@ans1) { # 5回まわして足し算。3回答で合計10になっていなければ不正 $set5++; if ($form{$_}) { $ansnum++; $anssum += $form{$_}; } if ($set5 == 5) { $setsumon++; &ls_error('Error','1',$setsumon) unless ($anssum == 10 and $ansnum == 3); $set5 = $ansnum = $anssum = 0; } } } if ($form{'part'} == 4) { # パート1：8問はラジオボタンの未選択をはじく # パート2は12題に1〜3位の打ち方チェック my $ansnum = 0; # 真値回答数 my $anssum = 0; # 回答数値合計 foreach (@ans4) { if ($setsumon < 8) {#############part1 $setsumon++; &ls_error('Error','4',$setsumon) unless ($form{$_}); } else {#############part2 if ($form{$_}) { $ansnum++; $anssum += $form{$_}; } } } &ls_error('Error','4','パート2') unless ($anssum == 6 and $ansnum == 3); } if ($form{'part'} == 5) { # パート1&2：6問はラジオボタンの未選択をはじく foreach (@ans5) { if ($setsumon < 6) { ############# part1&2 $setsumon++; &ls_error('Error','5',$setsumon) unless ($form{$_}); } } } } sub data_spool { # 2度打ち対策にtmpファイルを使う my ($final, $message); no strict 'refs'; open (DATA, ">$G_path{'datadir'}/$form{'stid'}/data/$form{'part'}.tmp") or &error('File Open Error.', "$form{'part'}.tmp"); foreach (@{'ans' . $form{'part'}}) { print DATA "$form{$_},"; } close (DATA); # ここは5.tmpは作った後。 # データ取りまとめ（1..5.tmpを$finalに連結してから$G_ls{'datafile'}に。unlink 1..5.tmp） if ($form{'part'} == 5) { for (1..5) { open (DATA, "$G_path{'datadir'}/$form{'stid'}/data/$_.tmp") or &error('File Open Error.', "$_.tmp", '（途中のパートからやり直しましたか？）'); $final .= ; close (DATA); # push (@ansall, @{'ans'.$_}); # ついでにここで回しちゃおう } $final =~ s/,$//; # 行末のカンマ落とし open (DATA, ">$G_path{'datadir'}/$form{'stid'}/data/$G_ls{'datafile'}") or &error('File Open Error.', "$G_ls{'datafile'}"); print DATA "$final"; close (DATA); for (1..5) { #内容は$finalに移したので掃除。$G_ls{'datafile'}を作った後で。 unlink "$G_path{'datadir'}/$form{'stid'}/data/$_.tmp"; } # データスプールはここまで # &make_result; # for test メールしないで結果表示 # $G_mail{'mailto'} = 'art@mimir.ne.jp'; # テスト用 # $G_mail{'mailfrom'} = ''; # テスト用 # $G_mail{'bccmail'} = 'gogo@mimir.ne.jp'; # テスト用 # メール送信 $message = <; close (DATA); # $form{'part'} = 5; # } @ans = split (/,/, $final); foreach (@ansall) { $form{$_} = shift (@ans); $form{$_} = " " unless ($form{$_}); # テーブルの空セル対策 } #足し算やら掛け算やら該当テキスト代入やら my $set5 = 0; # 5回答刻みでチェック foreach (@ans1) { # 5,4は加算、1はマイナス1する%sum_for_result no strict 'refs'; $set5++; ($form{$_} > 1) ? ($sum_for_result{$set5} += $form{$_}) : ($sum_for_result{$set5} -= $form{$_}); # 6.html内の変数 $set5 = 0 if ($set5 == 5); } foreach (@ans2) { # チェック数×10点 $form{$_} *= 10; } foreach (@ans4[0..7]) { # abcそれぞれの個数×10点 no strict 'refs'; $sum_for_result{$form{$_}} += 10; } foreach (@ans4[8..19]) { # 1〜3順位づけ if ($form{$_} =~ /\d/) { $form{$_} .= '位
'; } } foreach (@ans5[0..5]) { # パート5の選択肢のテキスト化 $a501 = $a501{'a'} no strict 'refs'; $form{$_} = ${$_}{$form{$_}}; } &showpage if ($form{'show'} eq 'result'); } sub showpage { $form{'show'} eq 'result' and $form{'part'} = 5; $form{'part'}++; open (IN,"$G_ls{'successdir'}/$form{'part'}.html") or &ls_error($form{'part'}); while () { s/\$\w+(\{'\w+'\})?/$&/eeg; print; } close IN; exit; } sub ls_error { # 'Error' : header footer未送出 print "

$_[0]


Part $_[1] : 設問$_[2]の回答が不正です。
\n" if ($_[0] eq 'Error'); print "ブラウザで戻って再入力してください。\n" if ($_[0] eq 'Error'); print "

File Open Error $_[0]


パート$_[0]のデータが読み込めませんでした。
\n" if ($_[0] =~ /\d/); print "データ処理を完了しませんでした。\n" if ($_[0] eq 'Mail Error'); print "システム部へ問い合わせてみてください。" unless ($_[0] eq 'Error'); exit; }