$title

#!/usr/local/bin/perl #------------------------------------------# # ↑このperlのパスはプロバイダによって違う # # ので、分からないときはプロバイダに聞く。 # #------------------------------------------# ########################################################### # PerlInquire Ver.3.00 # # # # 種別　　　　　： Free # # 作成日　　　　： 11/21/1997 # # 更新日　　　　： 11/13/2000 # # 著作権者　　　：飾り職人ひで(Hideyuki Chikada) # # メールアドレス： hideyuki@din.or.jp # # ホームページ　： http://www.din.or.jp/~hideyuki/home/ # # # # Copyright (c) 1997-1998 Hideyuki Chikada # # All rights reserved. # #=========================================================# # この著作権表示は書き換えないで下さい # ########################################################### ########## ↓ 初期設定(必要に応じて書き換える) ↓ ########## ##### このファイル $thisfile = '../inquire/perlinqu.cgi'; ##### ログファイル(inqudata.dat)のパス $logfile = '../inquire/inqudata.dat'; ##### ロックファイル用ディレクトリ(lock)のパス (最後のスラッシュ(/)は不要) #------------------------------------------------------# # perlinqu.cgiがあるディレクトリ内にlockという名前のデ # # ィレクトリを作成し、パーミッションを777にして下さい。# #------------------------------------------------------# $lockdir = './lock'; ##### 棒グラフ用の画像 $graph = 'http://contest.thinkquest.jp/tqj2002/50533/graph.gif'; ##### アンケートのタイトル $title = 'PerlInquire Ver.3.00'; ##### 文字色や背景色、壁紙などの設定(普通のBODYタグ) $body = ''; ##### FORMタグのMETHOD属性 #-------------------------------------------# # Method not implemented.. というエラーが　 # # 出る場合は、POSTをGETに書き換えて下さい。 # #-------------------------------------------# $method = 'POST'; ##### 「ホームページへ戻る」のリンク先URL $back = 'http://contest.thinkquest.jp/tqj2002/50533/top.html'; ##### 記録させるデータの最大件数 #------------------------------------------------# # この数値を越えると古いデータから削除されます。 # #------------------------------------------------# $max = 1000; ##### アンケートの項目 #-------------------------------------------------------# # 項目は、いくつでも増やすことができます。　　　　　　 # # 項目を増やす場合は、下のように0から始まる一連の数字を # # 続けて下さい。　　　　　　　　　　　　　　　　　　　 # # 尚、運営途中で項目を変更する場合は、データの整合性が # # なくなるので、必ず「inqudata.dat」を空にして下さい。 # #-------------------------------------------------------# $head[0] = 'あなたは？'; $head[1] = 'ゴミ問題で取り組んでいることがありますか？'; $head[2] = 'このホームページはどうでしたか？'; $head[3] = 'このホームページで一番良かったコーナーは？'; ##### 各項目の回答 #------------------------------------------------------# # 下の数字の部分は、上記「アンケートの項目」の各数字に # # 対応しています。　　　　　　　　　　　　　　　　　　 # # それぞれの回答は、半角カンマで区切って、複数指定して # # 下さい。いくつでも設定できます。　　　　　　　　　　 # # 尚、運営途中で項目を変更する場合は、データの整合性が # # なくなるので、必ず「inqudata.dat」を空にして下さい。 # #------------------------------------------------------# $option[0] = '小､中学生,高校生,大学生,社会人,その他'; $option[1] = '空き缶やペットボトルのリサイクル,新聞や雑誌のリサイクル,町の清掃活動,何もしてない,その他'; $option[2] = '難しすぎる,簡単すぎる,勉強になった,ゴミ問題に興味を持った,つまらなかった'; $option[3] = '生物とゴミ,クイズ,掲示板,リンク'; ########## ↑ 初期設定ここまで ↑ ########## #----------------------------------------------------------# # ここから下をカスタマイズするには、Perlの知識が必要です。 # # Perlについて充分な知識のない方は、変更しないで下さい。　 # #----------------------------------------------------------# ##### ロックファイル $lockfile = "$lockdir/inqu"; ##### フォームデータ受け取り if ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'}); @pairs = split(/&/,$buffer); } else { @pairs = split(/&/,$ENV{'QUERY_STRING'}); } foreach $pair (@pairs) { ($k,$v) = split(/=/,$pair); if ($k ne 'action' && $v ne "") { $noblank = 1; } $in{$k} = $v; } ##### 未選択エラー or 送信 or HTML出力 if ($in{'action'} eq 'send') { if (! $noblank) { &Error('Bad Request','空の送信はできません。
ブラウザーの戻るボタンで戻って、各項目を選択して下さい。'); } &OpenLock; &ReadFile; &WriteFile; &CloseLock; &PrintLog; } else { &ReadFile; &PrintLog; } ##### ロックファイル作成 sub OpenLock { $lockchek = 0; while (! mkdir($lockfile,0755)) { if (++$lockchek > 10) { &CloseOld; &Error("Can't open",'ロックファイルのオープンに失敗しました。
ブラウザーの更新（再読み込み）ボタンを押して下さい。'); } sleep(1); } } ##### 古いロックファイル消去 sub CloseOld { @stat = stat($lockfile); if (time - $stat[9] > 180) { &CloseLock; } } ##### ロックファイル消去 sub CloseLock { rmdir($lockfile); } ##### ログファイル読み込み sub ReadFile { for ($filechek = 0; $filechek < 5; $filechek++) { if (! open(LOG,"$logfile")) { if ($in{'action'} eq 'send') { &CloseLock; } &Error("Can't open",'ログファイルの読み込みに失敗しました。
ブラウザーの更新（再読み込み）ボタンを押して下さい。'); } @inqulogs = ; close(LOG); if (@inqulogs) { last; } sleep(1); } } ##### ログファイル書き込み sub WriteFile { @lastlog = split(/,/,$inqulogs[0]); if ($lastlog[0] eq $ENV{'REMOTE_ADDR'}) { &CloseLock; &Error('Bad Request','連続して送信することは出来ません。'); } $newlog = "$ENV{'REMOTE_ADDR'},"; foreach (0..$#head) { $newlog .= "$in{$_},"; } $newlog .= "\n"; @inqulogs = ($newlog,@inqulogs); if ($#inqulogs >= $max) { $#inqulogs = $max - 1; } if (! open(LOG,">$logfile")) { &CloseLock; &Error("Can't open",'ログファイルへの書き込みに失敗しました。
ブラウザーの更新（再読み込み）ボタンを押して下さい。'); } print LOG @inqulogs; close(LOG); } ##### HTML出力 sub PrintLog { print "Content-type: text/html\n\n"; ##### ヘッダ出力 print "\n\n\n$title\n"; print "\n"; print "\n"; print "$body\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "

