#!/usr/bin/perl

# By timeless
# Compare locale strings
#
# Usage:
# freemoe-locale-cmp delta unused_field src/po/es_MX src/po/en_US/

my ($verb, $domain, $deltas, $dest, $locale, $extra, $orig) = @ARGV;
my %map = ();
my %map2 = ();

sub init {
  unless (defined $verb && defined $domain) {
    print "$0 merge domain [delta_path [destination_path [locale [extra [orig_path]]]]]
";
    print "$0 delta domain new_mo old_mo
";
    exit 1;
  }
  return if $verb eq 'merge';
  my $base = '/usr/share/locale/';

  $extra = '/LC_MESSAGES/' unless defined $extra;
  $locale = 'en_US' unless defined $locale;
  $dest = "$base$locale$extra$domain.mo" unless defined $dest;
  $deltas = "$base$locale.1$extra$domain.pd" unless defined $deltas;
  $orig = "$base$locale.0$extra$domain.mo" unless defined $orig;
}

sub unformat {
  my ($orig) = @_;
  if (-d $orig) {
    foreach my $file (<$orig/*>) {
      unformat($file);
    }
    return;
  }
  my ($text, $isPO, $isMO);
  if ($orig =~ /\.mo$/) {
    $isMO = 1;
  } elsif ($orig =~ /\.po$/) {
    $isPO = 1;
  } else {
    $isMO = 1;
  }
  if ($isMO) {
    $text = `msgunfmt $orig 2> /dev/null`;
  } else {
    $text = `cat $orig`;
  }
  if (0) {
  print "
$domain
$deltas
$dest
$locale
$extra
$base
$orig
";
  }

  my @lines = split /\n/, $text;
  while (@lines) {
    my $line = shift @lines;
    next unless $line =~ /\S/;
    if ($line =~ /^msgid/) {
      my $key = $line;
      while (($line = shift @lines) &&
             $line !~ /^msgstr/) {
        $key .= "\n$line";
      }
      my $data = $line;
      while (($line = shift @lines)) {
        $data .= "\n$line";
      }
      # print "$key => $data\n";
      $map{$key} = $data;
    }
  }
}

init();

sub dumpKey {
  my ($key) = @_;
  print $key . "\n" . $map{$key} . "\n\n";
  delete $map{$key};
}

sub review {
  dumpKey('msgid ""');
  foreach my $key (sort {$a cmp $b} keys %map) {
    dumpKey($key);
  }
}

sub merge {
  open DELTAS, '<', $deltas || return;
  # merge format:
  # HEADER: # po-delta
  # EXEMPT: !~ /re/
  # REWRITE: =~ s/old/new/
  # ENDHEAD: [empty line]
  # REPLACEMENTS: msgid .../msgstr ...
  my $ok = 5;
  my ($line, @exempt, @rewrite, %override);
  while ($ok && ($line = <DELTAS>)) {
    if ($ok == 5) {
      $ok = $line =~ /^# po-delta/ ? 4 : 0;
    } else {
      if ($ok == 4) {
        if ($line =~ /^([!=])~ (.*)/) {
          if ($1 eq '!') {
            push @exempt, $2;
          } elsif ($1 eq '=') {
            push @rewrite, $2;
          }
        } else {
          --$ok;
        } 
      }
      if ($ok == 3) {
        $ok = $line eq "\n" ? 2 : 0;
      }
      if ($ok == 2) {
        if ($line =~ /^msgid/) {
          my $key = $line;
          $key .= $line while (($line = <DELTAS>) && $line !~ /^msgstr/);
          chomp $key;
          my $value = $line;
          $value .= $line while (($line = <DELTAS>) && $line ne "\n");
          chomp $value;
          $override{$key} = $value;
        }
      }
    }
  }
  close DELTAS;
  for my $key (keys %override) {
    $map{$key} = $override{$key};
  }
  my $re = '^$';
  foreach $rep (@exempt) {
    next unless $rep =~ m!/(.*)/!;
    $re .= "|$1";
  }
  $re = qr/$re/;
  for my $key (keys %map) {
    next if defined $override{$key};
    next if $key =~ $re;
    my $value = $map{$key};
    my $update = 0;
    foreach $repl (@rewrite) {
      (eval "\$value =~ $repl") && ($update = 1);
    }
    $map{$key} = $value if $update;
  }
}

sub escape_re {
  my ($str) = @_;
  $str =~ s!([\\\[\]/.*+?(){}])!\\$1!g;
  return $str;
}

my %accounting = ();
my %rmap = ();
my @conflicts = ();
sub queue {
  my ($old, $new) = @_;
  if ((defined $rmap{$old}) && ($rmap{$old} ne $new)) {
    push @conflicts, "# $old => $new ! $rmap{$old}";
  } else {
    $rmap{$old} = $new;
  }
  ($old, $new) = (escape_re($old), escape_re($new));
  my $re = "=~ s/\\b$old\\b/$new/\n";
  if (defined $accounting{$re}) {
    ++$accounting{$re};
  } else {
    $accounting{$re} = 1;
  }
}

sub flush {
  my %scores = ();
  if (scalar @conflicts) {
    print "# Conflicts (".(scalar @conflicts)."):\n";
    print join "\n", sort @conflicts;
    print "\n#\n";
  }
  foreach my $key (sort keys %accounting) {
    my $value = $accounting{$key};
    my @list;
    if (defined $scores{$value}) {
      @list = @{$scores{$value}};
    } else {
      @list = ();
    }
    push @list, $key;
    $scores{$value} = \@list;
  }
  foreach my $key (reverse sort {$a <=> $b} keys %scores) {
    my @list = @{$scores{$key}};
    print "# $key\n";
    my @list2 = sort
      {
        my ($c, $d, $e, $f) = (length $a, length $b, lc $a, lc $b);
        ($c == $d) ?
         ($e eq $f ? $a cmp $b : $e cmp $f) : $d <=> $c;
      }
      @list;
    foreach my $item (@list2) {
      print $item;
    }
  }
}

sub delta {
  my ($left_string, $right_string) = @_;
  return if $left_string eq $right_string;
  my (@left_list, @right_list);
  @left_list = split /\s+/, $left_string;
  @right_list = split /\s+/, $right_string;
  if (0)
  { local $, = "|"; print @left_list; print "\n"; print @right_list; print "\n"; }

  use Algorithm::Diff;
  my @cdiff = Algorithm::Diff::compact_diff(\@left_list, \@right_list);

  my $cdiff_count = scalar(@cdiff);
  if (0) {
    for (my $i = 2; $i < $cdiff_count; $i+=2) {
      print "$cdiff[$i],\t$cdiff[$i+1],\t#\t";
      print join(' ',@left_list[$cdiff[$i]..$cdiff[$i+2]-1]);
      print "\t~\t";
      print join(' ',@right_list[$cdiff[$i+1]..$cdiff[$i+3]-1]);
      print "\n";
    }
  }
  for (my $i = 2; $i < $cdiff_count-2; $i+=4) {
    my ($a, $b, $c, $d) = ($cdiff[$i], $cdiff[$i+1], $cdiff[$i+2]-1, $cdiff[$i+3]-1);
    if (($a > $c) || ($b > $d)) {
      # handle insertions
      $a--;
      $c++;
      $b--;
      $d++;
    }
    my $old = join ' ',@left_list[$a..$c];
    my $new = join ' ',@right_list[$b..$d];
    if (0) {
      print "$old ($a..$c) > $new ($b..$d)\n"; 
    }
    queue($old, $new);
  }
}

sub unwrap_msgstr {
  my ($str) = @_;
  $str =~ /^(?:msgstr )"(.*)"\s*$/ms;
  my $str2 = $1;
  $str2 =~ s/"\n"//mg;
  $str2 =~ s/(\\[\\tn])/ $1 /g;
  # what do we do about \n\t\\ ?
  return $str2;
}

sub rewrap_msgstr {
  my ($str) = @_;
  $str =~ s/ (\\[\\tn]) /$1/g;
  if ($str =~ s/(\\n)/$1"\n"/g) {
    $str = qq!"\n"$str!;
  }
  return qq!msgstr "$str"!;
}

for ($verb) {
  /^merge$/ && do {
    unformat($orig);
    merge();
    review();
  };
  /^delta$/ && do {
    unformat($deltas);
    %map2 = %map;
    %map = (); 
    unformat($dest);
    print "# po-delta\n";

    foreach my $key (keys %map) {
      if (defined $map2{$key}) {
        delta(
          unwrap_msgstr($map{$key}),
          unwrap_msgstr($map2{$key}) 
       );
      }
    }
    flush();
  };
}
