$title2

#! /usr/bin/perl #---------------------------------------------------------------------- # だぼっち心理ゲームＡ ver 1.01 (Free) # AUTHOR : Alpha-kou. # E-MAIL : dabo@dabo.design.co.jp # URL : http://dabo.pobox.ne.jp/ # # 無断で転載、再配布しないでください。 # [このスクリプトを使用して起きたいかなる損害にも責任は負いません。] #---------------------------------------------------------------------- $| = 1; require './jcode.pl'; ##########ローカル変数指定 sub kankyou{ # 基本設定 $cgifile = 'hearta.cgi'; # このファイル名 $logfile = './hearta1.dat'; # ログファイル（なるべく変更すること） $countfile = './count1.dat'; # 人数カウントファイル（なるべく変更すること） $method = 'POST'; # GET or POSTを指定 $max_hyouji = '100'; # ほかの人の記録保存件数 $title = '心理ゲーム'; # タイトル $title2 = '心理ゲーム'; # ブラウザ上のタイトル $comment = ''; # タイトル下のコメント（タグ可能） $url = 'http://www.mmm.ne.jp/~supika/'; # 戻り先ＵＲＬ $longname = '6'; # 名前の長さを全角で（0なら無制限） $longword = '10'; # 言葉の長さを全角で（0なら無制限） # ページ全体（変数の名前はbodyタグそのままです。） $bgcolor = 'C0E0FF'; # default:C0E0FF $text = '000000'; # default:000000 $link = '0000CD'; # default:0000CD $vlink = '6699FF'; # default:6699FF $alink = '303030'; # default:303030 $background = ''; # 背景画像 $ysize = 600; # 横幅（解像度が低い人のために、出来るだけ600にしてください。） # タイトル $tcolor = '3366FF'; # タイトルの色(default:3366FF) $tsize = '6'; # タイトルサイズ(default:6) # 表示部分 $iroformwaku = '6699FF'; # フォームの枠 (default:6699FF) $iroformnaka = 'E0F0FF'; # フォームの中 (default:C0E0FF) $border = '0'; # フォームに普通の枠を付けるか $meskakiko = '次へ進む'; # 書き込みボタン $meshome = 'ゆにちゃ♪Ｔｏｐ'; # ホームページボタン if ($longname){ $warn1 = "名前は$longname文字以下してね。
";} if ($longword){ $warn2 = "言葉は$longword文字以下してね。
";} sub message{ local($_) = @_; $message[1] = "まずは名前を書いてね。名前は適当な名前でいいよ。
$warn1
"; $message[2] = "それでは$nameさん、がんばっていってみようっ！
"; $message[3] = "まだまだ先は長いぞっ。
"; $message[4] = "半分は経過した。がんばれ～！
"; $message[5] = "結果が分かるまで後一歩だ！
"; $message[6] = "これに答えたら結果が分かる！
"; $message[7] = "結果は以下の通りです。
"; return $message[$_] } ##########設定ここまで $body = ""; }#END kankyou &kankyou; &decode; if ($no == 0) {&zero;} elsif ($no == 1) {&one;} elsif ($no == 2) {&two;} elsif ($no == 3) {&three;} elsif ($no == 4) {&four;} elsif ($no == 5) {&five;} elsif ($no == 6) {&six;} elsif ($no == 7) {&seven;} elsif ($no == 8) {&eight;} $no++; $message = &message($no); &html; exit; ##########デコード＆ローカル変数へ受け渡し sub decode{ #入力された値をデコード if ($ENV{'REQUEST_METHOD'} eq "GET") { $buffer = $ENV{'QUERY_STRING'}; } elsif ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } @pairs = split(/&/,$buffer); foreach $pair (@pairs) { ($key, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; &jcode'convert(*value, "sjis"); $value =~ s/　//g; $value =~ s/ //g; $value =~ s//>/g; length($value) >= $longword *2 && $error++; $form{$key} = $value; } $no = $form{'no'}; $name = $form{'name'}; $a = $form{'a'}; $b = $form{'b'}; $c = $form{'c'}; $d = $form{'d'}; $e = $form{'e'}; $f = $form{'f'}; $g = $form{'g'}; $h = $form{'h'}; $i = $form{'i'}; $j = $form{'j'}; $k = $form{'k'}; $l = $form{'l'}; $m = $form{'m'}; $n = $form{'n'}; $o = $form{'o'}; $p = $form{'p'}; $q = $form{'q'}; $r = $form{'r'}; $s = $form{'s'}; $t = $form{'t'}; length($name) >= $longname *2 && &error(2); ($error) && &error(3); }#END decode sub zero{ $form[0] = qq|なまえ　

