#!/usr/bin/perl
require './set.cgi';
require './system.cgi';
#┏━━━━━━━━━━━━━━━━━━━━━━┓
#┃HoMePeT Copyright (c) Merino                ┃
#┃CGI-Sweets [ http://cgi-sweets.com/ ]       ┃
#┗━━━━━━━━━━━━━━━━━━━━━━┛

# =========================================================
# メイン処理

&access_check;
%in = &decode;
&header;

if    ($in{mode} eq 'admin')      { &admin_enter; }
elsif ($in{mode} eq 'ranking')    { &ranking; }
elsif ($in{mode} eq 'pet_detail') { &pet_detail; }
elsif ($admin_only) { &error("ご主人様に他の人から教わるなと言われている$tail_word"); }
elsif ($in{mode} eq 'new_entry_form') { &new_entry_form; }
elsif ($in{mode} eq 'new_entry_exe')  { &new_entry_exe; }
else { ⊤ }

&footer;
exit;


# =========================================================
# 登録者ログイン
sub top {
	my($cook_id, $cook_pass) = &get_cookie;
	print <<"EOM";
	<div class="main">
	<p>言葉を教えるにはﾛｸﾞｲﾝする必要があります。</p>
	<a href="$index_script?mode=new_entry_form">新規登録</a>
	<form method="$method" action="$learn_script">
	<table class="table1">
		<tr><td>ID</td><td><input type="text" name="id" class="text_box_s" value="$cook_id"><br></td></tr>
		<tr><td>Pass</td><td><input type="text" name="pass" class="text_box_s" value="$cook_pass"><br></td></tr>
	</table>
		<input type="submit" value="ログイン" class="button1">
	</form>
	</div>
EOM
}

# =========================================================
# 管理室ログイン
sub admin_enter {
	my($cook_id, $cook_pass) = &get_cookie;
	print <<"EOM";
	<h2>管理室ﾛｸﾞｲﾝ</h2>
	<form method="$method" action="$admin_script">
		<table class="table1">
			<tr><td>Pass</td><td><input type="text" name="pass" class="text_box_s" value="$cook_pass"><br></td></tr>
		</table>
		<input type="submit" value="ログイン" class="button1">
	</form>
EOM
}


# =========================================================
# 新規登録フォーム
sub new_entry_form {
	print <<"EOM";
	<div class="main">
	<h2>新規登録</h2>
	<ul>
		<li>ID、Passは半角英数字4〜8文字</li>
		<li>名前は半角10文字全角5文字</li>
	</ul>
	<form method="$method" action="$index_script">
		<input type="hidden" name="mode" value="new_entry_exe">
	<table class="table1">
		<tr><td>ID</td><td><input type="text" name="id" class="text_box_s"><br></td></tr>
		<tr><td>Pass</td><td><input type="text" name="pass" class="text_box_s"><br></td></tr>
		<tr><td>名前</td><td><input type="text" name="name" class="text_box_s"><br></td></tr>
	</table>
		<input type="submit" value="登録する" class="button1">
	</form>
	</div>
EOM
}

# =========================================================
# 新規登録処理
sub new_entry_exe {
	&check;

	$time = time();
	open $fh, "> $userdir/$in{id}.cgi" or &error("ユーザーファイルに書き込みができない$tail_word");
	print $fh "$time<>0<>$in{id}<>$in{pass}<>$in{name}<>$addr<>0<>";
	close $fh;
	chmod $chmod, "$userdir/$in{id}.cgi";
	
	print <<"EOM";
	<div class="main">
	<h2>登録完了しました</h2>
	<p>IDとPassは、言葉を覚えさせるときに必要なので忘れないで$tail_word</p>
	<hr>
	<ul>
		<li>ID: $in{id}</li>
		<li>Pass: $in{pass}</li>
		<li>名前: $in{name}</li>
	</ul>
	<hr>
	
	<form method="$method" action="$learn_script">
		<input type="hidden" name="id" value="$in{id}">
		<input type="hidden" name="pass" value="$in{pass}">
		<input type="submit" value="言葉を教える">
	</form>
	</div>
EOM
}

