package ssw;
#
#
#       ssw-1.00 -  人工無脳 精霊石『ホワイトノイズ』 ver 1.00
#
#

use strict;

#   ---- 人工無脳のキャラクタ定義 -----------------
# 名前
$ssw::Name="muno";

# 仮想体調(サインカーブ)の周期, 日
$ssw::VCondInterv=10;

# 会話のタイムアウト (分)
$ssw::Timeout=5;

# 人工無脳が「ついさっき」と思う時間（分）
$ssw::ShortDuration=60;

# 人工無脳が「久しぶり」と思う日数
$ssw::LongDuration=7;

# 返答デッキ(-UCPR)
$ssw::Deck="--------AUUUCPPE";



#   ---  ファイルなどの設定 ----------------------
# 辞書書きこみ権限パスワード
$ssw::Passwd="WhiskyNancy001";

# notfoundログのパス
$ssw::NotFoundLog="notfound.txt";

# notfoundの最大行数
$ssw::NFLMaxLines=100;

# アクセスログのパス
$ssw::AccessLog="access.txt";

# 基本辞書のパス
$ssw::MainDicPath="main.dic";

# レンダリング辞書のパス
$ssw::RenderDicPath="render.dic";

# 新着記憶辞書のパス
$ssw::GreenDicPath="green.dic";

# 辞書への書き込み権限をすべてのユーザに与える
$ssw::IsAuthorized = 1;

#   --- 要維持変数 ------------------------
$ssw::UName        = "nouser";
$ssw::Queue        = "";
$ssw::Reserved     = "";
$ssw::Message      = "";
$ssw::PrevInput    = "";
$ssw::PrevOutput   = "";
$ssw::PervTheme    = "";
$ssw::CurrentTheme = "";

#   --- 内部変数 -------------------------
%ssw::Dic          = ();
%ssw::Key2Theme    = ();
%ssw::Theme2Key    = ();
@ssw::DicKeys      = ();
@ssw::Pairs        = ();
$ssw::Teacher      = "";
$ssw::Value        = "";