\n|; } sub one{ ($name) || (&error(0)); $form[0] = qq|次の１０個の欄に、ぱっと思いついた名詞、固有名詞、形容詞を書いてね。
$warn2
\n|; $form[1] = qq|ことば１　　　\n|; $form[2] = qq|ことば２　

\n|; $form[3] = qq|ことば３　　　\n|; $form[4] = qq|ことば４　

\n|; $form[5] = qq|ことば５　　　\n|; $form[6] = qq|ことば６　

\n|; $form[7] = qq|ことば７　　　\n|; $form[8] = qq|ことば８　

\n|; $form[9] = qq|ことば９　　　\n|; $form[10] = qq|ことば10　

\n|; } sub two{ ($a)||(&error(1)); ($b)||(&error(1)); ($c)||(&error(1)); ($d)||(&error(1)); ($e)||(&error(1)); ($f)||(&error(1)); ($g)||(&error(1)); ($h)||(&error(1)); ($i)||(&error(1)); ($j)||(&error(1)); $form[0] = qq|「$a」と「$b」から連想されるものを書いてね。　\n|; $form[1] = qq|

\n|; $form[2] = qq|「$c」と「$d」から連想されるものを書いてね。　\n|; $form[3] = qq|

\n|; $form[4] = qq|「$e」と「$f」から連想されるものを書いてね。　\n|; $form[5] = qq|

\n|; $form[6] = qq|「$g」と「$h」から連想されるものを書いてね。　\n|; $form[7] = qq|

\n|; $form[8] = qq|「$i」と「$j」から連想されるものを書いてね。　\n|; $form[9] = qq|

\n|; $hidden[0] = qq|\n|; $hidden[1] = qq|\n|; $hidden[2] = qq|\n|; $hidden[3] = qq|\n|; $hidden[4] = qq|\n|; $hidden[5] = qq|\n|; $hidden[6] = qq|\n|; $hidden[7] = qq|\n|; $hidden[8] = qq|\n|; $hidden[9] = qq|\n|; } sub three{ ($a)||(&error(1)); ($b)||(&error(1)); ($c)||(&error(1)); ($d)||(&error(1)); ($e)||(&error(1)); $form[0] = qq|「$a」と「$b」から連想されるものを書いてね。　\n|; $form[1] = qq|

\n|; $form[2] = qq|「$c」と「$d」から連想されるものを書いてね。　\n|; $form[3] = qq|

\n|; $form[4] = qq|\n|; $hidden[0] = qq|\n|; $hidden[1] = qq|\n|; $hidden[2] = qq|\n|; $hidden[3] = qq|\n|; $hidden[4] = qq|\n|; } sub four{ ($a)||(&error(1)); ($b)||(&error(1)); ($c)||(&error(1)); $form[0] = qq|「$a」と「$b」から連想されるものを書いてね。　\n|; $form[1] = qq|

\n|; $form[2] = qq|\n|; $hidden[0] = qq|\n|; $hidden[1] = qq|\n|; $hidden[2] = qq|\n|; } sub five{ ($a)||(&error(1)); ($b)||(&error(1)); $form[0] = qq|「$a」と「$b」から連想されるものを書いてね。　\n|; $form[1] = qq|\n|; $hidden[0] = qq|\n|; $hidden[1] = qq|\n|; } sub six{ ($a)||(&error(1)); $number = &count; sub count{ open(FILE,"+<$countfile"); eval 'flock(FILE, 2);'; $count = ; $count++; seek(FILE,0,0); print FILE "$count"; eval 'flock(FILE, 8);'; close(FILE); return $count; } $form[0] = qq|$nameさん、あながた今一番欲しいもの、
必要としているものは、

「$a」

です！

\n|; $form[1] = qq|さてさて、このデータをログファイルに登録してみませんか？
\n|; $form[2] = qq|登録すると、他の人が登録したデータも見ることが出来ます。
\n|; $form[3] = qq|わたしは心が広いので、ログファイルに登録する。

\n|; $form[4] = qq|今までにこのゲームに参加した人：$number人\n|; $form[5] = qq|\n|; } sub seven{ if($form{'rec'}){&record;} sub record{ ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $mon++; $hour = sprintf("%02d",$hour); $min = sprintf("%02d",$min); $jikan = "$mon月$mday日 $hour時$min分"; $host1 = $ENV{'REMOTE_HOST'}||$ENV{'REMOTE_ADDR'}; $host1 = gethostbyaddr(pack('c4',split(/\./, $host1)), 2) || $host1; $kakiko = qq|$nameさんが$jikanに一番欲しかったもの、
それは$aです（$host1）

\n|; open(LOG,"+<$logfile"); eval 'flock(LOG, 2);'; @lines = ; unshift (@lines , $kakiko); splice(@lines, $max_hyouji); seek(LOG,0,0); print LOG @lines; eval 'flock(LOG, 8);'; close(LOG); $thanks = qq|登録してくださってありがとうございました。
以下はほかの人の記録です。
ここをブックマークに登録すると記録は何度でも見られます。

\n|; } $form[0] = qq|$thanks|; $form[1] = qq|@lines|; $form[2] = qq|長い間つきあってくださってありがとうございました
\n|; $form[3] = qq|$meskakikoを押すと最初の画面に戻ります。
\n|; $no = $no -8; } sub eight{ open(LOG,"$logfile"); @lines = ; seek(LOG,0,0); close(LOG); open(FILE,"$countfile"); seek(FILE,0,0); $count = ; close(FILE); $form[0] = qq|このページをブックマークに登録すると、ログはいつでも見られます。
|; $form[1] = qq|$meskakikoを押すと最初の画面に戻ります。
|; $form[2] = qq|今までにこのゲームに参加した人：$count人

\n|; $form[3] = qq|@lines|; $no = $no -9; } ##########発言の処理 sub syori{ #名前入力チェック if($name eq ''){&error(8);} #リモートホストを取得 $host = $ENV{'REMOTE_HOST'}; }#END syori ##########ＨＴＭＬを出力 sub html{ if($title){$comment = "

$comment";} print "Content-type: text/html\n\n";#コンテントタイプ出力 print <<"_HTML1_"; $title2 $body $title $comment

$message

_HTML1_ print <<"_BODY_";

だぼっち心理ゲームＡver1.01(Free)

_BODY_ }#END html ##########エラーメッセージ ###エラーの時の処理。 sub error { local($mesno) = @_; $msg[0] = '名前を入力してね。'; $msg[1] = '言葉をちゃんと書いてね。'; $msg[2] = '名前が長すぎるよ。'; $msg[3] = '言葉が長すぎるよ。'; $no--; print "Content-type: text/html\n\n"; print <<"_ERROR_"; ERROR $body $msg[$mesno]
_ERROR_ exit; }#END error