package arse;
#-----------------------------------------------
# 人工無脳 ARtificial Spirit - E型 実験機No.2
#
# 辞書＋エピソード型人工無脳
#
# 2015-7 ver 1.0


use utf8;
#use feature 'unicode_strings';
use open ':encoding(utf8)';         # I/O default encoding is UTF-8
use open ':std';                    # stdio encoding = utf8
use Encode qw(encode_utf8 decode);
use Fcntl;
use strict;

#------------------- ユーザー設定 ----------------------

$arse::ARSLog="arse_log.txt"; #ARSのログ
$arse::ARSLogLength=500;      #ARSログの長さ
$arse::IsFlockEnable =0;

#-------------------------------------------------------

%arse::Main=();        # 主辞書
@arse::MainKeys=();    # 主辞書のキー
%arse::Episode=();     # エピソード辞書

$arse::Word1RE = qr/[\p{Katakana}a-zA-Z0-9０-９%][\p{Katakana}a-zA-Z0-9０-９%・ー]*/;
$arse::Word2RE = qr/[\p{Han}\p{Katakana}a-zA-Z0-9０-９%][\p{Han}\p{Katakana}a-zA-Z0-9０-９%・ー]*/;

#-------------------------------------------------------

BEGIN {	srand; }

#-------------------------------------------------

# M E T H O D 

#-------------------------------------------------

