#!/usr/bin/perl
# -*- coding: utf-8-unix -*-

#--------------------------------- プラグマ類 ---------------------------------
use strict vars;

#----------------------------- パラメータの初期値 -----------------------------
our $TARGET  = 'translation_list';

our %CONST = (
	# 設定ファイル関係
	'iniFile'    => './jmlint.ini',
	'iniSection' => $TARGET,   # 標準のターゲット名をセクション名にする

	# スクリプト内で使用するURL類
	'://JM'  => 'https://linuxjm.osdn.jp/',
	'://CC4' => 'https://creativecommons.org/licenses/by/4.0/deed.ja',
);

our %CONFIG = (
	# データの入っているフォルダ
	'/orig'  => 'original',
	'/draft' => 'draft',
	'/rel'   => 'release',
	'/po4a'  => 'po4a',

	# コマンドラインオプション
	'--debug'  => 'mono',	# ''→出力なし, 'mono'→色不使用, 他→その色で
	'--yes'    => 0,
	'--prompt' => 0,

	'check.fix' => 0,	# check/check+ の際に自動的に修正する
);

our %INI_CONTENTS = (
	# ターゲットファイルに入れるべき文字列
	'user.name'  => '',
	'user.email' => '',
);

our $COMMAND = '';
our $nChanged = 0;

#--------------------------------- 各種初期化 ---------------------------------
open(KBD, '< /dev/tty') or open(KBD, '< /con') or open(KBD, '<&STDIN');

&parseArgv();
&parseIniFile();

#print join("\n", @{$INI_CONTENTS{'legalCondition.description[]'}});
exit 0;

#******************************** @ARGVのパース *******************************
sub parseArgv()
{
	my $s;
	foreach $s ( @ARGV )
	{
		if ( $s =~ /^-+([\w]+)(=(.+))?$/ )
		{
			&parseArgvOption( $1, $2 );
			next;
		}

		if ( $s =~ /^(create|update|check)$/ )
		{
			if ( $COMMAND eq '' )
			{
				$COMMAND = $s;
				next;
			}
		}

		if ( $s =~ /^(check\+|and so on...)$/ )
		{
			die "Sorry, '$s' is not implemented yet.\n";
		}

		if ( $s eq 'fix' )
		{
			if ( $COMMAND =~ /^check\+?$/ )
				{ $CONFIG{'check.fix'} = 1;}
			else
				{ die &doesNotApply($s); }
		}

		die "Unknown command-line parameter: '$s'\n";
	}
}

sub doesNotApply()
{
	return "'$_[0]' does not apply to '$COMMAND' command.\n";
}

sub parseArgvOption()
{
	my ( $k, $v ) = @_;

	if ( $k eq 'version' )
	{
		&version();
		exit 0;
	}

	if ( $k eq 'help' )
	{
		&usage();
		exit 0;
	}

	if ( $k =~ /^(yes|prompt)$/ )
	{
		$CONFIG{"--$k"} = ( $v !~ /^(0|-|off|no.+)$/ );
		return;
	}

	if ( $k eq 'debug' )
	{
		my $isDisabled  = ( $v =~ /^(0|-|off|no.+)$/ );
		my $isAutoColor = ( $v eq '' || $v =~ /^(1|\+|on|yes)$/ );

		if ( $isDisabled ) { $v = ''; }
		if ( $isAutoColor )
		{
			$v = ( defined $ENV{CLICOLOR}
				? 'bright_red'	# この色は飯嶋の個人的嗜好
				: 'mono'
			);
		}

		$CONFIG{'--debug'} = $v;
		return;
	}

	&warning("Unknown option: --$k='$v'. Just ignored.\n");
}

#**************************** iniファイル関係の処理 ***************************

# キーの値を参照するときは直接ハッシュを索かず、このメソッドを経由する。
# キー名のミスタイプでundefと判定されないようにするため。
sub getIniData()
{
	my $key = $_[0];
	if ( !&isValidIniKey($key) )
	{
		die "getIniData('$key'): data required with undefined key.\n";
	}

	return $INI_CONTENTS{$key};
}

sub isValidIniKey()
{
	my $names = '('. join('|',
		'common\.(controlCodes|variationSelectors)',
		'user\.(name|email)',
		'progressStatus\.(choices|forLinkPages|correction\[\]|'
			. 'description\[\]|now(Untouched|Working|Released))',
		'legalCondition\.(choices|description\[\])',
		'sectionNames\.(validNames|knownExceptions)'
	) . ')';

	return $_[0] =~ /^$names$/;
}

