## Active Perl 5.8.8
# 注意>DBD-mysql を 4.005 以上にアップデートしてください。
# 注意>やりかた: ppm install http://theoryx5.uwinnipeg.ca/ppms/DBD-mysql.ppd

# __init__.py 中のクエスト名を一括して日本語化する
# data/scripts/quests/*/__init__.py

use utf8;
use strict;
use warnings;
use Encode;
use DBI;

binmode STDOUT,':encoding(cp932)'; $|=1;
sub   FS {Encode::encode('cp932',shift)}
sub UTF8 {Encode::decode('cp932',shift)}

my $vars_txt = 'tools/vars.txt';
open FILE,'<',$vars_txt  or do {warn "'$vars_txt' $!";exit 0};
read FILE,my $vars,-s FILE;
close FILE;
my $gsuser = ($vars =~ m/^\@*set gsuser=(.+)$/m)[0];
my $gspass = ($vars =~ m/^@*set gspass=(.+)$/m)[0];
my $gsdb   = ($vars =~ m/^@*set gsdb=(.+)$/m)[0];
my $gshost = ($vars =~ m/^@*set gshost=(.+)$/m)[0];

my $DEBUG = 0; # 1 or 0
my $STRICT = 0;

my $LogFile = UTF8(__FILE__);
   $LogFile =~ s!\.[^.\/\\]*$!.log!;
open LOG, '>:utf8', FS($LogFile)  or die "'$LogFile' $!";

my $db = DBI->connect("DBI:mysql:$gsdb:$gshost", $gsuser, $gspass, {mysql_enable_utf8=>1}) or do{warn DBI::errstr;exit 0};
   $db->do('SET NAMES UTF8');

&start('build/dist/gameserver/data/scripts/quests/');

close LOG;
exit 0;

sub start {
	my ($subDir) = @_;

	print ' [',$subDir,"]\n" if $DEBUG;
	opendir DIR, FS($subDir) or die "'$subDir' $!";
	my @files = readdir DIR; foreach (@files) { $_ = UTF8($_) }
	closedir DIR;

	foreach my $fileName (@files) {
		next if $fileName =~ m/^\./;
		next if $fileName =~ m/ /;

		my $filePath = $subDir.$fileName;

		if (-d FS($filePath)) {
			next unless $fileName =~ m/^\d+_/;
			$filePath =~ s!^\.\/!!;
			&start($filePath.'/');
			next;

		} elsif ($fileName eq '__init__.py') {
			my $outPath = $filePath;
			   $outPath .= '.text' if $DEBUG;

			print "  $filePath\n" if $DEBUG;
			open FILE, '<:encoding(cp932)', FS($filePath) or die "'$filePath' $!";
			my $mtime = (stat FILE)[9];
			read FILE, my $text, -s FILE;
			close FILE;

			my $original = $text;
			my ($id, $name_en);
			my $name_jp;

			$id      = $1 if $text =~ m/= *Quest\((\d+),/;
			$name_en = $1 if $text =~ m/^qd *= *"(.+?)"/m;
			$id      = $1 if $text =~ m/^qnu *= *(\d+)/m;
			$name_en = $1 if $text =~ m/^qna *= *"(.+?)"/m;
			$id      = $1 if $text =~ m/^QUEST_NUMBER *= *(\d+)/m;
			$name_en = $1 if $text =~ m/^QUEST_DESCRIPTION *= *"(.+?)"/m;
			$id      = $1 if $text =~ m/^QuestNumber *= *(\d+)/m;
			$name_en = $1 if $text =~ m/^QuestDescription *= *"(.+?)"/m;

			($id,$name_en) = ($1,$2) if $text =~ m/= *Quest\((\d+), *\w+, *"(.+?)"\)/;
			($id,$name_en) = ($1,$2) if $text =~ m/= *Quest\((\d+), *".+?", *"(.+?)"\)/;
			($id,$name_en) = ($1,$2) if $text =~ m/^QUEST_NUMBER,QUEST_NAME,QUEST_DESCRIPTION *= *(\d+), *".+?", *"(.+?)"/m;

			#die $filePath unless $id;
			#die $filePath unless $name_en;
			next unless $id;
			next unless $name_en;

			$name_jp = &getName($id);
			next unless $name_jp;
			next if $name_jp eq $name_en;

			$text =~ s/(= *Quest\(.+?,.+?, *)".+?"(\))/$1'$name_jp'$2/;
			$text =~ s/^(qd *= *)".+?"/$1"$name_jp"/m;
			$text =~ s/^(qna *= *)".+?"/$1"$name_jp"/m;
			$text =~ s/^(QUEST_DESCRIPTION *= *)".+?"/$1"$name_jp"/m;
			$text =~ s/^(QuestDescription *= *)".+?"/$1"$name_jp"/m;
			$text =~ s/^(QUEST_NUMBER,QUEST_NAME,QUEST_DESCRIPTION *= *\d+, *".+?", *)".+?"/$1"$name_jp"/m;
if ($STRICT) {
			if ($text eq $original) {
				print     "\t[",$name_en,"]\n";
				print     "\t[",$name_jp,"]\n";
				exit 1;
			}
}

			if ($text ne $original) {
				open FILE, '>:encoding(cp932)', $outPath or die "'$outPath' $!";
				print FILE $text;
				close FILE;
				utime $mtime, $mtime, FS($outPath);

				my $i = &minidiff($text, $original);
				print '●',$outPath,"($i)\n";
				print     "\t[",$name_en,"]\n";
				print     "\t[",$name_jp,"]\n";
				print LOG  $outPath,"($i)\n";
				print LOG "\t[",$name_en,"]\n";
				print LOG "\t[",$name_jp,"]\n";
			}
		}
	}
}

sub getName {
	my ($id) = @_;

	my $sql = "SELECT name FROM questname_ja WHERE id=?";
	my $sth = $db->prepare($sql);
	$sth->execute($id) or die DBI::errstr;
	$sth->bind_columns(undef, \(my($N_name))) or die DBI::errstr;
	my $rc = $sth->fetch();

	return '' unless $N_name;
	return $N_name;
}

sub minidiff {
	my ($textA, $textB) = @_;

	$textA =~ s/^\x{FEFF}//;
	$textB =~ s/^\x{FEFF}//;
	my @A = split /\n/,$textA;
	my @B = split /\n/,$textB;
	my $min = $#A <= $#B ? $#A : $#B;
	for (my $i=0; $i <=$min; ++$i) {
		return $i+1 if $A[$i] ne $B[$i];
	}
	return 0;
}