sub arse::ReplyTo
{
	my $input=shift;
	
	#デバッグ用#######################################################
	
	if($input =~/^dump ([^ \n\r]+)/) { 	return $arse::Main{$1}; }
	if($input =~/^dumpe ([^ \n\r]+)/) { 	return $arse::Episode{$1}; }
	
	
	##################################################################

	#1. 辞書型：Queue1処理
	if($arse::Main{'$Queue1$'} ne '')
	{ 
		my $queue=$arse::Main{'$Queue1$'};
		$arse::Main{'$Queue1$'}='';
		
		&arse::writeLog("$arse::Main{'$MyName$'},$queue (queue1),");
		return &arse::develop($queue);
	}
	
	#2. 辞書型：メイン辞書による返答
	foreach ($input)
	{
		s/($arse::Main{'$MyName$'}(さん|君|)|あなた|君)/%ars%/g;
		s/(私|わたし|あたし|僕|ぼく|俺|$arse::Main{'$UserName$'})/%user%/g;
		s/,/C;/g;
		s/\$/&#24;/g;
	}
	
	foreach my $key (@arse::MainKeys)
	{
		if($input =~ /$key/)
		{
			$arse::Main{'$1$'}= $1 if ($1);
			$arse::Main{'$2$'}= $2 if ($2);
			&arse::writeLog("$arse::Main{'$MyName$'},$key,$input (Main)");
			return &arse::develop($key);
		}
	}
	
	#3. エピソード型：Queue2処理
	if($arse::Main{'$Queue2$'} ne '')
	{
		if (rand>=$arse::Main{'$EPISODE_QUEUE_SF$'})
		{
			$arse::Main{'$Queue2$'}="";
		}
		else
		{
			my @queue2=split (/-/,$arse::Main{'$Queue2$'});
			my $output=shift(@queue2);
			$arse::Main{'$Queue2$'}=join("-",@queue2);
			&arse::writeLog("$arse::Main{'$MyName$'},$output (queue2),");
			foreach($output)
			{
				s/(\$[^ \$]+\$)/&arse::develop($1)/eg;
			}
			
			return $output;
		}
	}

	
	#4. エピソード型：辞書による返答
	my @eps=split (/,/,$arse::Episode{&arse::getKeyword($input)});
	if(@eps)
	{
		foreach($eps[rand(1+$#eps)])
		{
			my @ep=split /-/;
			my $output= shift (@ep);
			$arse::Main{'$Queue2$'}=join ("-",@ep);
			&arse::writeLog("$arse::Main{'$MyName$'},$output (Episode),");
			foreach($output)
			{
				s/(\$[^ \$]+\$)/&arse::develop($1)/eg;
			}
			return $output;
		}
	}
	
	#5. NotFound処理
	&arse::writeLog("$arse::Main{'$MyName$'},\$NotFound\$,$input (NotFound)");
	return &arse::develop('$NotFound$');
}

sub arse::Load   # &Load(エピソード辞書,メイン辞書);
{
	my $path = shift;
	
	# エピソード型記憶
	
	sysopen(FILE,$path,O_RDONLY) or die("arse: $path not found");
	while(<FILE>)
	{
		/^#/ && do { next; };
		/(\$[^\$ ]+\$) ([^\n\r]+)/ && do { $arse::Main{$1}=$2; next;};
		/([^ ]+) ([^\n\r]+)/ && do { $arse::Episode{$1}=$2; next;};
	}
	close FILE;
	
	# 辞書型記憶
	$path=shift;
	sysopen(FILE,$path,O_RDONLY) or die("arse: $path not found");
	
	while (<FILE>)
	{
		/^#/ && do { next; };
		/^([^ ]+) ([^\n\r]+)/ && do{
			$arse::Main{$1}=$2; 
			if($1 !~ /^\$[^\$ ]+\$$/) { push @arse::MainKeys,$1;}} ;
	}
	close FILE;

}

sub arse::GetARSName{ return $arse::Main{'$MyName$'}; }
sub arse::SetUserName {	$arse::Main{'$UserName$'} = shift; }
sub arse::SetQueue1 { $arse::Main{'$Queue1$'}=shift || ""; return ""; }
sub arse::SetQueue2 { $arse::Main{'$Queue2$'}=shift || ""; return ""; }
sub arse::GetQueue1 { return $arse::Main{'$Queue1$'}; }
sub arse::GetQueue2 { return $arse::Main{'$Queue2$'}; }


#---------------------------------------
# I N T E R N A L  F U N C T I O N S
#

sub arse::develop
{
	my $key=shift;
	my @vals=split(/,/,$arse::Main{$key});

	foreach($vals[rand(1+$#vals)])
	{
		s/\%month\%/&arse::getMonth()/eg;
		s/\%hour\%/&arse::getHour()/eg;
		s/\%queue ([^\n]+)\%/&arse::SetQueue1($1)/eg;
		s/(\$[^ \$]+\$)/&arse::develop($1)/eg;

		return undef if(/^%nop%/);
		return $_;
	}
	&arse::writeLog("$arse::Main{'$MyName$'}, error: \"$key\" not found in Main hash,");
}

sub arse::getKeyword
{
	my $input=shift;

	my @Keywords=();

	foreach ($input)
	{
		s/($arse::Main{'$MyName$'}(さん|君|)|あなた|君)/%ars%/g;
		s/(私|わたし|あたし|僕|ぼく|俺|$arse::Main{'$UserName$'})/%user%/g;
		s/,/C;/g;
		s/\$/&#24;/g;
	
		# 相槌は削除
		s/なるほど//g;
		s/そうだね//g;
		s/ふーん//g;
		s/あ[はっ]+//g;
		s/へー//g;
		
		# 数字はいくつでもマッチする（今後）


		# ユーザ + の + 単語
		s/(%user%のお?$arse::Word2RE)/ do{ push @Keywords,$1; ""; }; /ge;
		
		# ars + の + 単語
		s/(%ars%のお?$arse::Word2RE)/ do{ push @Keywords,$1; ""; }; /ge;
		
		# 単語+の+単語
		s/($arse::Word2RE(?#)のお?$arse::Word2RE)/ do{ push @Keywords,$1; ""; }; /ge;

		# 単語+助詞

		s/($arse::Word1RE(?#)ばかり)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)くらい)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)ぐらい)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)から)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)より)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)やら)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)だの)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)まで)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)だけ)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)ほど)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)など)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)なり)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)やら)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)こそ)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)しか)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)とか)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)さえ)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)が)/ do{ push @Keywords,$1; ""; }; /ge; 
		s/($arse::Word1RE(?#)は)/ do{ push @Keywords,$1; ""; }; /ge; 
		s/($arse::Word1RE(?#)の)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)を)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)に)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)へ)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)と)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)で)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)や)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word1RE(?#)か)/ do{ push @Keywords,$1; ""; }; /ge;

		
		s/($arse::Word2RE(?#)ばかり)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)くらい)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)ぐらい)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)から)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)より)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)やら)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)だの)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)まで)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)だけ)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)ほど)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)など)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)なり)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)やら)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)こそ)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)でも)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)しか)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)とか)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)さえ)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)は)/ do{ push @Keywords,$1; ""; }; /ge; 
		s/($arse::Word2RE(?#)が)/ do{ push @Keywords,$1; ""; }; /ge; 
		s/($arse::Word2RE(?#)の)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)を)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)に)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)へ)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)と)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)で)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)や)/ do{ push @Keywords,$1; ""; }; /ge;
		s/($arse::Word2RE(?#)か)/ do{ push @Keywords,$1; ""; }; /ge;

		
		# 単語
		s/($arse::Word2RE)/ do{ push @Keywords,$1; ""; }; /ge;
	
	}
	
	splice(@Keywords,$arse::Main{'$EPISODE_KEYWORD_MAX$'}-1);
	return  join( ",",@Keywords);
}


sub arse::writeLog
{
	my $line=shift;
	sysopen (LOG,$arse::ARSLog, O_RDWR | O_CREAT) || die("arse: $arse::ARSLog not found");
	if($arse::IsFlockEnable)
	{
		flock (LOG,2) or return "arse: flock() not available - let IsFlockEnable=0.";
	}
	my @log=<LOG>;
	my $stamp= &arse::getTimestamp();
	
	push @log,"$stamp,$line\n";
	splice @log,$arse::ARSLogLength;
	seek LOG,0,0;
	print LOG @log;
	truncate LOG,tell(LOG);
	close LOG;

}

sub arse::getTimestamp
{
	my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
	
	return sprintf("%04d-%02d-%02d %02d:%02d:%02d",
		1900+$year,++$mon,$day,$hour,$min,$sec);
}

sub arse::getMonth
{
	my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
	
	return ++$mon;
}

sub arse::getHour
{
	my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
	
	return $hour;
}

1;