# =========================================================
# 登録記入チェック
sub check {
	&error("IDを半角英数字で入力して$tail_word") if $in{id} eq '' || $in{id} !~ /[0-9a-zA-Z]/;
	&error("IDを4〜8文字以内で入力して$tail_word") if length $in{id} < 4 || length $in{id} > 8;
	&error("Passを半角英数字で入力して$tail_word") if $in{pass} eq '' || $in{pass} !~ /[0-9a-zA-Z]/;
	&error("Passを4〜8文字以内で入力して$tail_word") if length $in{pass} < 4 || length $in{pass} > 8;
	&error("名前を入力して$tail_word") if $in{name} eq '';
	&error("名前が長すぎる$tail_word。半角10文字全角5文字以内で入力して$tail_word") if length $in{name} > 10;
	&error("$pet_nameは$pet_nameの名前$tail_word") if $in{name} eq $pet_name;
	
	my $err_flg = '';
	opendir my $fh, "$userdir" or &error("ユーザーディレクトリが読み込めない$tail_word");
	while (my $file_name = readdir $fh) {
		next if $file_name !~ /.+\.cgi$/;
		
		open my $fh2, "< $userdir/$file_name" or &error("ユーザーファイルが読み込めない$tail_word");
		my $line = <$fh2>;
		close $fh2;
		
		my($ftime,$ltime,$id,$pass,$name,$ip,$learn_count) = split /<>/, $line;
		
		unless ($owner_name eq $name && $pass eq $admin_pass) {
			if ($time > $ftime + $del_time * 60 * 60 * 24) {
				unlink "$userdir/$file_name";
			}
		}

		if (lc $id eq lc $eid) {
			$err_flg = "すでに同じIDが登録されている$tail_word";
			last;
		}
		elsif ($name eq $in{name}) {
			$err_flg = "すでに同じ名前が登録されている$tail_word";
			last;
		}
	}
	closedir $fh;

	&error($err_flg) if $err_flg;
}

# =========================================================
# ランキング
sub ranking {
	my @ranks = ();
	opendir my $dh, "$userdir" or &error("ユーザーディレクトリが読み込めない$tail_word",1);
	while (my $file_name = readdir $dh) {
		next if $file_name !~ /.+\.cgi$/;
		
		open my $fh, "< $userdir/$file_name" or &error("ユーザーファイルが読み込めない$tail_word",1);
		my $line = <$fh>;
		close $fh;
		
		my($ftime,$ltime,$id,$pass,$name,$ip,$learn_count) = split /<>/, $line;
		
		push @ranks, "$name<>$learn_count<>\n";
		
	}
	closedir $dh;

	my @tmp = map { (split /<>/)[1] } @ranks;
	@ranks = @ranks[ sort { $tmp[$b] <=> $tmp[$a] } 0 .. $#tmp];
	
	print qq|<table class="table1"><tr><th>名前</th><th>言葉<br></th></tr>\n|;
	
	my $cnt = 1;
	for my $rank (@ranks) {
		my($name,$learn_count) = split /<>/, $rank;
		print qq|<tr><td>$name</td><td align="right">$learn_count語<br></td></tr>\n|;
		
		last if ++$cnt > 10;
	}
	print qq|</table>|;
}

# =========================================================
# 言葉を教えるのが管理者のみの場合ランキングは必要ないので、簡易自己紹介
sub pet_detail {
	print <<"EOM";
<div class="pet_mes">$pet_nameともうします$tail_word。<br>ご主人様は$owner_nameです$tail_word。<br>どうぞよろしく$tail_word。</div>
<div class="main"><a href="$script"><img src="$imgdir/$pets[$pet]" border="0"></a></div>
<table class="table1">
	<tr><th>$pet_name<br></th></tr>
	<tr><td>▼<a href="$script">はなす</a><br></td></tr>
	<tr><td>▼<a href="$index_script?mode=admin">管理室</a><br></td></tr>
	<tr><td align="center"><!-- $ver -->- <a href="$cgi_sweets_url" target="_blank">HoMePeT</a> -<br></td></tr>
</table>
EOM
}


#-----------------------------------------------------------
# クッキー取得
sub get_cookie {
	my $cook = $ENV{HTTP_COOKIE};

	for my $pair (split /;/, $cook) {
		my($k, $v) = split /=/, $pair;
		$k =~ s/\s//g;
		$cook{$k} = $v;
	}
	for my $c (split /<>/, $cook{pet}) {
		push @cooks, $c;
	}
	return @cooks;
}