A utility to print the structural differences between two files in config/locales

diff --git a/script/utils/locale-diff b/script/utils/locale-diff
new file mode 100644 (file)
index 0000000..1bb07d8
--- /dev/null
+++ b/script/utils/locale-diff
@@ -0,0 +1,95 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use YAML::Syck qw(LoadFile);
+use Data::Walk;
+use Test::Differences;
+use Pod::Usage ();
+use Getopt::Long ();
+
+=head1 NAME
+
+locale-diff - Compare two YAML files and print how their datastructures differ
+
+=head1 SYNOPSIS
+
+    locale-diff en.yml is.yml
+    locale-diff en.yml is.yml | grep '*'
+
+=head1 DESCRIPTION
+
+This utility prints the differences between two YAML files using
+L<Test::Differences>. The purpose of it is to diff the files is
+F<config/locales> to find out what keys need to be added to the
+translated files when F<en.yml> changes.
+
+=head1 OPTIONS
+
+=over
+
+=item -h, --help
+
+Print this help message.
+
+=back
+
+=head1 AUTHOR
+
+E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason <avar@f-prot.com>
+
+=cut
+
+# Get the command-line options
+Getopt::Long::Parser->new(
+    config => [ qw< bundling no_ignore_case no_require_order pass_through > ],
+)->getoptions(
+    'h|help' => \my $help,
+) or help();
+
+# On --help
+help() if $help;
+
+# If we're not given two .yml files
+help() if @ARGV != 2 or (!-f $ARGV[0] or !-f $ARGV[1]);
+
+my ($from, $to) = @ARGV;
+
+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 ($to_key) = keys %$to_data;
+$to_data = $to_data->{$to_key};
+
+# Delete hash values
+walkdepth \&delete_hash_values, $_ for $from_data, $to_data;
+
+# Hack around Test::Differences wanting a Test::* module loaded
+$INC{"Test.pm"} = 1;
+sub Test::ok { print shift }
+
+# Diff the tree
+eq_or_diff($from_data, $to_data);
+
+sub delete_hash_values
+{
+    return unless defined $Data::Walk::type and $Data::Walk::type eq 'HASH';
+
+    # We totally need Perl 6's $OUTER::_ to make this prettier
+    my $hash = $_;
+
+    @$hash{grep { not ref $hash->{$_} } keys %$hash} = ();
+}
+
+sub help
+{
+    my %arg = @_;
+
+    Pod::Usage::pod2usage(
+        -verbose => $arg{ verbose },
+        -exitval => $arg{ exitval } || 0,
+    );
+}