#!/usr/local/bin/perl -w
# animal - guess animals.
# Copyright (C) 2005 candy
# $Id: animal.pl,v 1.4 2005/06/02 06:14:57 candy Exp candy $
use strict;

my $dbfile = "animaldb.txt";

my %db = (
	"" => "生物ですか?",
	"0" => "原子から構成されるものですか?",
	"00" => "小説",
	"01" => "麦茶",
	"1" => "動物ですか?",
	"10" => "マイタケ",
	"11" => "オカダンゴムシ",
);

sub db_save($) {
	my ($file) = @_;
	my $err = -1;
	if (open(F, ">" . $file)) {
		my $k;
		foreach $k (sort keys %db) {
			printf(F "%s\t%s\n", $k, $db{$k});
		}
		close(F);
		$err = 0;
	}
	else {
		printf(STDERR "%s: $!\n", $dbfile);
	}
	return $err;
}

sub db_load($) {
	my ($file) = @_;
	my $err = -1;
	if (open(F, $file)) {
		my $lbuf;
		while ($lbuf = <F>) {
			chomp($lbuf);
			my @v = split(/\t/, $lbuf);
			if ($#v == 1) {
				$db{$v[0]} = $v[1];
			}
		}
		close(F);
		$err = 0;
	}
	else {
		printf(STDERR "%s: $!\n", $dbfile);
	}
	return $err;
}

sub getyn($) {
	my ($prompt) = @_;
	my $input = "";
	while ($input ne "y" && $input ne "n" && $input ne "q") {
		printf("%s\n[y/n/q]?", $prompt);
		$input = <STDIN>;
		if (defined($input)) {
			chomp($input);
		}
		else {
			$input = "q";
		}
	
	}
	return $input;
}

sub getline($) {
	my ($prompt) = @_;
	my $lbuf;
	my $more = 1;
	while ($more) {
		printf("%s", $prompt);
		$lbuf = <STDIN>;
		if (defined($lbuf)) {
			chomp($lbuf);
			if ($lbuf ne "") {
				$more = 0;
			}
		}
		else {
			$lbuf = ""
		}
	}
	return $lbuf;
}

sub question_of($) {
	my ($key) = @_;
	my $q = $db{$key};
	my $ret = "";
	if (defined($q) && $q =~ /\?$/) {
		$ret = $q;
	}
	return $ret;
}

sub answer_of($) {
	my ($key) = @_;
	my $q = $db{$key};
	my $ret = "";
	if (defined($q) && $q !~ /\?$/) {
		$ret = $q;
	}
	return $ret;
}

sub query_loop() {
	my $key = "";
	my $question;
	my $input = "";
	while ($input ne "q" && ($question = question_of($key)) ne "") {
		$input = getyn($question);
		if ($input eq "y") {
			$key .= "1";
		}
		elsif ($input eq "n") {
			$key .= "0";
		}
	}
	return ($input, $key);
}

sub input_answer() {
	my $input = "n";
	my $answer = "";
	while ($input eq "n") {
		printf("それはなんなのですか?\n");
		$answer = getline(">");
		if ($answer ne "") {
			my $prompt = sprintf("それは%sですね?", $answer);
			$input = getyn($prompt);
		}
		else {
			$input = "q";
		}
	}
	return $input eq "y" ? $answer : "";
}

sub input_question($$) {
	my ($guess, $correct) = @_;
	my $input = "n";
	my $question = "";
	while ($input eq "n") {
		printf("%sを%sから区別するためには、\nなんと質問すればよかったのでしょうか?\n質問を入力してください。\n", $correct, $guess);
		$question = getline(">");
		if ($question ne "") {
			if ($question !~ /\?$/) {
				$question .= "?";
			}
			printf("質問「%s」\n", $question);
			printf("  はい→%s\n", $correct);
			printf("  いいえ→%s\n", $guess);
			$input = getyn("これでよろしいですか?");
		}
		else {
			$input = "q";
		}
	}
	return $input eq "y" ? $question : "";
}

sub guess($) {
	my ($key) = @_;
	my $guess = answer_of($key);
	my $save_db = 0;
	if ($guess ne "") {
		printf("わかりました!!\n");
		my $prompt = sprintf("それは%sですね!!", $guess);
		my $input = getyn($prompt);
		if ($input eq "n") {
			printf("オーマイガッ!!\n");
			my $new_answer = input_answer();
			if ($new_answer ne "") {
				my $new_question = input_question($guess, $new_answer);
				if ($new_question ne "") {
					$db{$key} = $new_question;
					$db{$key . "0"} = $guess;
					$db{$key . "1"} = $new_answer;
					printf("ありがとう!!\nまた遊んでね!!\n");
					$save_db = 1;
				}
			}
		}
		else {
			printf("やったやった!!\nまた遊んでね!!\n");
		}
	}
	else {
		printf(STDERR "%s: db error: no answer\n", $key);
	}
	return $save_db;
}

sub nain() {
	my $save_db = 0;
	my ($input, $key) = query_loop();
	if ($input ne "q") {
		$save_db = guess($key);
	}
	return $save_db;
}

sub main() {
	printf("animal V0.8086\n");
	db_load($dbfile);
	if (nain()) {
		#db_save("/dev/stdout");
		db_save($dbfile);
	}
	return 0;
}

exit(main());