#!/usr/bin/perl
#--------------------------------------------
# corpus2e.pl コーパスtoエピソード辞書変換
#


# corpus書式
#
# Title=コーパスのタイトル: Episode辞書先頭に注釈として転記される
# Date=日付: Episode辞書先頭に注釈として転記される
# UserName=ユーザ名
# UserPrefix=コーパス行頭で使うユーザの頭文字
# ArsName=人工無脳の名前
# ArsPrefix=コーパス行頭で使う人工無脳の頭文字
# 

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;

my $CorpusPath="./corpus3.txt";
my %Main = ();
my %Sys = ();
my @Keywords= ();
#my $Count=0;
#my $MaxKeywords=3;
#my $MaxQueueLength=4;

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

&Transform($CorpusPath);

sub GetKeyword
{
	my $input=shift;

	@Keywords=();

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


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

		# 単語+助詞

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

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

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


sub Transform
{
	my $path=shift;
	my $count=0;
	my $keywords;

	sysopen(FILE,$path,O_RDONLY) or die("$path not found");
	
	while(<FILE>)
	{
		/^[#\$]/ && do { print $_; next; };
		/^(\w+)\s*=\s*([^\n\r]+)/ && do { $Sys{$1}=$2;  next; };
		/^_CORPUS_/ && do { last;}
	}
	my $size=-s $path;
	$size=~s/(\d{1,3})(?=(?:\d{3})+(?!\d))/$1,/g;
	
	print "# source: $path $size byte(s)\n";
	print "# converted: ".&getTimestamp."\n";

	my $a=$Sys{'ArsPrefix'};
	my $amax=$Sys{'QueueLength'};

	
	my $str="";

	while(<FILE>)
	{
		/$Sys{'ArsPrefix'} ([^\n\r]+)/ && do {
			foreach($str=$1)
			{
				s/($Sys{'UserName'}(さん|君|)|あなた|君)/%user%/g;
				s/(私|あたし|僕|俺|$Sys{'ArsName'})/%ars%/g;
				s/,/&#2C;/g;
				s/\$/&#24;/g;
			}
			print "\$$a$count\$ $str\n" ;
			$count++;
			 next;
		};
		/$Sys{'UserPrefix'} ([^\n\r]+)/ && do 
			{ $keywords=&GetKeyword($1);
			  if($keywords ne "") {
					
					$str="\$$a$count\$";
					for(my $i=$count+1; $i<$amax+$count; $i++)
					{
						$str.="-\$$a$i\$";
					}
					$Main{$keywords} .= $str.",";
				}	
			};
	}
	close FILE;
	
	while (my ($key, $val) = each %Main)
	{
		chop $val;	#末尾のカンマを除去
		print "$key $val\n";
	}

}

sub 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);
}
