#!/usr/local/bin/perl

# ##################################################################
# PET ROOM Editer Ver1.2
#        Copyright (C) 2000 Sho Sunami.
#             All rights reserved.
# 作成者 Sho Sunami
# E-mail:　sho@area-s.com
# Home Page:　http://www.area-s.com/
# And Produce:　http://www.fayreal.com/
# このスクリプトはフリーウェアです。
# 改造は自由ですが、二次配布は禁止します。
# 著作権はTHE MISSING LINK並びにFayrealが保有します。
# 質問等はサポート掲示板まで。
# http://www.fayreal.com/cgi-bin/missinglink/support/support.cgi
# ##################################################################

# ########################設定はここから############################

require '../jcode.pl'; # jcode.pl のパス

$cgiurl   = './index.cgi'; # このCGIのパス

$petdata  = '../pet.dat'; # ペットデータのパス
$userdata = '../user.dat'; # ユーザーデータのパス

$method   = 'POST'; # メソッド

$lockkey  = 1; # ロックを使用する(Yes = 1,No = 0)
$pass     = '0123'; # パスワード

# ##########################設定終わり##############################


$ENV{'TZ'} = "JST-9";
$pettime   = time;
$daysec    = 86400;
$ver       = '1.2';

&decode;
if ($FORM{'mode'} eq "")        { &pass; }
if ($FORM{'mode'} eq "enter")   { &enter; }
if ($FORM{'mode'} eq "rewrite") { &writepet; }
if ($FORM{'mode'} eq "delete")  { &deleteform; }
if ($FORM{'mode'} eq "deleted") { &deletedform; }
&adminform;
exit;

# ------------------------- #
# Sub Password
# ------------------------- #
sub pass {
    &header;
    print "<center>\n";
    print "<form>\n";
	print "<div align=\"center\">パスワードを入力してください\n";
    print "<input type=\"password\" name=\"pass\" size=\"10\">\n";
    print "<input type=\"hidden\" name=\"mode\" value=\"enter\">\n";
    print "<input type=\"submit\" value=\"OK\" name=\"submit\">\n";
    print "</center>\n";
    print "</form>\n";
    print "</body>\n";
    print "</html>\n";
    exit;
}

# ------------------------- #
# Sub Enter
# ------------------------- #
sub enter {
    if ($FORM{'pass'} ne $pass) { &error('パスワードが違います') }
}

# ------------------------- #
# Sub Admin Form
# 管理者編集モード
# ------------------------- #
sub adminform {
    &header;
    print "<font color=\"#FF0000\">ペットデータ変更用CGI</font><br>";
    print "日付をマイナスする場合、数値の前に-をつけてください。<br>\n";
    print "例：3日後 3　例：3日前 -3<br>\n";
    print "日付の変更は現在に日付を基準にしています。<br><br>\n";
    
    print "現在の日付："; &gettime(time); print "$date<br>\n";

    &readpet;
    print "<form method=\"$method\" action=\"$cgiurl\">\n";
    print "ペットの名前：\n"; print "$petname<br>\n";
    print "変更する名前<br>\n";
    print "<input type=\"text\" name=\"name\"><br>\n";
    print "ペットの名付け親：\n"; print "$godfather<br>\n";
    print "変更する名前<br>\n";
    print "<input type=\"text\" name=\"godfather\"><br>\n";
    print "ペットの性別：\n"; print "$sex<br>\n";
    print "変更する性別<br>\n";
    print "<input type=\"text\" name=\"sex\"><br>\n";
    print "ペットの代：\n"; print "$num<br>\n";
    print "変更する代<br>\n";
    print "<input type=\"text\" name=\"num\"><br>\n";
    print "現誕生日：\n"; &gettime($birth); print "$date<br>\n";
    print "何日前(後)に設定しますか？<br>\n";
    print "<input type=\"text\" name=\"birth\"><br>\n";
    print "最後に餌をあげた日：\n"; &gettime($lastfeed); print "$date<br>\n";
    print "何日前(後)に設定しますか？<br>\n";
    print "<input type=\"text\" name=\"lastfeed\"><br>\n";
    print "最後に訪問者が来た日：\n"; &gettime($lastvisit); print "$date<br>\n";
    print "何日前(後)に設定しますか？<br>\n";
    print "<input type=\"text\" name=\"lastvisit\"><br>\n";
    print "最後にペットが遊んだ日：\n"; &gettime($lastplay); print "$date<br>\n";
    print "何日前(後)に設定しますか？<br>\n";
    print "<input type=\"text\" name=\"lastplay\"><br>\n";
    print "ペットの現在のGOOD POINT：$good<br>\n";
    print "変更する場合は数値を入力<br>\n";
    print "<input type=\"text\" name=\"good\"><br>\n";
    print "ペットの現在のBAD POINT：$bad<br>\n";
    print "変更する場合は数値を入力<br>\n";
    print "<input type=\"text\" name=\"bad\"><br>\n";
    print "ペットの外出フラグ(1=外出,0=在宅)：$out<br>\n";
    print "変更する場合は数値を入力<br>\n";
    print "<input type=\"text\" name=\"out\"><br>\n";
    print "<input type=\"submit\" value=\"送信\">\n";
    print "<input type=\"hidden\" name=\"mode\" value=\"rewrite\">\n";
    print "</form>";
    print "<form method=\"$method\" action=\"$cgiurl\">\n";
    print "<input type=\"submit\" value=\"ユーザーデータを個別に削除する\">\n";
    print "<input type=\"hidden\" name=\"mode\" value=\"delete\">\n";
    print "</form>";
    &footer;
}

