#!/usr/bin/env perl
use strict;
use warnings;
-use YAML::Syck qw(LoadFile);
-use Data::Walk;
+use YAML::Syck qw(Load LoadFile);
use Test::Differences;
use Pod::Usage ();
use Getopt::Long ();
=head1 SYNOPSIS
- locale-diff en.yml is.yml
- locale-diff en.yml is.yml | grep '*'
+ # --keys is the default
+ diff en.yml is.yml
+ diff --keys en.yml is.yml
+
+ # --untranslated-values compares prints keys whose values don't differ
+ diff --untranslated-values-all en.yml is.yml
+
+ # --untranslated-values-all compares prints keys whose values
+ # don't differ. Ignoring the blacklist which prunes things
+ # unlikley to be translated
+ diff --untranslated-values-all en.yml is.yml
=head1 DESCRIPTION
Print this help message.
+=item --keys
+
+Show the hash keys that differ between the two files, useful merging
+new entries from F<en.yml> to a local file.
+
+=item --untranslated-values
+
+Show keys whose values are either exactly the same between the two
+files, or don't exist in the target file (the latter file
+specified). The values are pruned according to global and language
+specific blacklists found in the C<__DATA__> section of this script.
+
+This helps to find untranslated values.
+
+=item --untranslated-values-all
+
+Like C<--untranslated-values> but ignores blacklists.
+
=back
=head1 AUTHOR
config => [ qw< bundling no_ignore_case no_require_order pass_through > ],
)->getoptions(
'h|help' => \my $help,
+ 'keys' => \my $keys,
+ 'untranslated-values' => \my $untranslated_values,
+ 'untranslated-values-all' => \my $untranslated_values_all,
) or help();
+# --keys is the default
+$keys = 1 if not $untranslated_values_all and not $untranslated_values;
+
# On --help
help() if $help;
my $from_data = LoadFile($from);
my $to_data = LoadFile($to);
-# Normalize the two to have the same root element
-my ($from_key) = keys %$from_data;
-$from_data = $from_data->{$from_key};
+my $from_parsed = { iterate($from_data->{basename($from)}) };
+my $to_parsed = { iterate($to_data->{basename($to)}) };
-my ($to_key) = keys %$to_data;
-$to_data = $to_data->{$to_key};
+# Since this used to be the default, support that...
+if ($keys)
+{
+ print_key_differences();
+}
+elsif ($untranslated_values or $untranslated_values_all)
+{
+ my @untranslated = untranslated_keys($from_parsed, $to_parsed);
-# Delete hash values
-walkdepth \&delete_hash_values, $_ for $from_data, $to_data;
+ # Prune according to blacklist
+ if ($untranslated_values) {
+ @untranslated = prune_untranslated_with_blacklist(basename($to), @untranslated);
+ }
-# Hack around Test::Differences wanting a Test::* module loaded
-$INC{"Test.pm"} = 1;
-sub Test::ok { print shift }
+ print $_, "\n" for @untranslated;
+}
-# Diff the tree
-eq_or_diff($from_data, $to_data);
+exit 0;
-sub delete_hash_values
+sub print_key_differences
{
- return unless defined $Data::Walk::type and $Data::Walk::type eq 'HASH';
+ # Hack around Test::Differences wanting a Test::* module loaded
+ $INC{"Test.pm"} = 1;
+ sub Test::ok { print shift }
- # We totally need Perl 6's $OUTER::_ to make this prettier
- my $hash = $_;
+ # Diff the tree
+ eq_or_diff([ sort keys %$from_parsed ], [ sort keys %$to_parsed ]);
+}
- @$hash{grep { not ref $hash->{$_} } keys %$hash} = ();
+sub untranslated_keys
+{
+ my ($from_parsed, $to_parsed) = @_;
+ sort grep { not exists $to_parsed->{$_} or $from_parsed->{$_} eq $to_parsed->{$_} } keys %$from_parsed;
+}
+
+sub prune_untranslated_with_blacklist
+{
+ my ($language, @keys) = @_;
+ my %keys;
+ @keys{@keys} = ();
+
+ my $end_yaml = Load(join '', <DATA>);
+ my $untranslated_values = $end_yaml->{untranslated_values};
+ my $default = $untranslated_values->{default};
+ my $this_language = $untranslated_values->{$language} || {};
+
+ my %bw_list = (%$default, %$this_language);
+
+ while (my ($key, $blacklisted) = each %bw_list)
+ {
+ # FIXME: Does syck actually support true/false booleans in yaml?
+ delete $keys{$key} if $blacklisted eq 'true'
+ }
+
+ sort keys %keys;
+}
+
+sub iterate
+{
+ my ($hash, @path) = @_;
+ my @ret;
+
+ while (my ($k, $v) = each %$hash)
+ {
+ if (ref $v eq 'HASH')
+ {
+ push @ret => iterate($v, @path, $k);
+ }
+ else
+ {
+ push @ret => join(".",@path, $k), $v;
+ }
+ }
+
+ return @ret;
+}
+
+sub basename
+{
+ my $name = shift;
+ $name =~ s[\..*?$][];
+ $name;
}
sub help
-exitval => $arg{ exitval } || 0,
);
}
+
+__DATA__
+untranslated_values:
+
+ # Default/Per language blacklist/whitelist for the
+ # --untranslated-values switch. "true" as a value indicates that the
+ # key is to be blacklisted, and "false" that it's to be
+ # whitelisted. "false" is only required to whitelist a key
+ # blacklisted by default on a per-language basis.
+
+ default:
+ html.dir: true
+ layouts.intro_3_bytemark: true
+ layouts.intro_3_ucl: true
+ layouts.project_name.h1: true
+ layouts.project_name.title: true
+ site.index.license.license_url: true
+ site.index.license.project_url: true
+ de:
+ layouts.export: true
+