sub load_dic($)
{
	my $path=shift;
	my ($key,$thm);
	local *DIC;
	open (DIC,"$path") or die "$path not found";
	while(<DIC>) {
		/([^ ]+) ([^\n]+)/ && do{
			($key,$thm)=split(/\//,$1);
			$ssw::Dic{$key}=$2;
			$ssw::Key2Theme{$key}=$thm if defined $thm;
		}
	}
	close DIC;
}

sub load()
{
	my ($key,$thm);
	local *DIC;
	return if defined $ssw::Dic{'$NOT_FOUND$'};

	load_dic($ssw::MainDicPath);
	load_dic($ssw::GreenDicPath);

	open(DIC,$ssw::RenderDicPath) or die "$ssw::RenderDicPath not found";
	while(<DIC>) {
		/([^ ]+) ([^\n]+)/ && do { $ssw::Dic{$1}=$2; }
	}
	close DIC;
	@ssw::DicKeys= keys %ssw::Dic;
}

# ユーザのラストアクセスを調べ、
# 前アクセスからの経過時間 $Freq{ONLINE,SHORT,LONG}を返す

sub chk_uinfo()
{
	local *AL;
	open(AL,"+<$ssw::AccessLog") or die "$ssw::AccessLog not found";

	#lock file 省略
	
	my $al=<AL>;
	my ($count,$freq,$last,$status);
	my $now=time;
	if($al =~ s/$ssw::UName=([^ ]+) //g) {
		($count,$last,$status)=split /,/,$1;
		$count++;
		if($last>$now-$ssw::Timeout*60 && $status ne "logout"){
			$freq="ONLINE";
		}elsif($last>$now-$ssw::ShortDuration*60) {
			$freq="SHORT";
		}elsif($last>$now-$ssw::LongDuration*60*60*24) {
			$freq="MIDDLE";
		}else {
			$freq="LONG";
		}
	}else {
		$freq="STRANGER";
	}
	
	$al="$ssw::UName=$count,$now,- ".$al;
	seek AL,0,0;
	print AL $al;
	truncate(AL,tell(AL));
	close AL;
	$freq;
}

sub get_season() { 
	my $m=$ssw::LTime[4];
	($m>=3)+($m>=6)+($m>=9)-3*($m==12);
}

sub get_zone() {
	my $h=$ssw::LTime[2];
	($h>=7)+($h>=10)+($h>=11)+($h>=14)+($h>=19)-5*($h>=22);
}

sub get_vcond() { int(2*sin(2*3.14159*time/($ssw::VCondInterv*60*60*24))+3.5); }
sub get_status()
{
	my $mainsiz= -s $ssw::MainDicPath;
	my $rendsiz= -s $ssw::RenderDicPath;
	my $grensiz= -s $ssw::GreenDicPath;
	
	my $nflsiz = -s $ssw::NotFoundLog;
	"主辞書 $mainsiz Byte, レンダリング辞書 $rendsiz Byte,新着辞書 $grensiz Byte, NFL $nflsiz Byte";
}

sub set_nfl()
{
	local *NFL;
	open(NFL,"$ssw::NotFoundLog") or die "cannot open NFL"; #unsafe
	my $nfl=<NFL>;
	close NFL;
	
	unless ($nfl) {
		$ssw::Message="NFL_EMPTY";
		return "";
	}
	$nfl=~/([^|]+)\|([^\n]+)/;
	$ssw::Teacher=($1 eq $ssw::UName) ? &expand('$you$') : $1;
	$ssw::Value=$2;
	$ssw::Message="educate" if $ssw::IsAuthorized;
	"";
}

sub hearsay($$)
{
	$ssw::Teacher=shift; 
	$ssw::Value=shift; 
	return &expand ('$HEARSAY$'); 
}

sub set_reserve($) { $ssw::Reserve=shift;  ""; }

sub set_queue($)   { $ssw::Queue  =shift;  ""; }

sub set_post($)    { $ssw::Message=shift;  ""; }

sub set_pair($)
{
	my $key=shift;
	my @values=split(/,/,$ssw::Dic{$key});
	my $value=$values[rand($#values+1)];
	@ssw::Pairs=split /\|/,$value;
	"";
}

sub get_assoc()
{
	unless (%ssw::Theme2Key) {
		while(my ($k,$v)=each(%ssw::Key2Theme)) {
			unless(defined $ssw::Theme2Key{$v}) {
				$ssw::Theme2Key{$v}=$k;
			}
			else
			{
				$ssw::Theme2Key{$v}=$ssw::Theme2Key{$v}.",$k";
			}
		}
	}
	my @values=split(/,/,ssw::Theme2Key{$ssw::CurrentKey});
	#return &expand(rand
	return $values[rand($#values)];
}

sub expand($)
{
	my $key=shift;
	my @values=split(/,/,$ssw::Dic{$key});
	my $value=$values[rand($#values+1)];

	$value=~ s/\%uname\%/$ssw::UName/g;
	$value=~ s/\%name\%/$ssw::Name/g;
	$value=~ s/\%theme\%/$ssw::CurrentTheme/g;
	$value=~ s/\%time\%/"$ssw::LTime[2]:$ssw::LTime[1]:$ssw::LTime[0]"/g;
	$value=~ s/\%date\%/"$ssw::LTime[5]\/$ssw::LTime[4]\/$ssw::LTime[3]"/g;
	$value=~ s/\%season\%/&get_season/eg;
	$value=~ s/\%zone\%/&get_zone/eg;
	$value=~ s/\%vcond\%/&get_vcond/eg;
	$value=~ s/\%status\%/&get_status/ge;
	
	$value=~ s/(\![^ \!]+\!)/&set_pair($1)/ge;
	$value=~ s/%[A-Z]%/$ssw::Pairs[ord($1)-ord'A']/eg;
	
	$value=~ s/\%educate\%/&set_nfl/eg;
	$value=~ s/\%teacher\%/$ssw::Teacher/g;
	$value=~ s/\%value\%/$ssw::Value/g;
	
	$value=~ s/\%assoc\%/&get_assoc/eg;
	
	$value=~ s/^([^|\n]+)\|([^|\n]+)$/&hearsay($1,$2)/ge;

	$value=~ s/\%reserve ([^\n]+)\%/&set_reserve($1)/ge;
	$value=~ s/\%queue ([^\n]+)\%/&set_queue($1)/ge;
	$value=~ s/\%post ([^\n]+)\%/&set_post($1)/ge;
	
	$value=~ s/(\$[^ \$]+\$)/&expand($1)/ge;
	
	return $value;
}




#   --- メソッド ----------------------------------------------------

sub writedic($$$$$$)
{
	my ($key,$theme,$reply,$teacher,$value,$hearsay)=@_;
	local (*GREEN,*NFL);
	
	open(GREEN,"+<$ssw::GreenDicPath") or die "$ssw::GreenDicPath not found";
	my @green=<GREEN>;
	$theme   ="/".$theme if $theme ne "";
	$hearsay =",$teacher|$value" if $hearsay ne "";
	unshift @green,"$key$theme $reply$hearsay\n";
	#spliceする？
	seek GREEN,0,0;
	print GREEN @green;
	truncate(GREEN,tell(GREEN));
	close GREEN;
	
	return;
}

sub truncNFL($)
{
	my $value=shift;
	open(NFL,"+<$ssw::NotFoundLog") or return;
	my @nfl=<NFL>;
	for (my $i=0 ; $i<$#nfl ;$i++)
	{
		next if index($nfl[$i],$value) == -1;
		#当該行が見つかったときの処理
		splice @nfl,$i,1;
		seek NFL,0,0;
		print NFL @nfl;
		truncate(NFL,tell(NFL));
	}
	close NFL;
}

sub login()
{
	#挨拶生成
	my $freq=chk_uinfo;
	$ssw::Reserved='$HELLO_ONLINE$';  # implies (if $freq eq "ONLINE"))
	$ssw::Reserved='$HELLO_STRANGER$' if $freq eq "STRANGER";
	$ssw::Reserved='$HELLO_SHORT$'    if $freq eq "SHORT";
	$ssw::Reserved='$HELLO_MIDDLE$'   if $freq eq "MIDDLE";
	$ssw::Reserved='$HELLO_LONG$'     if $freq eq "LONG";
}

sub logout()
{
	local *AL;
	open(AL,"+<$ssw::AccessLog") or die "$ssw::AccessLog not found";

	#lock file 省略
	
	my $al=<AL>;
	my $now=time;
	
	$al =~ s/$ssw::UName=([0-9]+),[^ ]+/$ssw::UName=$1,$now,logout/;
	seek AL,0,0;
	print AL $al;
	truncate(AL,tell(AL));
	close AL;
}

sub ProcessQueue()  { 
	my $q=$ssw::Queue;
	$ssw::Queue="";
	return $ssw::PrevOutput=&expand ($ssw::Queue);    
}

sub EducateAccept() { &truncNFL; $ssw::Reserved='$EDU_ACCEPT$'; }
sub EducateCancel() {            $ssw::Reserved='$EDU_CANCEL$'; }
sub EducateBanned() { &truncNFL; $ssw::Reserved='$EDU_BANNED$'; }



#---------------------------------------------------------------------
#
# メインルーチン
#

sub reply($)
{
	my $input=shift;
	
	$input =~ s/\|/&#124;/g;
	$input =~ s/,/&#44;/g;

	load;
	@ssw::LTime=localtime(time);
	chk_uinfo;
	
	#予約返答処理
	if ($ssw::Reserved ne "") {
		my $r=$ssw::Reserved;
		$ssw::Reserved="";
		return $ssw::PrevOutput=expand $r;
	}

	return $ssw::PrevOutput=expand '$SAY_SOMETHING$' if ($input eq "");

	#ユーザ認証
	if($input eq $ssw::Passwd)
	{
		$ssw::IsAuthorized=1;
		return $ssw::PrevOutput=expand '$AUTHORIZED$' if !$ssw::IsAuthorized;
		return $ssw::PrevOutput=expand '$AUTH_COOKIED$';
	}

	#カードを一枚引く
	my $card=substr($ssw::Deck,rand(length($ssw::Deck)+1),1);
	return $ssw::PrevOutput=expand '$COUNTER$'     if $card eq "C";
	return $ssw::PrevOutput=expand '$PROMPT$'      if $card eq "P";
	return $ssw::PrevOutput=expand '$ASSOCIATE$'   if $card eq "A";
	return $ssw::PrevOutput=expand '$EDU_REQUIRE$' if $card eq "E";
	if ($card eq "U") {
		$ssw::CurrentTheme=$ssw::PrevTheme if $ssw::PrevTheme ne "";
	}
	
	#繰り返し検出
	return $ssw::PrevOutput=expand '$DONT_REPEAT$' 
			if $ssw::PrevInput  eq $input;
	return $ssw::PrevOutput=expand '$DONT_COPY_ME$' 
			if $ssw::PrevOutput eq $input;
	

	#通常業務
	$ssw::PrevInput=$input;
	foreach my $key (@ssw::DicKeys){
		if($input =~ /$key/) {
			$ssw::PrevOutput= expand $key;
			#内部メッセージディスパッチ
			if($ssw::Message eq "NFL_EMPTY") {
				$ssw::PrevOutput= expand '$NFL_EMPTY$';
				$ssw::Message="";
			}
			
			$ssw::PrevTheme=$ssw::Key2Theme{$key}
						if defined $ssw::Key2Theme{$key};
			return $ssw::PrevOutput;
		}
	}
	
	#notfound
	local *NFL;
	open(NFL,">> $ssw::NotFoundLog") or die"$ssw::NotFoundLog not found";


	print (NFL "$ssw::UName|$input\n");
	close NFL;
	
	return $ssw::PrevOutput=expand '$NOT_FOUND$';
}

1;