$title

ホームページへ戻る

\n"; print "

\n"; print "下のアンケートに答えて、送信ボタンを押して下さい。
\n"; print "送信した内容は、すぐにアンケート結果に反映されます。

\n"; ##### アンケートフォーム出力 print "

\n"; print "
\n"; } else { $all = @inqulogs; print "アンケート集計結果 （最新$all件の集計結果です）\n"; print "\n"; foreach $ques (0..$#head) { print "$head[$ques]\n"; print "\n"; print "\n"; print "

\n"; print "\n"; print "\n"; $null = 0; %total = (); foreach (@inqulogs) { @logparts = split(/,/,$_); $ans = $logparts[$ques+1]; if ($ans eq "") { $null++; } else { $total{$ans}++; } } @parts = split(/,/,$option[$ques]); foreach (0..$#parts) { if (! $total{$_}) { $total{$_} = 0; } } foreach (sort {$total{$b} <=> $total{$a}} keys(%total)) { $rate = $total{$_} / $all * 100; $rate = sprintf("%.1f",$rate); $width = int($rate * 5 + 0.5); print "\n"; } if (! $null) { $null = 0; } $rate = $null / $all * 100; $rate = sprintf("%.1f",$rate); $width = int($rate * 5 + 0.5); print "\n"; print "

回答項目	件数	グラフ
$parts[$_]	$total{$_}	"; if ($width) { print ""; } print " $rate\%
無回答	$null	"; if ($width) { print ""; } print " $rate\%

\n"; print "

\n"; } } ##### フッタ出力 print "

\n"; #--------------------------------# # ここは、書き換えないで下さい。 # #--------------------------------# print "

PerlInquire Ver.3.00

\n"; print "\n\n"; exit; } ##### エラー表示 sub Error { print "Content-type: text/html\n\n"; print "\n\n\n$_[0]\n\n"; print "\n"; print "

$_[0]

\n"; print "$_[1]\n"; print "\n\n"; exit; }

$head[$_]