#! /usr/bin/perl
#
# パッケージ原文が更新されたときに、
# translation_list を更新するために upd_tl.perl に与える
# 設定ファイルを作成するスクリプト
#
# original/ ディレクトリ以下にファイルを揃え、
# 変更/追加/削除されたファイルを git add で stage した上で
# git commit を実行する前に、original/ の一つ上のディレクトリで
# git status した結果を標準入力から与えてください。
# 結果は標準出力に出力するので、適当にリダイレクトして下さい。
#
# 結果にはささいな変更も含まれますので、実際にはそれらに
# 手動で対応した後、結果の該当部分を手動で削除してから
# upd_tl.perl を使うことになると思います。
#
# BUG:
# ゴミを出力することがあります。手動で削除してください。
#

sub cvfn()
{
	my($fn) = @_;
	if($fn =~ m@man./([-.\w]+)\.(\d)$@){
		return (1, "$1:$2");
	} else {
		return (0, "$fn");
	}
}

sub getdate()
{
	my($fn) = @_;
	my($input,$date);
	open F, "<$fn";
	while ($input = <F>) {
		if ($input =~ /^\.TH [^ ]+ +[1-8] +\"?([0-9]+)\-([0-9]+)\-([0-9]+)\"? /) {
			$date = $1 . "/" . $2 . "/" . $3;
		}
	}
	close F;
	if ($date) {
		return $date;
	} else {
		return "0000/00/00";
	}
}

sub read_file_head() {
	my ($fn) = @_;
	my $top;
	open F, "<$fn";
	$top = <F>;
	close F;
	return $top;
}

sub get_prefix() {
	my ($valid) = @_;
	if (not $valid) {
		return '# ';
	} else {
		return '';
	}
}

sub print_entry() {
	# NOTE: $mode should be either of 'A' or 'U'.
	my ($mode, $fn, $top) = @_;
	my ($valid, $cvfn) = &cvfn($fn);
	my $prefix = &get_prefix($valid);
	if($top =~ /^.so ([-\w]+)/i){
		print $prefix . 'L' . ' ' . &cvfn($fn) . ' ' . &cvfn($top) . "\n";
	} else {
		print $prefix . $mode . ' ' . &cvfn($fn) . " " . &getdate($fn) . "\n";
	}
}

sub print_removed_entry() {
	my ($fn) = @_;
	my ($valid, $cvfn) = &cvfn($fn);
	my $prefix = &get_prefix($valid);
	print $prefix . 'R ' . $cvfn . "\n";
}

$state = "start";

while(<>){
	s/[\r\n]*$//;
	$state = "staged" if /^(# )?Changes to be committed/;
	if(/^#?$/){
		$state = ($state eq "staged") ? "target" : "done";
	}
	next if $state ne "target";

	s/^#?[ \t]*//;
	my($mode, $fn) = split(/: +/);
	if($mode eq 'new file'){
		$top = &read_file_head($fn);
		&print_entry('A', $fn, $top);
	}
	if($mode eq 'modified'){
		$top = &read_file_head($fn);
		&print_entry('U', $fn, $top);
	}
	if($mode eq 'deleted'){
		&print_removed_entry($fn);
	}
	if($mode eq 'renamed'){
		my ($fn_old, $fn_new) = split(' -> ', $fn);
		$top = &read_file_head($fn_new);
		&print_entry('A', $fn_new, $top);
		&print_removed_entry($fn_old);
	}
}