sub parseIniFile()
{
	my $fname = $CONST{iniFile};

	if ( !-e $fname )
	{
		&debugLog("'$fname' does not exist. Going anyway....\n");
		return;
	}

	&debugLog("Starting to read '$fname'.\n");
	my @DATA = &readWholeFile($fname);

	my $i;
	my $inOurSection = 0;

	for ( $i=1 ; $i<=@DATA ; $i++ )
	{
		my $s = $DATA[$i];
		my $tag = "$fname($i): ";

		$s =~ s/^\s+//;
		$s =~ s/^;*$//;
		next if $s eq '';

		if ( $s =~ /^\[\s*(.+)\s*\]/ )
		{
			my $section = $1;
			&debugLog("${tag}New Section: '$section'\n");
			$inOurSection = ( $section eq $CONST{iniSection} );
			next;
		}

		next unless $inOurSection;
		if ( $s =~ /^['"]?(.+?)['"]?\s*=\s*['"]?(.+)['"]?$/ )
		{
			my ( $key, $value ) = ( $1, $2 );

			if ( !&isValidIniKey($key) )
			{
				&warning("${tag}Invalid key name: '$key'. "
					. "Skipping.");
				next;
			}

			&debugLog("'$key' => '$value'\n");

			if ( substr($key,-2) eq '[]' )
				{ push @{$INI_CONTENTS{$key}}, $value; }
			else
				{ $INI_CONTENTS{$key} = $value; }
		}
	}
}

#**************************** 一覧表ファイルの処理 ****************************

#------------------- 各行のコロン区切りデータををセルに分割 -------------------
# split() では末尾の空要素は切り捨てられることに注意。
# つまり、split(':','a:b:::') は ('a','b','','','') ではなく ('a','b') を返す。
#------------------------------------------------------------------------------
sub splitTargetLine()
{
	my @cells = split(':', $_[0], 10);
	# https://linuxjm.osdn.jp/guide/translation_list.html
	# [For Real Bodies]
	#     0)Status, 1)Package Name, 2)Manpage Version, 3)Original Date,
	#     4)Basename, 5)Section, 6)Working Date, 7)License,
	#     8)Translator Email, 9)Translator Name, 10)Memo
	# [For Links]
	#     0)Status, 1)Package Name, 2)Manpage Version, 3)Original Date,
	#     4)Basename, 5)Section, 6)Body Basename, 7)Body Section

	return @cells;
}

#******************************* バナー、ヘルプ *******************************

sub version()
{
print << "__END_VERSION__";
JM TranslationList Lint, version 0.0.0
Copyright (c) 2022 Linux JM Project <$CONST{'://JM'}>.
Licensed under CC BY 4.0 clauses <$CONST{'://CC4'}>
Originally written by IIJIMA 'Delmonta' Hiromitsu.
__END_VERSION__
}

# とりあえずSTDOUTで
sub usage()
{
# &print_Disclaimer();

my $basename = $0;
$basename =~ s#^.+[/\\]##;

print << "__END_USAGE__";
Usage: $basename <options> <command> [<arguments>...]

<command>
	create      Creates a new '$TARGET' file.
	update      Updates '$TARGET' file according to the replsitory
	check       Detects common errors in '$TARGET'.
	check+      Analyses '$TARGET' in detail, and prints one by one.

<options>
	--yes       Assume YES for all confirmations.
	--debug[=param] 
	            Switch on/off debug output.
	--prompt    Prompts for an Enter key for every action.

<arguments>
	For check/check+:
		fix      Fixes errors and creates a new '$TARGET' file.
__END_USAGE__
}

#***************************** 雑多なサブルーチン *****************************

#------------------------------ ファイルアクセス ------------------------------
sub readWholeFile()
{
	my $fname = $_[0];
	my $fd;

	if ( !open($fd, "< $fname") )
		{ die "Cannot open 'fname': $!\n"; }
	my $all = join('', <$fd>);
	close $fd;

	if ( $all eq '')
	{
		&warning("'$fname' is empty. Going anyway...\n");
		return undef;
	}

	$all =~ s/\x0D\x0A?/\x0A/g;	# CR, CRLF => LF
	my @data = split("\x0A", $all);

	# split() の仕様上、ファイル最後尾に限ってはいくつ空行があっても
	# 丸ごと切り捨てられることに注意。今回はそれで実害なしと判断。

	unshift @data, undef;		# 行番号を1から始めるため
	$data[1] = &trimBOM($data[1]);	# 保険として入れておく。

	&debugLog("'$fname' has $#data lines.\n");
	return @data;
}

#------------------------------- 文字コード関係 -------------------------------
sub chompAll() { $_[0] =~ s/[\x0D\x0A]+$//;  return $_[0]; }
sub trimBOM()  { $_[0] =~ s/^\xEF\xBB\xBF//; return $_[0]; }

sub addBOM()
{
	my $text = join('', @_);
	my $bom = "\xEF\xBB\xBF";

	if ( $text !~ /^$bom/ )
		{ return $bom . $text }
	else
		{ return $text; }
}

sub tromControlCodes()
{
	my $text = join('', @_);
	my $re = &getIniData('common.controlCodes');
	return $text unless defined $re;
	$text =~ s/$re//g;
	return $text;

}

sub tromVariationSelectors()
{
	my $text = join('', @_);
	my $vs = &getIniData('common.variationSelectors');
	return $text unless defined $re;
	$text =~ s/$re//g;
	return $text;
}
#------------------------------------ 確認 ------------------------------------
sub confirm()
{
	return 1 if $CONFIG{'--yes'};
	my $prompt = join('', @_);
	while ( 1 )
	{
		print $prompt;
		my $key = <KBD>;
		if    ( $key =~ /^[yY]/ ) { return 1; }
		elsif ( $key =~ /^[nN]/ ) { return 0; }
	}
}

sub promptIfFlagged()
{
	&promptAlways() if $CONFIG{'--prompt'};
}

sub promptAlways()
{
	print "Hit Enter to continue...";
	my $dummy = <KBD>;
}

#-------------------------------- デバッグ表示 --------------------------------
sub __debugLog() { ($CONFIG{'--debug'} ne '' ) && print join('', @_); }

eval 'use Win32::Console::ANSI';
eval 'use Term::ANSIColor';

sub debugLog()
{
	my $flag = $CONFIG{'--debug'};
	return if $flag eq '';

	if ( $flag ne 'mono' ) { eval "print color('$flag')"; }
	print join('', @_);
	if ( $flag ne 'mono' ) { eval "print color('reset')"; }

	&promptIfFlagged();
}

#---------------------------------- 警告表示 ----------------------------------
sub __warning()  { print STDERR join('', @_); return -1;}

# いろいろ盛り込みたいけど、とりあえずこれで済ます
sub warning()
{
	print STDERR "\cG";	# beep
	print STDERR join('', @_);
	return -1;
}

#************************************* EOF ************************************