#!/usr/bin/perl -w
# Written by Francois-Xavier Duranceau <duranceau@free.fr>
# and Stephan Kulow <coolo@kde.org>
# and David Faure <faure@kde.org>

use strict;
use Cwd;
use File::Basename;

my $line_number;
my $look_ahead = "";
my $fuzzy;
my $no_c_format;
my $current_file;
my $topdir;

sub read_line {
	$line_number++;
	$look_ahead = <INPUT>;
	return $look_ahead;
}

# Read a msgid and return three values:
#  @(comment, msgid (reformatted in one line), raw msgid (as read))
# Also sets a few vars: $fuzzy, $no_c_format
sub get_msgid() {
	my $line = '';
	$fuzzy = 0;
	$no_c_format = 0;
	my $comment = "";

	while ( $line = read_line() ) {
		die "msgstr found when a msgid was expected ($current_file:$line_number)"
		if ( $line =~ /^\s*msgstr/ );
		
		if ( $line =~ /^\#,.*fuzzy/) {
			$fuzzy = 1;
		}

		if ( $line =~ /^\#,.*no-c-format/) {
			$no_c_format = 1;
		}

		if ( $line !~ /^\s*msgid\s+"(.*)"\s*\n/ ) {
			$comment .= $line;
			next;
		}

		my $rawstr = 'msgid "' . $1 . "\"\n";
		#               print "found a msgid (`$1')\n";
		my $str = $1;
		while ( $line = read_line() ) {
			last if($line !~ /^\s*"(.*)"\s*\n/ );
			$str .= $1;
			$rawstr .= $line;
		}

		return ($comment, $str, $rawstr);
	}
	return ($comment,undef,undef);
}


# Read a complete msgstr and return @(msgstr, raw msgstr)
sub get_msgstr() {

	my $rawstr = $look_ahead;
	die "expected msgstr not found at $current_file:$line_number"
		if( $look_ahead !~ /^\s*msgstr\s+"(.*)"/ );
		
#	print "found a msgstr (`$1')\n";

	my $str = $1;
	my $line = '';
	while ( $line = read_line() ) {
		last if($line !~ /^\s*"(.*)"/ );
		$str .= $1;
		$rawstr .= $line;
	}
	return ($str, $rawstr);
}

# Read msgid from INPUT, and write it into OUTPUT
my %plurals =
(
 'af' => 2,
 'ar' => 4,
 'az' => 1,
 'be' => 3,
 'bg' => 2,
 'bn' => 2,
 'br' => 1,
 'bs' => 3,
 'ca' => 2,
 'cs' => 3,
 'cy' => 2,
 'da' => 2,
 'de' => 2,
 'el' => 2,
 'en_GB' => 2,
 'eo' => 2,
 'es' => 2,
 'et' => 2,
 'eu' => 2,
 'fa' => 1,
 'fi' => 2,
 'fo' => 2,
 'fr' => 2,
 'fy' => 2,
 'ga' => 5,
 'gl' => 2,
 'he' => 2,
 'hi' => 2,
 'hu' => 1,
 'hr' => 3,
 'hsb' => 4,
 'id' => 1,
 'is' => 2,
 'it' => 2,
 'ja' => 1,
 'ko' => 1,
 'ku' => 2,
 'lo' => 1,
 'lt' => 3,
 'lv' => 2,
 'mk' => 3,
 'mn' => 2,
 'ms' => 2,
 'mt' => 4,
 'nl' => 2,
 'nb' => 2,
 'nds' => 2,
 'nn' => 2,
 'nso' => 2,
 'pa' => 2,
 'pl' => 3,
 'pt' => 2,
 'pt_BR' => 2,
 'ro' => 2,
 'ru' => 3,
 'se' => 2,
 'sk' => 3,
 'sl' => 4,
 'sr' => 3,
 'sr@Latn' => 3,
 'ss' => 2,
 'sv' => 2,
 'ta' => 2,
 'tg' => 2,
 'th' => 1,
 'tr' => 1,
 'uk' => 3,
 'uz' => 2,
 'ven' => 2,
 'vi' => 1,
 'wa' => 2,
 'xh' => 2,
 'xx' => 1,
 'zh_CN' => 1,
 'zh_TW' => 1,
 'zu' => 2
);

