5 # script to compare changes between translation files before merging them
8 # ./diff_po.pl cs.po.old cs.po
9 # svn diff -r38367 --diff-cmd ./diff_po.pl cs.po
10 # git difftool --extcmd=./diff_po.pl sk.po
11 # ./diff_po.pl -rHEAD~100 cs.po #fetch git revision and compare
12 # ./diff_po.pl -r39229 cs.po #fetch svn revision and compare
13 # ./diff_po.pl -r-1 cs.po #fetch the previous change of cs.po and compare
15 # This file is free software; you can redistribute it and/or
16 # modify it under the terms of the GNU General Public
17 # License as published by the Free Software Foundation; either
18 # version 2 of the License, or (at your option) any later version.
20 # This software is distributed in the hope that it will be useful,
21 # but WITHOUT ANY WARRANTY; without even the implied warranty of
22 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 # General Public License for more details.
25 # You should have received a copy of the GNU General Public
26 # License along with this software; if not, write to the Free Software
27 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
29 # Copyright (c) 2010-2013 Kornel Benko, kornel@lyx.org
32 # 1.) Search for good correlations of deleted <==> inserted string
33 # using Text::Levenshtein or Algorithm::Diff
37 # fuzzyopt: '--display-fuzzy=' val ;
39 # untranslatedopt: '--display-untranslated=' val ;
44 # options: | options option
47 # revspec: revision-tag # e.g. 46c00bab7
48 # | 'HEAD' relative-rev # e.g. HEAD~3, HEAD-3
49 # | '-' number # -1 == previous commit of the following po-file
52 # revision: '-r' revspec ;
54 # filespecold: revision | filespec ;
56 # filespec: # path to existing po-file
58 # filespecnew: filespec ;
60 # files: filespecold filespecnew ;
62 # diff: 'diff_po.pl' ' ' options files
67 my $p = File::Spec->rel2abs( __FILE__ );
68 $p =~ s/[\/\\]?[^\/\\]+$//;
74 use Term::ANSIColor qw(:constants);
76 use Cwd qw(abs_path getcwd);
78 my ($status, $foundline, $msgid, $msgstr, $fuzzy);
80 my %Messages = (); # Used for original po-file
81 my %newMessages = (); # new po-file
82 my %Untranslated = (); # inside new po-file
83 my %Fuzzy = (); # inside new po-file
84 my $result = 0; # exit value
88 "--display-fuzzy" => 1,
89 "--display-untranslated" => 1,
98 return undef if ($e !~ s/^\-\-//);
101 return "DIFF_PO_" . $e;
104 # Set option-defaults from environment
105 # git: not needed, diff is not recursive here
106 # svn: needed to pass options through --diff-cmd parameter
107 # hg: needed to pass options through extdiff parameter
108 for my $opt (keys %options) {
109 my $e = &get_env_name($opt);
111 if (defined($ENV{$e})) {
112 $options{$opt} = $ENV{$e};
117 while (($opt=$ARGV[0]) =~ s/=(\d+)$//) {
119 if (defined($options{$opt})) {
120 $options{$opt} = $val;
121 my $e = &get_env_name($opt);
128 die("illegal option \"$opt\"\n");
131 # Check first, if called as standalone program for git
132 if ($ARGV[0] =~ /^-r(.*)/) {
138 # convert arguments to full path ...
139 for my $argf1 (@ARGV) {
140 $argf1 = abs_path($argf1);
142 for my $argf (@ARGV) {
143 #my $argf = abs_path($argf1);
146 if ($argf =~ /^(.*)\/([^\/]+)$/) {
149 chdir($filedir); # set working directory for the repo-command
156 my ($repo, $level) = &searchRepo($filedir);
157 my $relargf = $baseargf; # argf relative to the top-most repo directory
159 if (defined($level)) {
160 my $abspathpo = $filedir; # directory of the po-file
161 $topdir = $abspathpo;
162 #print "Level = $level, abs path = $abspathpo\n";
164 $topdir =~ s/\/([^\/]+)$//;
165 $relargf = "$1/$relargf";
167 #print "Level = $level, topdir = $topdir, rel path = $relargf\n";
172 print "Could not find the repo-type\n";
176 &check_po_file_readable($baseargf, $relargf);
177 if ($repo eq ".git") {
179 my $tmpfile = File::Temp->new();
180 $rev = &getrev($repo, $rev, $argf);
181 push(@args, "-L", $argf . " (" . $rev . ")");
182 push(@args, "-L", $argf . " (local copy)");
183 print "git show $rev:$relargf\n";
184 open(FI, "git show $rev:$relargf|");
185 $tmpfile->unlink_on_destroy( 1 );
186 while(my $l = <FI>) {
190 $tmpfile->seek( 0, SEEK_END ); # Flush()
191 push(@args, $tmpfile->filename, $argf);
192 print "===================================================================\n";
195 elsif ($repo eq ".svn") {
196 # program svnversion needed here
197 $rev = &getrev($repo, $rev, $argf);
198 # call it again indirectly
199 my @cmd = ("svn", "diff", "-r$rev", "--diff-cmd", $0, $relargf);
200 print "cmd = " . join(' ', @cmd) . "\n";
203 elsif ($repo eq ".hg") {
204 # for this to work, one has to edit ~/.hgrc
209 $rev = &getrev($repo, $rev, $argf);
210 my @cmd = ("hg", "extdiff", "-r", "$rev", "-p", $0, $relargf);
211 print "cmd = " . join(' ', @cmd) . "\n";
221 #########################################################
223 # This routine builds n-th parent-path
224 # E.g. &buildParentDir("abc", 1) --> "abc/.."
225 # &buildParentDir("abc", 4) --> "abc/../../../.."
226 sub buildParentDir($$)
228 my ($dir, $par) = @_;
230 return &buildParentDir("$dir/..", $par-1);
237 # Tries up to 10 parent levels to find the repo-type
238 # Returns the repo-type
242 for my $parent ( 0 .. 10 ) {
243 my $f = &buildParentDir($dir, $parent);
244 for my $s (".git", ".svn", ".hg") {
246 #print "Found repo on level $parent\n";
247 return ($s, $parent);
251 return(""); # not found
263 while(defined($args[0])) {
264 last if ($args[0] !~ /^\-/);
265 my $param = shift(@args);
266 if ($param eq "-L") {
267 my $name = shift(@args);
271 # ignore other options
274 if (! defined($names[0])) {
275 push(@names, "original");
277 if (! defined($names[1])) {
282 die("names = \"", join('" "', @names) . "\"... args = \"" . join('" "', @args) . "\" Expected exactly 2 parameters");
285 &check_po_file_readable($names[0], $args[0]);
286 &check_po_file_readable($names[1], $args[1]);
288 &parse_po_file($args[0], \%Messages);
289 &parse_po_file($args[1], \%newMessages);
291 my @MsgKeys = &getLineSortedKeys(\%newMessages);
293 print RED "<<< \"$names[0]\"\n", RESET;
294 print GREEN ">>> \"$names[1]\"\n", RESET;
295 for my $k (@MsgKeys) {
296 if ($newMessages{$k}->{msgstr} eq "") {
297 # this is still untranslated string
298 $Untranslated{$newMessages{$k}->{line}} = $k;
300 elsif ($newMessages{$k}->{fuzzy}) {
302 # mark only, if not in alternative area
303 if (! $newMessages{$k}->{alternative}) {
304 $Fuzzy{$newMessages{$k}->{line}} = $k;
307 if (exists($Messages{$k})) {
308 &printIfDiff($k, $Messages{$k}, $newMessages{$k});
309 delete($Messages{$k});
310 delete($newMessages{$k});
315 @MsgKeys = sort keys %Messages, keys %newMessages;
316 for my $k (@MsgKeys) {
317 if (defined($Messages{$k})) {
319 print "deleted message\n";
320 print "< line = " . $Messages{$k}->{line} . "\n" if ($printlines);
321 print RED "< fuzzy = " . $Messages{$k}->{fuzzy} . "\n", RESET;
322 print RED "< msgid = \"$k\"\n", RESET;
323 print RED "< msgstr = \"" . $Messages{$k}->{msgstr} . "\"\n", RESET;
325 if (defined($newMessages{$k})) {
327 print "new message\n";
328 print "> line = " . $newMessages{$k}->{line} . "\n" if ($printlines);
329 print GREEN "> fuzzy = " . $newMessages{$k}->{fuzzy} . "\n", RESET;
330 print GREEN "> msgid = \"$k\"\n", RESET;
331 print GREEN "> msgstr = \"" . $newMessages{$k}->{msgstr} . "\"\n", RESET;
336 @MsgKeys = &getLineSortedKeys(\%Messages);
337 for my $k (@MsgKeys) {
339 print "deleted message\n";
340 print "< line = " . $Messages{$k}->{line} . "\n" if ($printlines);
341 print RED "< fuzzy = " . $Messages{$k}->{fuzzy} . "\n", RESET;
342 print RED "< msgid = \"$k\"\n", RESET;
343 print RED "< msgstr = \"" . $Messages{$k}->{msgstr} . "\"\n", RESET;
346 @MsgKeys = &getLineSortedKeys(\%newMessages);
347 for my $k (@MsgKeys) {
349 print "new message\n";
350 print "> line = " . $newMessages{$k}->{line} . "\n" if ($printlines);
351 print GREEN "> fuzzy = " . $newMessages{$k}->{fuzzy} . "\n", RESET;
352 print GREEN "> msgid = \"$k\"\n", RESET;
353 print GREEN "> msgstr = \"" . $newMessages{$k}->{msgstr} . "\"\n", RESET;
356 if ($options{"--display-fuzzy"}) {
357 &printExtraMessages("fuzzy", \%Fuzzy, \@names);
359 if ($options{"--display-untranslated"}) {
360 &printExtraMessages("untranslated", \%Untranslated, \@names);
364 sub check_po_file_readable($$)
366 my ($spec, $filename) = @_;
368 if (! -e $filename ) {
369 die("$spec po file does not exist");
371 if ( ! -f $filename ) {
372 die("$spec po file is not regular");
374 if ( ! -r $filename ) {
375 die("$spec po file is not readable");
379 # Diff of one corresponding entry
382 my ($k, $nk, $rM, $rnM) = @_;
383 print "diffline = " . $rM->{line} . "," . $rnM->{line} . "\n" if ($printlines);
384 print " msgid = \"$k\"\n";
385 if ($rM->{fuzzy} eq $rnM->{fuzzy}) {
386 print " fuzzy = " . $rM->{fuzzy} . "\n" if ($printlines);
389 print RED "< fuzzy = " . $rM->{fuzzy} . "\n", RESET;
391 print RED "< msgstr = " . $rM->{msgstr} . "\n", RESET;
393 print GREEN "> msgid = \"$nk\"\n", RESET;
395 if ($rM->{fuzzy} ne $rnM->{fuzzy}) {
396 print GREEN "> fuzzy = " . $rnM->{fuzzy} . "\n", RESET;
398 print GREEN "> msgstr = " . $rnM->{msgstr} . "\n", RESET;
404 my ($k, $rM, $rnM) = @_;
406 $doprint = 1 if ($rM->{fuzzy} != $rnM->{fuzzy});
407 $doprint = 1 if ($rM->{msgstr} ne $rnM->{msgstr});
410 &printDiff($k, $k, $rM, $rnM);
414 sub printExtraMessages($$$)
416 my ($type, $rExtra, $rNames) = @_;
417 #print "file1 = $rNames->[0], file2 = $rNames->[1]\n";
418 my @sortedExtraKeys = sort { $a <=> $b;} keys %{$rExtra};
420 if (@sortedExtraKeys > 0) {
421 print "Still " . 0 + @sortedExtraKeys . " $type messages found in $rNames->[1]\n";
422 for my $l (@sortedExtraKeys) {
423 print "> line $l: \"" . $rExtra->{$l} . "\"\n";
429 # get repository dependent revision representation
432 my ($repo, $rev, $argf) = @_;
435 if ($rev eq "HEAD") {
439 return $rev if ($rev !~ /^(-|HEAD[-~])(\d+)$/);
442 if ($repo eq ".hg") {
443 # try to get the revision of n-th previous change of the po-file
444 if (open(FIR, "hg log '$argf'|")) {
446 my $res = "-$revnum";
447 while (my $l = <FIR>) {
449 if ($l =~ /:\s+(\d+):([^\s]+)$/) {
451 last if ($count-- <= 0);
461 elsif ($repo eq ".git") {
462 # try to get the revision of n-th previous change of the po-file
463 if (open(FIR, "git log --skip=$revnum -1 '$argf'|")) {
464 my $res = "HEAD~$revnum";
465 while (my $l = <FIR>) {
467 if ($l =~ /^commit\s+([^\s]+)$/) {
476 return("HEAD~$revnum");
479 elsif ($repo eq ".svn") {
480 if (open(FIR, "svn log '$argf'|")) {
483 while (my $l = <FIR>) {
485 if ($l =~ /^r(\d+)\s+\|/) {
487 last if ($count-- <= 0);
494 if (open(VI, "svnversion |")) {
495 while (my $r1 = <VI>) {
497 if ($r1 =~ /^((\d+):)?(\d+)M?$/) {