# ------------------------- #
# Sub Delete Form
# ユーザーデータ削除モード
# ------------------------- #
sub deleteform {
    &header;
    print "<font color=\"#FF0000\">ユーザーデータ削除モード</font><br>";
    print "削除するユーザーをチェックしてください。（赤い数字はラブポイント）<br>\n";
    print "<form method=\"$method\" action=\"$cgiurl\">\n";
    &readuser;

    foreach $line (@lines) {
        ($username,$dummy1,$dummy2,$love) = split(/<>/,$line);
        print "<input type=\"checkbox\" name=\"$username\" value=\"on\">\n";
        print "$username　";
        print "<font color=\"#FF0000\">$love</font><br>\n";
    }
    print "<input type=\"hidden\" name=\"mode\" value=\"deleted\"><br>\n";
    print "<input type=\"submit\" value=\"OK\"><br>\n";
    &footer;
    exit;
}

# ------------------------- #
# Sub Deleted Form
# ユーザーデータ削除処理
# ------------------------- #
sub deletedform {
    &readuser;
    foreach $line (@lines) {
        ($username,$dummy1,$dummy2,$love) = split(/<>/,$line);
        if ($FORM{"$username"} ne 'on') {
            push (@newlines,$line);
        }
    }
    &lock if $lockkey == 1;
    open(OUT,">$userdata") || &error("out");
    print OUT @newlines;
    close(OUT);
    &unlock;
}

# ------------------------- #
# Sub Write Pet
# ペットデータの書き込み
# ------------------------- #
sub writepet {
    &lock if $lockkey == 1;
    &readpet;
    if ($FORM{name} ne '')      { $petname   = $FORM{name}                             }
    if ($FORM{godfather} ne '') { $godfather = $FORM{godfather}                        }
    if ($FORM{sex} ne '')       { $sex       = $FORM{sex}                              }
    if ($FORM{birth} ne '')     { $birth     = $pettime + ($FORM{birth} * $daysec)     }
    if ($FORM{lastfeed} ne '')  { $lastfeed  = $pettime + ($FORM{lastfeed} * $daysec)  }
    if ($FORM{lastplay} ne '')  { $lastplay  = $pettime + ($FORM{lastplay} * $daysec)  }
    if ($FORM{lastvisit} ne '') { $lastvisit = $pettime + ($FORM{lastvisit} * $daysec) }
    if ($FORM{good} ne '')      { $good      = $FORM{good}                             }
    if ($FORM{bad} ne '')       { $bad       = $FORM{bad}                              }
    if ($FORM{out} ne '')       { $out       = $FORM{out}                              }
    if ($FORM{num} ne '')       { $num       = $FORM{num}                              }
    
    $line = "$petname<>$godfather<>$birth<>$sex<>$dead<>$lastfeed<>$lastplay<>$lastvisit<>$good<>$bad<>$out<>$outdate<>$num";
    open(OUT,">$petdata") || &error("out");
    print OUT $line;
    close(OUT);
    &unlock;
}