sub check_qt_args($$$$){
	my ($msgid, $msgstr,$desktop_file,$plural_forms) = @_;
	my $id_brackets = 0;
	my $str_brackets = 0;

	if ($msgstr =~ /^_:/) {
		print STDERR "Severe error '_:' encountered in msgstr at $current_file:$line_number\n";
		return 0;
	}

	if ($msgstr =~ /^_n:/) {
		print STDERR "Severe error '_n:' encountered in msgstr at $current_file:$line_number\n";
		return 0;
	}

	if ($msgid =~ /^_n:/) {
		if (!$plural_forms) {
			# An error message was already given when trying to find the plural form
			# print STDERR "can't find number of plural forms for $f\n";
			# Return 1 to avoid fuzzing message where the problem is totally elsewhere
			return 1; 
		}
		# count the number of \\n, code from http://perl.active-venture.com/pod/perlfaq4-datastrings.html
		my $current_plurals = () = $msgstr =~ /\\n/g;
		if ($current_plurals + 1 != $plural_forms) {
			print STDERR "Found wrong number of plural in $current_file:$line_number : ".($current_plurals+1)."\n";
			return 0;
		}
	}

	#print STDERR "testing $msgid vs $msgstr\n";

	if ($msgid eq '%l:%M%P' || $no_c_format || $msgid =~ /^_n:/ || $msgid =~ /^_: /) { # exceptions
		return 1;
	}

	while ( $msgid =~ /(%\w+)/g ) {
		my $tok = $1;
		my $rtok = $tok;
		while (1) {
			if ( $msgstr =~ /$tok/ ) {
				$msgstr =~ s/$tok//;
				last;
			} else {
				$tok =~ s/.$//;
			}
			if ($tok eq '%' || $tok eq '%0') {
				print STDERR "msgstr doesn't contain $rtok at $current_file:$line_number\n";
				return 0;
			}
		}
		#		$msgid =~ s/$tok//;
	}
	if ( $msgstr =~ /%\w+/ ) {
		print STDERR "remaining %... in $msgstr at $current_file:$line_number\n";
		return 0;
	}

	if ($desktop_file) {
		my $tag = $msgid;
		$tag =~ s/=.*//;
		if ($msgstr !~ /^$tag=/) {
			print STDERR "Tag doesn't match in $current_file:$line_number\n";
			return 0;
		}
	}
	return 1;
}

sub check_template($)
{
	my $fullrelpath = $_[0]; # kept around for the print
	my $relpath = $fullrelpath;
	# For ./lang/messages/kdebase/foo.po, check if templates/kdebase/foo.pot exists
	$relpath =~ s,^[^/]*/,,; # remove language
	if ( $relpath =~ s,messages/,, ) {
		my $template = "templates/${relpath}t";
		if ( ! -f "$topdir/$template" ) {
			# Try to find if it moved
			my $filename = basename($relpath) . "t";
			my $prefix = "";
			$prefix = "/docs" if ( $relpath =~ /^docs/ );
			my $newloc = `ls -1 $topdir/templates$prefix/*/$filename 2> /dev/null`;
			if ( $newloc ) {
				chomp($newloc);
				$newloc =~ s,^$topdir/templates/,,;
				$newloc =~ s,t$,,;
				print STDERR "Warning: $fullrelpath looks like the template moved to $newloc. Consider using ./rename_or_move $relpath $newloc\n";
			} else {
				print STDERR "Warning: $fullrelpath looks like an orphan - there is no more $template (check for renamings with cvslastlog)\n";
				#system("cvs rm -f $fullrelpath");
				#next;
			}
		}
	}
}

sub find_plural_form($)
{
	my $current_file = $_[0];
	# print "Processing " . dirname($current_file) . "...\n";
	my $plural_forms = -1;
	my $kdelibs_dir = dirname($current_file);
	while (!($kdelibs_dir eq '/')) {
		if (-f "$kdelibs_dir/kdelibs/kdelibs.po") {
			$kdelibs_dir = basename(dirname($kdelibs_dir));
			if (defined $plurals{$kdelibs_dir}) {
				$plural_forms = $plurals{$kdelibs_dir};
			} else {
				print STDERR "no plural forms defined for $kdelibs_dir (kdelibs.po)\n";
				$plural_forms = 0;
			}
			last;
		} elsif (-f "$kdelibs_dir/messages/entry.desktop") { # If we have no kdelibs (KOffice stable branches), may be we have an entry.desktop instead
			$kdelibs_dir = basename($kdelibs_dir);
			if (defined $plurals{$kdelibs_dir}) {
				$plural_forms = $plurals{$kdelibs_dir};
			} else {
				print STDERR "no plural forms defined for $kdelibs_dir (entry.desktop)\n";
				$plural_forms = 0;
			}
			last;
		}
		$kdelibs_dir = dirname($kdelibs_dir);
	}
	if ($plural_forms eq -1 ) {
		print STDERR "no plural forms defined for $current_file (kdelibs.po not found!)\n";
		$plural_forms = 0;
	}
	return $plural_forms;
}

