#!/usr/bin/perl
#------------------------
#罵声バトラver1.11
#このスクリプトはフリ−ウェアです。
#このスクリプトを使用し損害をうけても作者は一切の責任を負いません。
#改造、再配布は自由です。
#質問等はHPのサポ−ト掲示板のほうへお願いします。
#作者 yu-ame
#http://www.himawaringo.org/
#------------------------
#設定。ここは最低限の設定です。
#全部同じフォルダにつっこめればここの設定は触らんでもいいと思います
#jcode.plの場所
require "jcode.pl";
#罵声のログファイル
$file="basei.dat";
#殿堂入りファイル
$dfile="yzf_r1.dat";
#カウントファイル
$countfile="TL1000R.dat";
#このスクリプトファイル
$scr="basei.cgi";
#ロックファイル(flock)
#ロックを使用する場合は1,使用しない場合は0にして下さい。
$lockey=1;
$lockfile="lock.dat";
##あなた好みに設定。(うわ−設定できるのすくな!)すいません..めんどくさかったので(^^;
#戻り先URLだ!
$url="http://www.himawaringo.org/index.html";
#過去の戦歴の数だ!
$senreki=100;
#殿堂入りの連勝数の設定だ!
$rensyo=20;
#背景色だ!
$backcolor="#ffffff";
#チャンピオンがまけたときの絵
$mimg1="make.png";
#挑戦者が負けたときの絵
$mimg2="make.png";
#チャンピオンが勝ったときの絵
$ckimg="kati2.png";
#挑戦者が勝ったときの絵
$tkimg="kati.png";
##--設定完了
#ここから汚いプログラムです。
#自分でつくって置きながらなんとキタナイのか。
#解説をつけるのもめんどくさいのでこのままです。ごめんなさい
#それでも改造したい!ってかたは頑張ってください。
##メインプログラム
if($lockey==1){&lock;}
&openlog;
&opencount;
&decode;
&mozisu;
if ($form{'mode'} eq "fight"){
&itigyo;
&opendendo;
✓
$count++;
&writecount;
&setc;
&kekkahtml;
&syorihantei;
exit;
}
if ($form{'mode'} eq "dendo"){
&opendendo;
&dendohtml;
exit;
}
if($form{'mode'} eq "senre"){
&senrehtml;
exit;
}
&itigyo;
&getc;
&html;
exit;
##メインここまで
#デコ−ド処理
sub decode{
$method = $ENV{'REQUEST_METHOD'};
if ($method eq 'GET') {
$log = $ENV{'QUERY_STRING'};
}
elsif ($method eq 'POST') {
read(STDIN, $log, $ENV{'CONTENT_LENGTH'});
}
@group=split(/&/,$log);
foreach $ans(@group){
($name,$value)=split(/=/,$ans);
$value=~tr/+/ /;
$value=~s/%(..)/pack("c",hex($1))/ge;
$value =~ s/\t/ /g;$value =~ s/\n//g;
&jcode'convert(*value,'sjis');
$value =~ s/</g;
$form{$name}=$value;
}
$form{'name'}=~s/_//g;
$id="";
if ($form{'id'} eq 'on'){
$ip=$ENV{'REMOTE_ADDR'};
($ip1,$ip2,$ip3)=split(/\./,$ip);
$ip=sprintf("%lx%lx%lx",$ip1,$ip3,$ip2);
$ip=$ip.$ENV{'REMOTE_USER'};
$ip=$ip.$ENV{'HTTP_USER_AGENT'};
@aline=unpack('C*',$ip);
foreach $ans(@aline){$zu=$zu+1;$seed=$seed+$ans*$zu;}
srand($seed);
for($i=0;$i<5;$i++){
$a=int(rand(16));
$a=sprintf("%lx",$a);
$id=$id.$a;
}
$id="_$id";
}
}
#各種チェック
sub check{
#未項目チェック
if ($form{'come'} eq ""){&atama;print "コメント入力してね";&ketu;exit;}
if ($form{'name'} eq ""){&atama;print "名前を入力してね";&ketu;exit;}
#文字数チェック
$a=length $form{'come'};
if ($a<6){&atama;print "文字が短すぎます";&ketu;exit;}
#過去罵声チェック
foreach $ans(@line){
chomp $ans;
($n1,$c1,$c2,$n2)=split(/<@@>/,$ans);
if ($c1 eq $form{'come'}){
&atama;
print "その罵声はもう過去にあるよ";
&ketu;
exit;
}
if ($c2 eq $form{'come'}){
&atama;
print "その罵声はもう過去にあるよ";
&ketu;
exit;
}
}
#殿堂入りチェック
$ans="";
foreach $ans(@dline){
chomp $ans;
($name,$come,$nou[0],$nou[1],$nou[2],$nou[3],$nou[4],$ren)=split(/<@@>/,$ans);
if ($come eq $form{'come'}){
&atama;
print "その罵声はもう殿堂入りしてるよ";
&ketu;
exit;
}
}
}
#結果HTML
sub kekkahtml{
&atama;
print "
結果
\n";
$cname2=$cname;
$cname2=~s/_.....//g;
undef @aline;
$seed=0;
$zu=0;
@aline=unpack('C*',$form{'come'});
foreach $ans(@aline){$zu=$zu+1;$seed=$seed+$ans*$zu;}
srand($seed);
for($i=0;$i<5;$i++){$nou[$i]=int(rand(100))+1;}
print <
挑戦者 |
\能\力 |
チャンピオン |
$nou[0] |
気合 |
$cnou[0] |
$nou[1] |
精神力 |
$cnou[1] |
$nou[2] |
声量 |
$cnou[2] |
$nou[3] |
ヤクザ度 |
$cnou[3] |
$nou[4] |
カミナリおやじ度 |
$cnou[4] |
HTML
$styoka=0;
$schaka=0;
for($ia=0;$ia<5;$ia++){
$tyoka=0;
$chaka=0;
$nm=$ia+1;
print "$nm回戦
\n";
for($i=0;$i<5;$i++){
$a=int(rand($nou[$i]))+1;
$b=int(rand($cnou[$i]))+1;
if ($a>=$b){$tyoka++;}
else{$chaka++; }
}
if ($tyoka>$chaka){
$styoka++;
print <
挑戦者 |
|
$form{'come'} |
|
チャンピオン |
それでもチャンピオンかい!やる気あんのかク\ソ\!
$cname2
HTML
}
else
{
$schaka++;
print <
挑戦者 |
|
$ccome |
|
チャンピオン |
もっと気合きれて挑戦せんかい!ボケ!
$cname2
HTML
}
}
}
#勝利判定
sub syorihantei{
#チャンピオンがかったとき
if ($schaka>$styoka){
print "×$styoka−$schaka○
チャンピオンの勝ち!!
\n";
$cren++;
shift @line;
$value="$cname<@@>$ccome<@@>$form{'come'}<@@>$form{'name'}$id";
unshift @line,$value;
$value="$cname<@@>$ccome<@@>$cnou[0]<@@>$cnou[1]<@@>$cnou[2]<@@>$cnou[3]<@@>$cnou[4]<@@>$cren";
unshift @line,$value;
&writelog;
&rensyori;
print "戻る\n";
&ketu;
}
else
{
#挑戦者がかったとき
print "○$styoka−$schaka×
挑戦者の勝ち!!新チャピオン!
\n";
print "戻る\n";
&ketu;
$ren=1;
shift @line;
$value="$form{'name'}$id<@@>$form{'come'}<@@>$ccome<@@>$cname";
unshift @line,$value;
$value="$form{'name'}$id<@@>$form{'come'}<@@>$nou[0]<@@>$nou[1]<@@>$nou[2]<@@>$nou[3]<@@>$nou[4]<@@>$ren";
unshift @line,$value;
&writelog;
}
}
#連勝処理
sub rensyori{
if ($cren>=$rensyo){
print "$cren連勝 殿堂入りします!!
\n";
&opendendo;
$value="$cname<@@>$ccome<@@>$cnou[0]<@@>$cnou[1]<@@>$cnou[2]<@@>$cnou[3]<@@>$cnou[4]<@@>$cren";
@dline2="";
$g=0;
if (@dline){
foreach $ans(@dline){
chomp $ans;
($name,$come,$nou[0],$nou[1],$nou[2],$nou[3],$nou[4],$ren)=split(/<@@>/,$ans);
if ($come eq $ccome){push @dline2,$value;$g=1}else{push @dline2,$ans;}
}
}else{push @dline2,$value;$g=1;}
if ($g==0){push @dline2,$value;}
@dline=@dline2;
$ret=@dline;
$r=$ret;
for($i=0;$i<$r;$i++){
for($j=$i+1;$j<$r+1;$j++){
($iname,$icome,$inou[0],$inou[1],$inou[2],$inou[3],$inou[4],$iren)=split(/<@@>/,$dline[$i]);
($jname,$jcome,$jnou[0],$jnou[1],$jnou[2],$jnou[3],$jnou[4],$jren)=split(/<@@>/,$dline[$j]);
chomp $iren;
chomp $jren;
if ($iren<$jren){
$work=$dline[$i];
$dline[$i]=$dline[$j];
$dline[$j]=$work;
}
}
}
&writedendo;
}
}
#文字数を調べる
sub mozisu{
$mozisu=length $log;
if ($mozisu>1500){
&atama;
print "文字が多すぎます";
&ketu;
exit;
}
}
#ログファイル読み込み
sub openlog{
open(IN,"$file");
@line=;
close(IN);
}
#ログファイル書き込み
sub writelog{
open(OUT,">$file");
seek(OUT,0,0);
foreach $ans(@line){
chomp $ans;
if($ans){
print OUT "$ans\n";
$m=$m+1;
if ($m>=$senreki) {last;}
}
}
close(OUT);
}
#カウント読み込み
sub opencount{
open(IN,"$countfile");
$count=;
close(IN);
}
#カウント書き込み
sub writecount{
open(OUT,">$countfile");
seek(OUT,0,0);
print OUT "$count";
close(OUT);
}
#ログ一行読み込み
sub itigyo{
chomp $line[0];
($cname,$ccome,$cnou[0],$cnou[1],$cnou[2],$cnou[3],$cnou[4],$cren)=split(/<@@>/,$line[0]);
}
#殿堂ファイル読みこみ
sub opendendo{
open(IN,"$dfile");
@dline=;
close(IN);
}
#殿堂ファイル書き込み
sub writedendo{
open (OUT,">$dfile");
seek(OUT,0,0);
foreach $ans(@dline){
if($ans){
print OUT "$ans\n";
}
}
close(OUT);
}
##通常表示HTML
sub html{
&atama;
print <罵声でぶちのめせ!
このゲ−ムは罵声を戦わせることができるゲ−ムです。
言葉は武器だ!!さあ罵声をあびせろ!!$rensyo連勝以上で殿堂入りします
注意・タグ使用不可。あまりにヤバイのは削除
現在全$count戦
現チャンピオン
名前----$cname
「$ccome」
現在$cren連勝中
殿堂入りの言葉。
過去の戦歴
戻る
※IDについて
同じ名前を使われるということなのであまり役に立たないかもしれませんが、ちょっと対応してみました。
オンにすると名前の後ろにIDが追加されます。IDはIPと使っているブラウザで作成します。なのでアクセスポイント、ブラウザが同じならIDは常に同じものとなります。
確実な方法ではありませんが、すこしは役に立つと思います
HTML
&ketu;
}
##HTMLのケツ
sub ketu{
if($lockey==1){close(LOCK);}
##ここは消さないでね。
print <罵声でぶちのめせ! by yu-ame
HTML
}
##HTMLのアタマ
sub atama{
print "Content-type: text/html\n\n";
print "罵声でぶちのめせ!\n";
print "\n";
}
##殿堂入りHTML
sub dendohtml{
&atama;
print <殿堂入り
HTML
foreach $ans(@dline){
chomp $ans;
($name,$come,$nou[0],$nou[1],$nou[2],$nou[3],$nou[4],$ren)=split(/<@@>/,$ans);
print "なまえ | 気合 | 精神力 | 声量 | ヤクザ度 | カミナリおやじ度 | 連勝 |
\n";
print "$name | $nou[0] | $nou[1] | $nou[2] | $nou[3] | $nou[4] | $ren |
\n";
print "$come |
\n";
}
print <戻る
HTML
&ketu;
}
#過去の戦歴HTML
sub senrehtml{
&atama;
print "過去の戦歴
\n";
$a=shift @line;
foreach $ans(@line){
chomp $ans;
($name,$come,$come2,$name2)=split(/<@@>/,$ans);
print <
名前 |
$name |
$name2 |
罵声 |
$come |
$come2 |
結果 |
○ |
× |
HTML
}
print <
以上過去$senreki戦の結果です
戻る
HTML
&ketu;
}
##クッキーセット
sub setc{
($sec,$min,$hour,$day,$month,$year,$we,$n,$n)
= gmtime(time + 60*24*60*60);
@week=('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
@mons = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
$date= sprintf("%s, %02d\-%s\-%04d %02d:%02d:%02d GMT",
$week[$we],$day,$mons[$month],$year+1900,$hour,$min,$sec);
$cook="name\:$form{'name'}";
print "Set-Cookie: BASEI=$cook; expires=$date;\n";
}
##クッキーをゲット
sub getc{
$ret=$ENV{'HTTP_COOKIE'};
@pairs = split(/;/, $ret);
foreach $pair (@pairs) {
local($name, $value) = split(/=/, $pair);
$name =~ s/ //g;
$ck{$name} = $value;
}
@pairs = split(/,/, $ck{'BASEI'});
foreach $pair (@pairs) {
local($name, $value) = split(/:/, $pair);
$ck1{$name} = $value;
}
}
# ロックファイル(flock関数)
sub lock {
open(LOCK,$lockfile);
eval {flock(LOCK,2);};
}
#エラー処理
sub error {
print "Content-type: text/html\n\n";
print "$_[0]";
close(LOCK);
exit;
}