# ------------------------- #
# Sub Read Pet
# ペットデータの読み取り
# ------------------------- #
sub readpet {
    &lock if $lockkey == 1;
    open(IN,"$petdata") || &error("in");
    $line = <IN>;
    close(IN);

    ($petname,$godfather,$birth,$sex,$dead,$lastfeed,$lastplay,$lastvisit,$good,$bad,$out,$outdate,$num) = split(/<>/,$line);
    &unlock;
}

# ------------------------- #
# Sub Read User
# ペットデータの読み取り
# ------------------------- #
sub readuser {
    &lock if $lockkey == 1;
    open(IN,"$userdata") || &error("in");
    @lines = <IN>;
    close(IN);
    &unlock;
}

# ------------------------- #
# Sub Decode
# デコード
# ------------------------- #
sub decode {
# フォームからのデータを取得
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
        @pairs = split(/&/, $buffer);
	} else { @pairs = split(/&/, $ENV{'QUERY_STRING'}); }

    # フォームからのデータを連想配列に格納
    foreach $pair (@pairs) {
        ($name, $value) = split(/=/, $pair);
        $name =~ tr/+/ /;
        $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

        &jcode'convert(*name,'sjis');
        &jcode'convert(*value,'sjis');

        # 入力データのチェック
        # タグが入力されていれば、それを無効にする。&ltなどに置き換え表示してる
        $value =~ s/</&lt;/g;
        $value =~ s/>/&gt;/g;
        # 区切り文字の”,”があれば”，”に変換
        $value =~ s/\,/，/g;
        # 改行コードを<br>に変換(上からWin、Mac、Unix用の処理)
        $value =~ s/\r\n/<br>/g;
        $value =~ s/\r/<br>/g;
        $value =~ s/\n/<br>/g;

        # 連想配列に格納
        $FORM{$name} = $value;
    }
}

# ------------------------- #
# Sub Get Time
# 時間の取得
# ------------------------- #
sub gettime {
    ($sec,$min,$hour,$dy,$mon,$year,$wday,$yday,$isdst) = localtime($_[0]);
    $year += 1900 ;
    $mon = $mon + 1;
    @week = ('sun','mon','tue','wed','thu','fri','sat');

    $date = "$year\/$mon\/$dy\($week[$wday]\) $hour\:$min\:$sec";
}

# ------------------------- #
# Sub Error
# エラー
# ------------------------- #
sub error {
    &header;
    print "<P><h3>ERROR !</h3>\n";
    print "<P><font color='red'><B>$_[0]</B></font><br><br>\n";
    &footer;
    &unlock;
    exit;
}

# ------------------------- #
# Sub Header
# ヘッダー
# ------------------------- #
sub header {
    print "Content-type: text/html\n\n";
    print "<html>\n<head>\n";
    print "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=Shift_JIS\">\n";
    print "<title>$title</title>\n";

print <<"EOM";
<STYLE TYPE="text/css">
<!--
body,tr,td,th { font-size:10pt }
-->
</STYLE>
</head>
EOM
    print "<body>\n";
}

# ------------------------- #
# Sub Footer
# フッター
# ------------------------- #
sub footer {
    print "PET ROOM Editer Ver $ver <br>\n";
    print '<a href="http://www.area-s.com/" target="_blank">[MISSINGLINK]</a> & <a href="http://www.fayreal.com/" target="_blank">[Fayreal]</a>';
    print "</body>\n</html>\n";
}

# ------------------------- #
# Sub Lock
# ロック
# ------------------------- #
sub lock {
    local($flag) = 0;
	foreach (1 .. 5) {
		if (-e $lockfile) { sleep(1); }
		else {
			open(LOCK,">$lockfile");
			close(LOCK);
			$flag = 1;
			last;
		}
	}
	if ($flag == 0) { &error("現在、他の人が使用しています"); }
}

# ------------------------- #
# Sub Unlock
# アンロック
# ------------------------- #
sub unlock {
    if (-e $lockfile) { unlink($lockfile); }
}