$topdir = $0;
$topdir = cwd() . "/" . $0 unless ($topdir =~ m,^/,);
$topdir = Cwd::realpath(dirname($topdir));

my @dlist = `find . -type d | sort`;
my $olddir = "";
my $plural_forms;

foreach my $d (@dlist) {
	chomp($d);
	$d =~ s,^\./,,;
	my @flist = `ls -1 $d/*.po 2> /dev/null`;
	print "Entering $d...\n" if ($#flist > 0 && $d =~ m,^[^/]*$,); # print if no slash in the name

	foreach my $f (@flist) {
		chomp($f);
		$current_file = Cwd::realpath(dirname(cwd() . "/$f")) . "/" . basename($f);
		# print "Processing $current_file\n";
		if (!(dirname($current_file) eq $olddir)) {
			# New subdirectory, find the appropriate plural form
			$olddir = dirname($current_file);
			$plural_forms = find_plural_form($current_file);
		}
		my %tofuzzy = ();
		my %toremove = ();
		my $desktop_file;
		if (basename($current_file) =~ "^desktop_.*\.po") {
			$desktop_file = 1;
		} else {
			$desktop_file = 0;
		}

		my $relpath = substr(Cwd::realpath($f), length($topdir) + 1);
		check_template( $relpath );

		# Now open the po file
		my %msgstrs = ();
		my %seen_msgids = ();
		open( INPUT, $f ) or die "Can't open $f!";
	
		my $msgid;
		my $msgstr;
		$line_number = 0;
	
		# Retrieve $msgid and $msgstr
		(undef,$msgid,undef) = get_msgid();
		($msgstr,undef) = get_msgstr();
		print STDERR "Warning: No header in $current_file\n" if( length($msgid));

		while ( 1 ) {
			(undef,$msgid,undef) = get_msgid();
			last unless defined $msgid;
			($msgstr,undef) = get_msgstr();

			if (length($msgstr)) {
				my $found = 0;
				if ( $seen_msgids{$msgid}++ ) {
					print STDERR "msgid \'$msgid\' seen twice at $current_file:$line_number\n";
					$tofuzzy{$msgid} = 1;
					$toremove{$msgid}++;
				} else {
					if (!$fuzzy) {
						if (!check_qt_args($msgid, $msgstr, $desktop_file, $plural_forms)) {
							$tofuzzy{$msgid} = 1;
						}
						if ($msgid !~ m/^_/) {
							if ($msgid =~ m/\\n$/ && $msgstr !~ m/\\n$/) {
								print "line feed mismatch: $msgid\n";
								$tofuzzy{$msgid} = 1;
							}
							if ($msgid !~ m/\\n$/ && $msgstr =~ m/\\n$/) {
								print "line feed mismatch: $msgid\n";
								$tofuzzy{$msgid} = 1;
							}
						}
					}
					$msgstrs{$msgid} = $msgstr;
				}
			}
		}
		close( INPUT );

		if (%tofuzzy || %toremove) {
			# Write out modified file
			open( OUTPUT, ">$current_file.NEW" ) || die;
			open( INPUT, $f ) || die;
			my $comment;
			my $rawmsgid;
			my $rawmsgstr;
			my $msgid;

			while( 1 ) {
				($comment,$msgid,$rawmsgid) = get_msgid();
				last unless defined $msgid;
				(undef,$rawmsgstr) = get_msgstr();
				print OUTPUT $comment;

				if ( exists $toremove{$msgid} ) {
					$toremove{$msgid}--; # keep the last one
					next;
				}

				if ( exists $tofuzzy{$msgid} ) {
					print OUTPUT "#, fuzzy\n";
				}
				print OUTPUT $rawmsgid;
				print OUTPUT $rawmsgstr;
				print OUTPUT "\n";
			}
			print OUTPUT $comment;
			close(OUTPUT);
			close(INPUT);
			system("if cmp -s $current_file $current_file.NEW; then rm $current_file.NEW; else echo 'Fixed $current_file'; mv -f $current_file.NEW $current_file; fi");
			#system("cat $current_file.NEW; rm $current_file.NEW");
		}
		#	print "-----\n";
	}
}

