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

# *.htm 中のＮＰＣ名を一括して日本語化する
# 位置情報編

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 $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/game/data/scripts/custom/NpcLocationInfo/');

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)) {
			$filePath =~ s!^\.\/!!;
			&start($filePath.'/');
			next;

		} elsif ($fileName =~ /^[0-9]+-[0-9]+\.html?$/) {
			my $outPath = $filePath;
			   $outPath .= '.text' if $DEBUG;

			print "  $filePath\n" if $DEBUG;
			open FILE, '<:utf8', FS($filePath) or die;
			my $mtime = (stat FILE)[9];
			my @TEXT = <FILE>;
			close FILE;

			my $UPDATE = 0;
			my ($id, $name_en, $br1);
			my $name_jp;
			for my $ix (0..$#TEXT) {
				chomp $TEXT[$ix];
				my $text = $TEXT[$ix];

				if ($text =~ s{Select the one you seek below.*?<br>}
				              {探している人の名前を次の中から選びなさい。その人の居場所が、画面に表示されるのだ。<br>}) {
					#
				} elsif ($text =~ s!(<a action="bypass -h Quest NpcLocationInfo [0-9]+\.htm">)(.*?BACK TO.*?LIST.*?)(?=</a>)!$1リストに戻る!i) {
					#
				} elsif ($text =~ s!(<a action="bypass -h Quest NpcLocationInfo [0-9]+\.htm">)(Go back.*?|back.*?|return)(?=</a>)!$1戻る!i) {
					#
				} elsif ($text =~ m!<a action="bypass -h Quest NpcLocationInfo ([0-9]+)">(.*?)</a>(.*)$!) {
					$id = $1;
					$name_en = $2;
					$br1 = $3;

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

					$text = '<a action="bypass -h Quest NpcLocationInfo '.$id.'">'.$name_jp.'</a>'.$br1;
						#	 <a action="bypass -h Quest NpcLocationInfo 32171">Warehouse Chief Hoffa</a><br>
				}

				if ($name_en && $text ne $TEXT[$ix]) {
					print  '+',$outPath,"(",$ix+1,")\n" unless $UPDATE;
					print     "\t[",$name_en,"]\n";
					print     "\t[",$name_jp,"]\n";
					print LOG  $outPath,"(",$ix+1,")\n" unless $UPDATE;
					print LOG "\t[",$name_en,"]\n";
					print LOG "\t[",$name_jp,"]\n";

					$TEXT[$ix] = $text;
					$UPDATE = 1;
				}
			}
			if ($UPDATE) {
				open FILE, '>:utf8', FS($outPath) or die;
				foreach my $text (@TEXT) {
					print FILE $text,"\n";
				}
				close FILE;
				utime $mtime, $mtime, FS($outPath);
			}
		}
	}
}

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

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

	return '' unless $N_name;
	if ($N_title) {
		# タイトルと名前をくっつける #
		if ($N_title =~ m/[\x{30A1}-\x{30ff}]$/
		 && $N_name =~ m/^[\x{30A1}-\x{30ff}]/) {
			#カタカナ+カタカナ連続するときは、空白入れる
		 	return $N_title.' '.$N_name;
		} elsif ($N_title =~ m/ /
		      || $N_name  =~ m/ /) {
			#タイトルか名前に空白ありのときは、空白入れる
		 	return $N_title.' '.$N_name;
		} else {
		 	return $N_title.$N_name;
		}
	}
	return $N_name;
}
