[Rt-commit] rt branch, 4.2-trunk, updated. rt-4.2.14-33-g6dee85f9e

? sunnavy sunnavy at bestpractical.com
Wed Mar 14 16:51:38 EDT 2018


The branch, 4.2-trunk has been updated
       via  6dee85f9ea1aae86495a8bbc51e93bd3ad075df1 (commit)
       via  157e7f9bae510c8a05a48558d4ea1e6d66c0ca54 (commit)
       via  33fcc338b871aa95ac1d5db8da738a498ad49ef8 (commit)
       via  6d87c629c20dc3571f06e5c9030a12cf9a9a1737 (commit)
       via  be0a016d0c05519022237e9a45a46cf6ece66068 (commit)
       via  5f3d9eda56dd93e6bcd60da34ac963c2ba63da38 (commit)
       via  091de14bae18b8df1866ba5af061cfae8a3585b4 (commit)
       via  3ae12fb130ec642d0de59fbeb11c3228b6979fb5 (commit)
       via  ff5b55a19f80edc287435e2cf062deaf1dab0fcb (commit)
       via  9f59d1a305199078d1fb7f191ad95cbfdc1c6f60 (commit)
       via  5032832f866c1723d7b71147e201edccb3852c58 (commit)
       via  2c929112fca712fa71f56d2b3c131241baf3bfcc (commit)
       via  495bf0f891ace34fc277bc3b4b875846a12fd83d (commit)
       via  8303ea9a1882d4bab32c9456c010e392c23f147b (commit)
      from  79038f5561f75c05a27cd71509580b90e0a0fe57 (commit)

Summary of changes:
 devel/tools/extract-message-catalog | 256 ++-------------------------------
 lib/RT/Config.pm                    |  20 ++-
 lib/RT/I18N/Extract.pm              | 280 ++++++++++++++++++++++++++++++++++++
 t/i18n/extract.t                    |  18 +++
 4 files changed, 324 insertions(+), 250 deletions(-)
 create mode 100644 lib/RT/I18N/Extract.pm
 create mode 100644 t/i18n/extract.t

- Log -----------------------------------------------------------------
commit 8303ea9a1882d4bab32c9456c010e392c23f147b
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 01:56:28 2016 -0700

    Re-format RT/Config.pm so the `# loc` comment parses correctly
    
    The trailing `# loc` comment can only deal with a limited set of
    possible trailing characters; it fails to extract if followed by a
    comma and an extra expression.
    
    Make `./devel/tools/rt-message-catalog extract` happy by re-wrapping
    the expression.

diff --git a/lib/RT/Config.pm b/lib/RT/Config.pm
index 25de4f29e..df335d502 100644
--- a/lib/RT/Config.pm
+++ b/lib/RT/Config.pm
@@ -340,10 +340,16 @@ our %META;
 
                 for my $value (@values) {
                     if ($value % 60 == 0) {
-                        $labels{$value} = ['Refresh search results every [quant,_1,minute,minutes].', $value / 60]; # loc
+                        $labels{$value} = [
+                            'Refresh search results every [quant,_1,minute,minutes].', #loc
+                            $value / 60
+                        ];
                     }
                     else {
-                        $labels{$value} = ['Refresh search results every [quant,_1,second,seconds].', $value]; # loc
+                        $labels{$value} = [
+                            'Refresh search results every [quant,_1,second,seconds].', #loc
+                            $value
+                        ];
                     }
                 }
 
@@ -370,10 +376,16 @@ our %META;
 
                 for my $value (@values) {
                     if ($value % 60 == 0) {
-                        $labels{$value} = ['Refresh home page every [quant,_1,minute,minutes].', $value / 60]; # loc
+                        $labels{$value} = [
+                            'Refresh home page every [quant,_1,minute,minutes].', #loc
+                            $value / 60
+                        ];
                     }
                     else {
-                        $labels{$value} = ['Refresh home page every [quant,_1,second,seconds].', $value]; # loc
+                        $labels{$value} = [
+                            'Refresh home page every [quant,_1,second,seconds].', #loc
+                            $value
+                        ];
                     }
                 }
 

commit 495bf0f891ace34fc277bc3b4b875846a12fd83d
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 02:40:47 2016 -0700

    Extract all logic into a package, with minimal refactoring
    
    This does the minimal effort to move the File::Find invocation and
    associated function into a standalone module.  This module will
    eventually be used by the test suite to verify that there are no PO
    extraction errors.

diff --git a/devel/tools/extract-message-catalog b/devel/tools/extract-message-catalog
index e1766affe..a8f511237 100755
--- a/devel/tools/extract-message-catalog
+++ b/devel/tools/extract-message-catalog
@@ -53,21 +53,21 @@ use warnings;
 
 use open qw/ :std :encoding(UTF-8) /;
 
-use File::Find;
 use File::Copy;
-use Regexp::Common;
 use Carp;
 use Locale::PO;
+
+use lib 'lib';
+use RT::I18N::Extract;
+
 $| = 1;
 
 # po dir is for extensions
 @ARGV = (<share/po/*.po>, <share/po/*.pot>, <po/*.po>, <po/*.pot>) unless @ARGV;
 
-our %FILECAT;
-
 # extract all strings and stuff them into %FILECAT
 # scan html dir for extensions
-File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, qw(bin sbin lib share html etc) );
+our %FILECAT = RT::I18N::Extract->new->all;
 
 # ensure proper escaping and [_1] => %1 transformation
 foreach my $str ( sort keys %FILECAT ) {
@@ -117,208 +117,6 @@ foreach my $dict (@ARGV) {
     update($lang, $dict);
 }
 
-sub extract_strings_from_code {
-    my $file = $_;
-
-    local $/;
-    return if ( -d $_ || !-e _ );
-    return
-      if ( $File::Find::dir =~
-        qr!lib/blib|lib/t/autogen|var|m4|local|share/fonts! );
-    return if ( /\.(?:pot|po|bak|gif|png|psd|jpe?g|svg|css|js)$/ );
-    return if ( /~|,D|,B$|extract-message-catalog$|tweak-template-locstring$/ );
-    return if ( /StyleGuide.pod/ );
-    return if ( /^[\.#]/ );
-    return if ( -f "$_.in" );
-
-    print "Looking at $File::Find::name";
-    my $filename = $File::Find::name;
-    $filename =~ s'^\./'';
-    $filename =~ s'\.in$'';
-
-    unless (open _, '<', $file) {
-        print "\n  Cannot open $file for reading ($!), skipping.\n\n";
-        return;
-    }
-
-    my $errors = 0;
-
-    my $re_space_wo_nl = qr{(?!\n)\s};
-    my $re_loc_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc $re_space_wo_nl* $}mx;
-    my $re_loc_qw_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_qw $re_space_wo_nl* $}mx;
-    my $re_loc_paren_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc \(\) $re_space_wo_nl* $}mx;
-    my $re_loc_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_pair $re_space_wo_nl* $}mx;
-    my $re_loc_left_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_left_pair $re_space_wo_nl* $}mx;
-    my $re_delim = $RE{delimited}{-delim=>q{'"}}{-keep};
-
-    $_ = <_>;
-
-    # Mason filter: <&|/l>...</&> and <&|/l_unsafe>...</&>
-    my $line = 1;
-    while (m!\G(.*?<&\|/l(?:_unsafe)?(.*?)&>(.*?)</&>)!sg) {
-        my ( $all, $vars, $str ) = ( $1, $2, $3 );
-        $vars =~ s/[\n\r]//g;
-        $line += ( $all =~ tr/\n/\n/ );
-        $str =~ s/\\(['"\\])/$1/g;
-        push @{ $FILECAT{$str} }, [ $filename, $line, $vars ];
-    }
-
-    # Localization function: loc(...)
-    $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?\bloc$RE{balanced}{-parens=>'()'}{-keep})/sg) {
-        my ( $all, $match ) = ( $1, $2 );
-        $line += ( $all =~ tr/\n/\n/ );
-
-        my ( $vars, $str );
-        next unless ( $match =~ /\(\s*($re_delim)(.*?)\s*\)$/so );
-
-        my $interp = (substr($1,0,1) eq '"' ? 1 : 0);
-        $str = substr( $1, 1, -1 );       # $str comes before $vars now
-        $vars = $9;
-
-        $vars =~ s/[\n\r]//g;
-        $str  =~ s/\\(['"\\])/$1/g;
-
-        push @{ $FILECAT{$str} }, [ $filename, $line, $vars, $interp ];
-    }
-
-    my %seen;
-    # Comment-based mark: "..." # loc
-    $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?($re_delim)[ \{\}\)\],;]*$re_loc_suffix)/smgo) {
-        my ( $all, $str ) = ( $1, $2 );
-        $line += ( $all =~ tr/\n/\n/ );
-        $seen{$line}++;
-        unless ( defined $str ) {
-            print "\n" unless $errors++;
-            print "  Couldn't process loc at $filename:$line:\n  $str\n";
-            next;
-        }
-        my $interp = (substr($str,0,1) eq '"' ? 1 : 0);
-        $str = substr($str, 1, -1);
-        $str =~ s/\\(['"\\])/$1/g;
-        push @{ $FILECAT{$str} }, [ $filename, $line, '', $interp ];
-    }
-
-    # Comment-based mark for list to loc():  ("...", $foo, $bar)  # loc()
-    $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*? $RE{balanced}{-parens=>'()'}{-keep} [ \{\}\)\],;]* $re_loc_paren_suffix)/sgx) {
-        my ( $all, $match ) = ( $1, $2 );
-        $line += ( $all =~ tr/\n/\n/ );
-
-        my ( $vars, $str );
-        unless ( $match =~
-                /\(\s*($re_delim)(.*?)\s*\)$/so ) {
-            print "\n" unless $errors++;
-            print "  Failed to match delimited against $match, line $line";
-            next;
-        }
-
-        my $interp = (substr($1,0,1) eq '"' ? 1 : 0);
-        $str = substr( $1, 1, -1 );       # $str comes before $vars now
-        $vars = $9;
-        $seen{$line}++;
-
-        $vars =~ s/[\n\r]//g;
-        $str  =~ s/\\(['"\\])/$1/g;
-
-        push @{ $FILECAT{$str} }, [ $filename, $line, $vars, $interp ];
-    }
-
-    # Comment-based qw mark: "qw(...)" # loc_qw
-    $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?(?:qw\(([^)]+)\)[ \{\}\)\],;]*)?$re_loc_qw_suffix)/smgo) {
-        my ( $all, $str ) = ( $1, $2 );
-        $line += ( $all =~ tr/\n/\n/ );
-        $seen{$line}++;
-        unless ( defined $str ) {
-            print "\n" unless $errors++;
-            print "  Couldn't process loc_qw at $filename:$line:\n  $str\n";
-            next;
-        }
-        foreach my $value (split ' ', $str) {
-            push @{ $FILECAT{$value} }, [ $filename, $line, '' ];
-        }
-    }
-
-    # Comment-based left pair mark: "..." => ... # loc_left_pair
-    $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?(?:(\w+|$re_delim)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix)/smgo) {
-        my ( $all, $key ) = ( $1, $2 );
-        $line += ( $all =~ tr/\n/\n/ );
-        $seen{$line}++;
-        unless ( defined $key ) {
-            print "\n" unless $errors++;
-            print "  Couldn't process loc_left_pair at $filename:$line:\n  $key\n";
-            next;
-        }
-        my $interp = (substr($key,0,1) eq '"' ? 1 : 0);
-        $key =~ s/\\(['"\\])/$1/g if $key =~ s/^(['"])(.*)\1$/$2/g; # dequote potentially quoted string
-        push @{ $FILECAT{$key} }, [ $filename, $line, '', $interp ];
-    }
-
-    # Comment-based pair mark: "..." => "..." # loc_pair
-    $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?(?:(\w+|$re_delim)\s*=>\s*($re_delim)[ \{\}\)\],;]*)?$re_loc_pair_suffix)/smgo) {
-        my ( $all, $key, $val ) = ( $1, $2, $10 );
-        $line += ( $all =~ tr/\n/\n/ );
-        $seen{$line}++;
-        unless ( defined $key && defined $val ) {
-            print "\n" unless $errors++;
-            print "  Couldn't process loc_pair at $filename:$line:\n  $key\n  $val\n";
-            next;
-        }
-        my $interp_key = (substr($key,0,1) eq '"' ? 1 : 0);
-        $key =~ s/\\(['"\\])/$1/g if $key =~ s/^(['"])(.*)\1$/$2/g; # dequote potentially quoted string
-        push @{ $FILECAT{$key} }, [ $filename, $line, '', $interp_key ];
-
-        my $interp_val = (substr($val,0,1) eq '"' ? 1 : 0);
-        $val = substr($val, 1, -1);    # dequote always quoted string
-        $val  =~ s/\\(['"\\])/$1/g;
-        push @{ $FILECAT{$val} }, [ $filename, $line, '', $interp_val ];
-    }
-
-    # Specific key  foo => "...", #loc{foo}
-    $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?(\w+|$re_delim)\s*=>\s*($re_delim)(?-s:.*?)\#$re_space_wo_nl*loc\{\2\}$re_space_wo_nl*)$/smgo) {
-        my ( $all, $key, $val ) = ( $1, $2, $10 );
-        $line += ( $all =~ tr/\n/\n/ );
-        $seen{$line}++;
-        unless ( defined $key && defined $val ) {
-            warn "Couldn't process loc_pair at $filename:$line:\n  $key\n  $val\n";
-            next;
-        }
-        $val = substr($val, 1, -1);    # dequote always quoted string
-        $val  =~ s/\\(['"])/$1/g;
-        push @{ $FILECAT{$val} }, [ $filename, $line, '' ];
-    }
-
-    # Check for ones we missed
-    $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*? \# $re_space_wo_nl* (loc (_\w+|\(\)|{$re_delim})?) $re_space_wo_nl* $)/smgox) {
-        my ($all, $loc_type) = ($1, $2);
-        $line += ( $all =~ tr/\n/\n/ );
-        next if $seen{$line};
-        print "\n" unless $errors++;
-        print "  $loc_type that did not match, line $line of $filename\n";
-    }
-
-    if ($errors) {
-        print "\n"
-    } else {
-        print "\r", " " x 100, "\r";
-    }
-
-    close (_);
-}
 
 sub uniq {
     my %seen;
diff --git a/devel/tools/extract-message-catalog b/lib/RT/I18N/Extract.pm
old mode 100755
new mode 100644
similarity index 56%
copy from devel/tools/extract-message-catalog
copy to lib/RT/I18N/Extract.pm
index e1766affe..cd8326f7a
--- a/devel/tools/extract-message-catalog
+++ b/lib/RT/I18N/Extract.pm
@@ -1,4 +1,3 @@
-#!/usr/bin/env perl
 # BEGIN BPS TAGGED BLOCK {{{
 #
 # COPYRIGHT:
@@ -46,101 +45,60 @@
 # those contributions and any derivatives thereof.
 #
 # END BPS TAGGED BLOCK }}}
-# Portions Copyright 2002 Autrijus Tang <autrijus at autrijus.org>
+
+package RT::I18N::Extract;
 
 use strict;
 use warnings;
 
-use open qw/ :std :encoding(UTF-8) /;
-
-use File::Find;
-use File::Copy;
 use Regexp::Common;
-use Carp;
-use Locale::PO;
-$| = 1;
-
-# po dir is for extensions
- at ARGV = (<share/po/*.po>, <share/po/*.pot>, <po/*.po>, <po/*.pot>) unless @ARGV;
-
-our %FILECAT;
-
-# extract all strings and stuff them into %FILECAT
-# scan html dir for extensions
-File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, qw(bin sbin lib share html etc) );
-
-# ensure proper escaping and [_1] => %1 transformation
-foreach my $str ( sort keys %FILECAT ) {
-    my $entry = delete $FILECAT{$str};
-    next unless @{$entry};
-
-    my ($filename, $line) = @{ $entry->[0] };
-    my $location = "$filename line $line" . (@{$entry} > 1 ? " (and ".(@{$entry}-1)." other places)" : "");
-
-    if ($str =~ /^\s/m || $str =~ /\s$/m || $str =~ /\\n$/m) {
-        warn "Extraneous whitespace in '$str' at $location\n";
-    }
-    if (grep {$_->[3]} @{$entry} and $str =~ /([\$\@]\w+)/) {
-        warn "Interpolated variable '$1' in '$str' at $location\n";
-    }
-
-    my $escape = sub { $_ = shift; s/\b_(\d+)/%$1/; $_ };
-    $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
-    $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".$escape->($3).")"/eg;
-    $str =~ s/~([\[\]])/$1/g;
-
-    my $po = Locale::PO->new(-msgid => $str, -msgstr => "");
-    $po->reference( join ( ' ', sort map $_->[0].":".$_->[1], @{ $entry } ) );
-    my %seen;
-    my @vars;
-    foreach my $find ( sort { $a->[2] cmp $b->[2] } grep { $_->[2] } @{ $entry } ) {
-        my ( $file, $line, $var ) = @{$find};
-        $var =~ s/^\s*,\s*//;
-        $var =~ s/\s*$//;
-        push @vars, "($var)" unless $seen{$var}++;
-    }
-    $po->automatic( join( "\n", @vars) );
+use File::Spec;
+use File::Find;
 
-    $FILECAT{$po->msgid} = $po;
+sub new {
+    return bless {filecat => {}}, shift;
 }
 
-# update all language dictionaries
-foreach my $dict (@ARGV) {
-    $dict = "share/po/$dict.pot" if ( $dict eq 'rt' );
-    $dict = "share/po/$dict.po" unless -f $dict or $dict =~ m!/!;
-
-    my $lang = $dict;
-    $lang =~ s|.*/||;
-    $lang =~ s|\.po$||;
-    $lang =~ s|\.pot$||;
-
-    update($lang, $dict);
+sub all {
+    my $self = shift;
+    my $merged = sub { $self->from($File::Find::name) };
+    File::Find::find(
+        { wanted => $merged, no_chdir => 1, follow => 1 },
+        qw(bin sbin lib share html etc),
+    );
+    return $self->results;
 }
 
-sub extract_strings_from_code {
-    my $file = $_;
+sub from {
+    my $self = shift;
+    my ($file) = (@_);
 
     local $/;
-    return if ( -d $_ || !-e _ );
+    return if ( -d $file || !-e _ );
+
+    my (undef, $dir, $file_only) = File::Spec->splitpath($file);
+    local $_ = $file_only;
     return
-      if ( $File::Find::dir =~
+      if ( $dir =~
         qr!lib/blib|lib/t/autogen|var|m4|local|share/fonts! );
     return if ( /\.(?:pot|po|bak|gif|png|psd|jpe?g|svg|css|js)$/ );
     return if ( /~|,D|,B$|extract-message-catalog$|tweak-template-locstring$/ );
     return if ( /StyleGuide.pod/ );
     return if ( /^[\.#]/ );
-    return if ( -f "$_.in" );
+    return if ( -f "$file.in" );
+    return if $file eq "lib/RT/I18N/Extract.pm";
 
-    print "Looking at $File::Find::name";
-    my $filename = $File::Find::name;
-    $filename =~ s'^\./'';
-    $filename =~ s'\.in$'';
+    my $normalized = $file;
+    $normalized =~ s'^\./'';
+    $normalized =~ s'\.in$'';
+    print "Looking at $normalized";
 
     unless (open _, '<', $file) {
         print "\n  Cannot open $file for reading ($!), skipping.\n\n";
         return;
     }
 
+    my %FILECAT = %{$self->{filecat}};
     my $errors = 0;
 
     my $re_space_wo_nl = qr{(?!\n)\s};
@@ -160,7 +118,7 @@ sub extract_strings_from_code {
         $vars =~ s/[\n\r]//g;
         $line += ( $all =~ tr/\n/\n/ );
         $str =~ s/\\(['"\\])/$1/g;
-        push @{ $FILECAT{$str} }, [ $filename, $line, $vars ];
+        push @{ $FILECAT{$str} }, [ $normalized, $line, $vars ];
     }
 
     # Localization function: loc(...)
@@ -180,7 +138,7 @@ sub extract_strings_from_code {
         $vars =~ s/[\n\r]//g;
         $str  =~ s/\\(['"\\])/$1/g;
 
-        push @{ $FILECAT{$str} }, [ $filename, $line, $vars, $interp ];
+        push @{ $FILECAT{$str} }, [ $normalized, $line, $vars, $interp ];
     }
 
     my %seen;
@@ -193,13 +151,13 @@ sub extract_strings_from_code {
         $seen{$line}++;
         unless ( defined $str ) {
             print "\n" unless $errors++;
-            print "  Couldn't process loc at $filename:$line:\n  $str\n";
+            print "  Couldn't process loc at $normalized:$line:\n  $str\n";
             next;
         }
         my $interp = (substr($str,0,1) eq '"' ? 1 : 0);
         $str = substr($str, 1, -1);
         $str =~ s/\\(['"\\])/$1/g;
-        push @{ $FILECAT{$str} }, [ $filename, $line, '', $interp ];
+        push @{ $FILECAT{$str} }, [ $normalized, $line, '', $interp ];
     }
 
     # Comment-based mark for list to loc():  ("...", $foo, $bar)  # loc()
@@ -225,7 +183,7 @@ sub extract_strings_from_code {
         $vars =~ s/[\n\r]//g;
         $str  =~ s/\\(['"\\])/$1/g;
 
-        push @{ $FILECAT{$str} }, [ $filename, $line, $vars, $interp ];
+        push @{ $FILECAT{$str} }, [ $normalized, $line, $vars, $interp ];
     }
 
     # Comment-based qw mark: "qw(...)" # loc_qw
@@ -237,11 +195,11 @@ sub extract_strings_from_code {
         $seen{$line}++;
         unless ( defined $str ) {
             print "\n" unless $errors++;
-            print "  Couldn't process loc_qw at $filename:$line:\n  $str\n";
+            print "  Couldn't process loc_qw at $normalized:$line:\n  $str\n";
             next;
         }
         foreach my $value (split ' ', $str) {
-            push @{ $FILECAT{$value} }, [ $filename, $line, '' ];
+            push @{ $FILECAT{$value} }, [ $normalized, $line, '' ];
         }
     }
 
@@ -254,12 +212,12 @@ sub extract_strings_from_code {
         $seen{$line}++;
         unless ( defined $key ) {
             print "\n" unless $errors++;
-            print "  Couldn't process loc_left_pair at $filename:$line:\n  $key\n";
+            print "  Couldn't process loc_left_pair at $normalized:$line:\n  $key\n";
             next;
         }
         my $interp = (substr($key,0,1) eq '"' ? 1 : 0);
         $key =~ s/\\(['"\\])/$1/g if $key =~ s/^(['"])(.*)\1$/$2/g; # dequote potentially quoted string
-        push @{ $FILECAT{$key} }, [ $filename, $line, '', $interp ];
+        push @{ $FILECAT{$key} }, [ $normalized, $line, '', $interp ];
     }
 
     # Comment-based pair mark: "..." => "..." # loc_pair
@@ -271,17 +229,17 @@ sub extract_strings_from_code {
         $seen{$line}++;
         unless ( defined $key && defined $val ) {
             print "\n" unless $errors++;
-            print "  Couldn't process loc_pair at $filename:$line:\n  $key\n  $val\n";
+            print "  Couldn't process loc_pair at $normalized:$line:\n  $key\n  $val\n";
             next;
         }
         my $interp_key = (substr($key,0,1) eq '"' ? 1 : 0);
         $key =~ s/\\(['"\\])/$1/g if $key =~ s/^(['"])(.*)\1$/$2/g; # dequote potentially quoted string
-        push @{ $FILECAT{$key} }, [ $filename, $line, '', $interp_key ];
+        push @{ $FILECAT{$key} }, [ $normalized, $line, '', $interp_key ];
 
         my $interp_val = (substr($val,0,1) eq '"' ? 1 : 0);
         $val = substr($val, 1, -1);    # dequote always quoted string
         $val  =~ s/\\(['"\\])/$1/g;
-        push @{ $FILECAT{$val} }, [ $filename, $line, '', $interp_val ];
+        push @{ $FILECAT{$val} }, [ $normalized, $line, '', $interp_val ];
     }
 
     # Specific key  foo => "...", #loc{foo}
@@ -292,12 +250,12 @@ sub extract_strings_from_code {
         $line += ( $all =~ tr/\n/\n/ );
         $seen{$line}++;
         unless ( defined $key && defined $val ) {
-            warn "Couldn't process loc_pair at $filename:$line:\n  $key\n  $val\n";
+            warn "Couldn't process loc_pair at $normalized:$line:\n  $key\n  $val\n";
             next;
         }
         $val = substr($val, 1, -1);    # dequote always quoted string
         $val  =~ s/\\(['"])/$1/g;
-        push @{ $FILECAT{$val} }, [ $filename, $line, '' ];
+        push @{ $FILECAT{$val} }, [ $normalized, $line, '' ];
     }
 
     # Check for ones we missed
@@ -308,7 +266,7 @@ sub extract_strings_from_code {
         $line += ( $all =~ tr/\n/\n/ );
         next if $seen{$line};
         print "\n" unless $errors++;
-        print "  $loc_type that did not match, line $line of $filename\n";
+        print "  $loc_type that did not match, line $line of $normalized\n";
     }
 
     if ($errors) {
@@ -318,97 +276,13 @@ sub extract_strings_from_code {
     }
 
     close (_);
-}
 
-sub uniq {
-    my %seen;
-    return grep { !$seen{$_}++ } @_;
+    $self->{filecat} = \%FILECAT;
 }
 
-sub update {
-    my $lang = shift;
-    my $file = shift;
-
-    unless (!-e $file or -w $file) {
-        warn "Can't write to $lang, skipping...\n";
-        return;
-    }
-
-    my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ );
-
-    print "Updating $lang";
-    my $lexicon = Locale::PO->load_file_ashash( $file, "utf-8" );
-
-    # Default to the empty string for new ones
-    $lexicon->{$_->msgid} ||= $_
-        for values %FILECAT;
-
-    my $errors = 0;
-    for my $msgid ( keys %{$lexicon} ) {
-        my $entry = $lexicon->{$msgid};
-
-        # Don't output empty translations for english
-        if (not length $entry->dequote($entry->msgstr) and $is_english) {
-            delete $lexicon->{$msgid};
-            next;
-        }
-
-        # The PO properties at the top are always fine to leave as-is
-        next if not length $entry->dequote($msgid);
-
-        # Not found in source?  Drop it
-        my $source = $FILECAT{$msgid};
-        if (not $source) {
-            delete $lexicon->{$msgid};
-            next;
-        }
-
-        # Pull in the properties from the source
-        $entry->reference( $source->reference );
-        $entry->automatic( $source->automatic );
-
-        my $fail = validate_msgstr($lang,
-                                   map {$entry->dequote($_)}
-                                       $entry->msgid, $entry->msgstr);
-        next unless $fail;
-        print "\n" unless $errors++;
-        print $fail;
-    }
-
-    my @order = map {$_->[0]}
-                sort {$a->[1] cmp $b->[1]}
-                map {[$_, $_->dequote($_->msgid)]}
-                values %{$lexicon};
-
-    Locale::PO->save_file_fromarray($file, \@order, "utf-8")
-          or die "Couldn't update '$file': $!";
-
-    if ($errors) {
-        print "\n";
-    } else {
-        print "\r", " "x100, "\r";
-    }
-    return 1;
+sub results {
+    my $self = shift;
+    return %{$self->{filecat}};
 }
 
-sub validate_msgstr {
-    my $lang   = shift;
-    my $msgid  = shift;
-    my $msgstr = shift;
-
-    return if not defined $msgstr or $msgstr eq ''; # no translation for this string
-
-    # we uniq because a string can use a placeholder more than once
-    # (eg %1 %quant(%1, ...) like in our czech localization
-    my @expected_variables = uniq($msgid =~ /%\d+/g);
-    my @got_variables = uniq($msgstr =~ /%\d+/g);
-
-    # this catches the case where expected uses %1,%2 and got uses %1,%3
-    # unlike a simple @expected_variables == @got_variables
-    my $expected = join ", ", sort @expected_variables;
-    my $got      = join ", ", sort @got_variables;
-    return if $expected eq $got;
-
-    return "  expected (" . $expected . ") in msgid: $msgid\n" .
-           "       got (" . $got      . ") in msgstr: $msgstr\n";
-}
+1;

commit 2c929112fca712fa71f56d2b3c131241baf3bfcc
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 22:59:28 2016 -0700

    Remove unused dependencies
    
    File::Copy was introduced in 7cd79f2b, in the first version of
    extract-message-catalog, and no functions from File::Copy were used
    even at that time.
    
    The same holds true for the introduction of Carp in 5a89bf9d.

diff --git a/devel/tools/extract-message-catalog b/devel/tools/extract-message-catalog
index a8f511237..9751506cc 100755
--- a/devel/tools/extract-message-catalog
+++ b/devel/tools/extract-message-catalog
@@ -53,8 +53,6 @@ use warnings;
 
 use open qw/ :std :encoding(UTF-8) /;
 
-use File::Copy;
-use Carp;
 use Locale::PO;
 
 use lib 'lib';

commit 5032832f866c1723d7b71147e201edccb3852c58
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 03:24:13 2016 -0700

    Simplify file skipping
    
    The movement of static resources into their own top-level directory
    allows this logic to be simplified significantly -- especially when
    combined with a fair number of "no longer relevant"s.
    
    Changes must be made with an eye toward allowing this tool to be run
    from within RT extensions, as well as RT itself (hence the inclusion
    of any top-level `html` directory, for instance).
    
    The following exceptions have been removed:
    
     - `lib/blib`: Nesting blib under lib is wrong, and doesn't happen
     - `lib/t/autogen`: Has never been relevant in core RT
     - `var`, `m4`, `local`: We skip these at the top level
     - `share/fonts`: Made unnecessary by limiting to `share/html`
     - `pot|po|gif|png|psd|jpe?g|svg|css|js`: Most of these exceptions
       came from static resouces or `share/po`, which are now skipped by
       limiting to `share/html`.  If any files matching these exist under
       `share/html`, they contain Mason code, so should be examined.
     - `,D` and `,B$`: Introduced in 5a89bf9d without comment; presumably
       editor cruft?
     - `extract-message-catalog`, `tweak-template-locstring`: Now live
       under `devel` so are exempt.

diff --git a/lib/RT/I18N/Extract.pm b/lib/RT/I18N/Extract.pm
index cd8326f7a..eaba864cd 100644
--- a/lib/RT/I18N/Extract.pm
+++ b/lib/RT/I18N/Extract.pm
@@ -64,29 +64,30 @@ sub all {
     my $merged = sub { $self->from($File::Find::name) };
     File::Find::find(
         { wanted => $merged, no_chdir => 1, follow => 1 },
-        qw(bin sbin lib share html etc),
+        grep {-d $_} qw(bin sbin lib share/html html etc),
     );
     return $self->results;
 }
 
+sub valid_to_extract {
+    my $self = shift;
+    my ($file) = @_;
+
+    return unless -f $file;
+    return if $file eq "lib/RT/StyleGuide.pod";
+    return if $file eq "lib/RT/I18N/Extract.pm";
+    return if $file =~ m{/[\.#][^/]*$} or $file =~ /\.bak$/;
+    return if -f "$file.in";
+    return 1;
+}
+
 sub from {
     my $self = shift;
     my ($file) = (@_);
 
     local $/;
-    return if ( -d $file || !-e _ );
-
-    my (undef, $dir, $file_only) = File::Spec->splitpath($file);
-    local $_ = $file_only;
-    return
-      if ( $dir =~
-        qr!lib/blib|lib/t/autogen|var|m4|local|share/fonts! );
-    return if ( /\.(?:pot|po|bak|gif|png|psd|jpe?g|svg|css|js)$/ );
-    return if ( /~|,D|,B$|extract-message-catalog$|tweak-template-locstring$/ );
-    return if ( /StyleGuide.pod/ );
-    return if ( /^[\.#]/ );
-    return if ( -f "$file.in" );
-    return if $file eq "lib/RT/I18N/Extract.pm";
+
+    return unless $self->valid_to_extract($file);
 
     my $normalized = $file;
     $normalized =~ s'^\./'';

commit 9f59d1a305199078d1fb7f191ad95cbfdc1c6f60
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 03:34:57 2016 -0700

    Remove use of $_ and _

diff --git a/lib/RT/I18N/Extract.pm b/lib/RT/I18N/Extract.pm
index eaba864cd..a97b5c9dc 100644
--- a/lib/RT/I18N/Extract.pm
+++ b/lib/RT/I18N/Extract.pm
@@ -85,8 +85,6 @@ sub from {
     my $self = shift;
     my ($file) = (@_);
 
-    local $/;
-
     return unless $self->valid_to_extract($file);
 
     my $normalized = $file;
@@ -94,10 +92,13 @@ sub from {
     $normalized =~ s'\.in$'';
     print "Looking at $normalized";
 
-    unless (open _, '<', $file) {
+    my $fh;
+    unless (open $fh, '<', $file) {
         print "\n  Cannot open $file for reading ($!), skipping.\n\n";
         return;
     }
+    my $contents = do { local $/; <$fh> };
+    close $fh;
 
     my %FILECAT = %{$self->{filecat}};
     my $errors = 0;
@@ -110,11 +111,10 @@ sub from {
     my $re_loc_left_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_left_pair $re_space_wo_nl* $}mx;
     my $re_delim = $RE{delimited}{-delim=>q{'"}}{-keep};
 
-    $_ = <_>;
 
-    # Mason filter: <&|/l>...</&> and <&|/l_unsafe>...</&>
+    # Mason filter: <&|/l&>...</&> and <&|/l_unsafe&>...</&>
     my $line = 1;
-    while (m!\G(.*?<&\|/l(?:_unsafe)?(.*?)&>(.*?)</&>)!sg) {
+    while ($contents =~ m!\G(.*?<&\|/l(?:_unsafe)?(.*?)&>(.*?)</&>)!sg) {
         my ( $all, $vars, $str ) = ( $1, $2, $3 );
         $vars =~ s/[\n\r]//g;
         $line += ( $all =~ tr/\n/\n/ );
@@ -124,8 +124,8 @@ sub from {
 
     # Localization function: loc(...)
     $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?\bloc$RE{balanced}{-parens=>'()'}{-keep})/sg) {
+    pos($contents) = 0;
+    while ($contents =~ m/\G(.*?\bloc$RE{balanced}{-parens=>'()'}{-keep})/sg) {
         my ( $all, $match ) = ( $1, $2 );
         $line += ( $all =~ tr/\n/\n/ );
 
@@ -145,8 +145,8 @@ sub from {
     my %seen;
     # Comment-based mark: "..." # loc
     $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?($re_delim)[ \{\}\)\],;]*$re_loc_suffix)/smgo) {
+    pos($contents) = 0;
+    while ($contents =~ m/\G(.*?($re_delim)[ \{\}\)\],;]*$re_loc_suffix)/smgo) {
         my ( $all, $str ) = ( $1, $2 );
         $line += ( $all =~ tr/\n/\n/ );
         $seen{$line}++;
@@ -163,8 +163,8 @@ sub from {
 
     # Comment-based mark for list to loc():  ("...", $foo, $bar)  # loc()
     $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*? $RE{balanced}{-parens=>'()'}{-keep} [ \{\}\)\],;]* $re_loc_paren_suffix)/sgx) {
+    pos($contents) = 0;
+    while ($contents =~ m/\G(.*? $RE{balanced}{-parens=>'()'}{-keep} [ \{\}\)\],;]* $re_loc_paren_suffix)/sgx) {
         my ( $all, $match ) = ( $1, $2 );
         $line += ( $all =~ tr/\n/\n/ );
 
@@ -189,8 +189,8 @@ sub from {
 
     # Comment-based qw mark: "qw(...)" # loc_qw
     $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?(?:qw\(([^)]+)\)[ \{\}\)\],;]*)?$re_loc_qw_suffix)/smgo) {
+    pos($contents) = 0;
+    while ($contents =~ m/\G(.*?(?:qw\(([^)]+)\)[ \{\}\)\],;]*)?$re_loc_qw_suffix)/smgo) {
         my ( $all, $str ) = ( $1, $2 );
         $line += ( $all =~ tr/\n/\n/ );
         $seen{$line}++;
@@ -206,8 +206,8 @@ sub from {
 
     # Comment-based left pair mark: "..." => ... # loc_left_pair
     $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?(?:(\w+|$re_delim)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix)/smgo) {
+    pos($contents) = 0;
+    while ($contents =~ m/\G(.*?(?:(\w+|$re_delim)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix)/smgo) {
         my ( $all, $key ) = ( $1, $2 );
         $line += ( $all =~ tr/\n/\n/ );
         $seen{$line}++;
@@ -223,8 +223,8 @@ sub from {
 
     # Comment-based pair mark: "..." => "..." # loc_pair
     $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?(?:(\w+|$re_delim)\s*=>\s*($re_delim)[ \{\}\)\],;]*)?$re_loc_pair_suffix)/smgo) {
+    pos($contents) = 0;
+    while ($contents =~ m/\G(.*?(?:(\w+|$re_delim)\s*=>\s*($re_delim)[ \{\}\)\],;]*)?$re_loc_pair_suffix)/smgo) {
         my ( $all, $key, $val ) = ( $1, $2, $10 );
         $line += ( $all =~ tr/\n/\n/ );
         $seen{$line}++;
@@ -245,8 +245,8 @@ sub from {
 
     # Specific key  foo => "...", #loc{foo}
     $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*?(\w+|$re_delim)\s*=>\s*($re_delim)(?-s:.*?)\#$re_space_wo_nl*loc\{\2\}$re_space_wo_nl*)$/smgo) {
+    pos($contents) = 0;
+    while ($contents =~ m/\G(.*?(\w+|$re_delim)\s*=>\s*($re_delim)(?-s:.*?)\#$re_space_wo_nl*loc\{\2\}$re_space_wo_nl*)$/smgo) {
         my ( $all, $key, $val ) = ( $1, $2, $10 );
         $line += ( $all =~ tr/\n/\n/ );
         $seen{$line}++;
@@ -261,8 +261,8 @@ sub from {
 
     # Check for ones we missed
     $line = 1;
-    pos($_) = 0;
-    while (m/\G(.*? \# $re_space_wo_nl* (loc (_\w+|\(\)|{$re_delim})?) $re_space_wo_nl* $)/smgox) {
+    pos($contents) = 0;
+    while ($contents =~ m/\G(.*? \# $re_space_wo_nl* (loc (_\w+|\(\)|{$re_delim})?) $re_space_wo_nl* $)/smgox) {
         my ($all, $loc_type) = ($1, $2);
         $line += ( $all =~ tr/\n/\n/ );
         next if $seen{$line};
@@ -276,8 +276,6 @@ sub from {
         print "\r", " " x 100, "\r";
     }
 
-    close (_);
-
     $self->{filecat} = \%FILECAT;
 }
 

commit ff5b55a19f80edc287435e2cf062deaf1dab0fcb
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 05:06:56 2016 -0700

    Refactor all extraction loops
    
    This takes the common pattern of a while loop, optional dequoting of
    values, and addition of the value to the list, and refactors them into
    closures.  In doing so, it became apparent that the <&|/l&> form was
    de-escaping when it should not have been; this has been fixed, though
    it does not affect any existing locstrings.
    
    There is no change to the extracted .pot file by this refactoring.

diff --git a/lib/RT/I18N/Extract.pm b/lib/RT/I18N/Extract.pm
index a97b5c9dc..2c7c1023f 100644
--- a/lib/RT/I18N/Extract.pm
+++ b/lib/RT/I18N/Extract.pm
@@ -111,164 +111,88 @@ sub from {
     my $re_loc_left_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_left_pair $re_space_wo_nl* $}mx;
     my $re_delim = $RE{delimited}{-delim=>q{'"}}{-keep};
 
+    my %seen;
+    my $line;
 
-    # Mason filter: <&|/l&>...</&> and <&|/l_unsafe&>...</&>
-    my $line = 1;
-    while ($contents =~ m!\G(.*?<&\|/l(?:_unsafe)?(.*?)&>(.*?)</&>)!sg) {
-        my ( $all, $vars, $str ) = ( $1, $2, $3 );
-        $vars =~ s/[\n\r]//g;
-        $line += ( $all =~ tr/\n/\n/ );
-        $str =~ s/\\(['"\\])/$1/g;
-        push @{ $FILECAT{$str} }, [ $normalized, $line, $vars ];
-    }
+    my $_add = sub {
+        my ($maybe_quoted, $key, $vars) = @_;
+        $vars = '' unless defined $vars;
 
-    # Localization function: loc(...)
-    $line = 1;
-    pos($contents) = 0;
-    while ($contents =~ m/\G(.*?\bloc$RE{balanced}{-parens=>'()'}{-keep})/sg) {
-        my ( $all, $match ) = ( $1, $2 );
-        $line += ( $all =~ tr/\n/\n/ );
+        $seen{$line}++;
 
-        my ( $vars, $str );
-        next unless ( $match =~ /\(\s*($re_delim)(.*?)\s*\)$/so );
+        my $interp;
+        if ($maybe_quoted and $key =~ s/^(['"])(.*)\1$/$2/) {
+            $interp = 1 if $1 eq '"';
+            $key =~ s/\\(['"\\])/$1/g;
+        }
 
-        my $interp = (substr($1,0,1) eq '"' ? 1 : 0);
-        $str = substr( $1, 1, -1 );       # $str comes before $vars now
-        $vars = $9;
+        $vars =~ tr/\n\r//d;
+
+        push @{ $FILECAT{$key} }, [ $normalized, $line, $vars, $interp ];
+    };
+    my $add = sub {$_add->(1, @_)};
+    my $add_noquotes = sub {$_add->(0, @_)};
+
+    my $extract = sub {
+        my ($regex, $run) = @_;
+        $line = 1;
+        pos($contents) = 0;
+        while ($contents =~ m!\G.*?$regex!sg) {
+            my $match = substr($contents,$-[0],$+[0]-$-[0]);
+            $line += ( $match =~ tr/\n/\n/ );
+            $run->();
+        }
+    };
 
-        $vars =~ s/[\n\r]//g;
-        $str  =~ s/\\(['"\\])/$1/g;
+    # Mason filter: <&|/l&>...</&> and <&|/l_unsafe&>...</&>
+    $extract->(qr!<&\|/l(?:_unsafe)?(.*?)&>(.*?)</&>!so, sub {
+        $add_noquotes->($2, $1);
+    });
 
-        push @{ $FILECAT{$str} }, [ $normalized, $line, $vars, $interp ];
-    }
+    # Localization function: loc(...)
+    $extract->(qr/\bloc$RE{balanced}{-parens=>'()'}{-keep}/so, sub {
+        return unless "$1" =~ /\(\s*($re_delim)(.*?)\s*\)$/so;
+        $add->($1, $9);
+    });
 
-    my %seen;
     # Comment-based mark: "..." # loc
-    $line = 1;
-    pos($contents) = 0;
-    while ($contents =~ m/\G(.*?($re_delim)[ \{\}\)\],;]*$re_loc_suffix)/smgo) {
-        my ( $all, $str ) = ( $1, $2 );
-        $line += ( $all =~ tr/\n/\n/ );
-        $seen{$line}++;
-        unless ( defined $str ) {
-            print "\n" unless $errors++;
-            print "  Couldn't process loc at $normalized:$line:\n  $str\n";
-            next;
-        }
-        my $interp = (substr($str,0,1) eq '"' ? 1 : 0);
-        $str = substr($str, 1, -1);
-        $str =~ s/\\(['"\\])/$1/g;
-        push @{ $FILECAT{$str} }, [ $normalized, $line, '', $interp ];
-    }
+    $extract->(qr/($re_delim)[ \{\}\)\],;]*$re_loc_suffix/smo, sub {
+        $add->($1);
+    });
 
     # Comment-based mark for list to loc():  ("...", $foo, $bar)  # loc()
-    $line = 1;
-    pos($contents) = 0;
-    while ($contents =~ m/\G(.*? $RE{balanced}{-parens=>'()'}{-keep} [ \{\}\)\],;]* $re_loc_paren_suffix)/sgx) {
-        my ( $all, $match ) = ( $1, $2 );
-        $line += ( $all =~ tr/\n/\n/ );
-
-        my ( $vars, $str );
-        unless ( $match =~
-                /\(\s*($re_delim)(.*?)\s*\)$/so ) {
-            print "\n" unless $errors++;
-            print "  Failed to match delimited against $match, line $line";
-            next;
-        }
-
-        my $interp = (substr($1,0,1) eq '"' ? 1 : 0);
-        $str = substr( $1, 1, -1 );       # $str comes before $vars now
-        $vars = $9;
-        $seen{$line}++;
-
-        $vars =~ s/[\n\r]//g;
-        $str  =~ s/\\(['"\\])/$1/g;
-
-        push @{ $FILECAT{$str} }, [ $normalized, $line, $vars, $interp ];
-    }
+    $extract->(qr/$RE{balanced}{-parens=>'()'}{-keep} [ \{\}\)\],;]* $re_loc_paren_suffix/sox, sub {
+        return unless "$1" =~ /\(\s*($re_delim)(.*?)\s*\)$/so;
+        $add->($1, $9);
+    });
 
     # Comment-based qw mark: "qw(...)" # loc_qw
-    $line = 1;
-    pos($contents) = 0;
-    while ($contents =~ m/\G(.*?(?:qw\(([^)]+)\)[ \{\}\)\],;]*)?$re_loc_qw_suffix)/smgo) {
-        my ( $all, $str ) = ( $1, $2 );
-        $line += ( $all =~ tr/\n/\n/ );
-        $seen{$line}++;
-        unless ( defined $str ) {
-            print "\n" unless $errors++;
-            print "  Couldn't process loc_qw at $normalized:$line:\n  $str\n";
-            next;
-        }
-        foreach my $value (split ' ', $str) {
-            push @{ $FILECAT{$value} }, [ $normalized, $line, '' ];
-        }
-    }
+    $extract->(qr/(?:qw\(([^)]+)\)[ \{\}\)\],;]*)?$re_loc_qw_suffix/smo, sub {
+        $add_noquotes->($_) for split ' ', $1;
+    });
 
     # Comment-based left pair mark: "..." => ... # loc_left_pair
-    $line = 1;
-    pos($contents) = 0;
-    while ($contents =~ m/\G(.*?(?:(\w+|$re_delim)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix)/smgo) {
-        my ( $all, $key ) = ( $1, $2 );
-        $line += ( $all =~ tr/\n/\n/ );
-        $seen{$line}++;
-        unless ( defined $key ) {
-            print "\n" unless $errors++;
-            print "  Couldn't process loc_left_pair at $normalized:$line:\n  $key\n";
-            next;
-        }
-        my $interp = (substr($key,0,1) eq '"' ? 1 : 0);
-        $key =~ s/\\(['"\\])/$1/g if $key =~ s/^(['"])(.*)\1$/$2/g; # dequote potentially quoted string
-        push @{ $FILECAT{$key} }, [ $normalized, $line, '', $interp ];
-    }
+    $extract->(qr/(?:(\w+|$re_delim)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix/smo, sub {
+        $add->($1);
+    });
 
     # Comment-based pair mark: "..." => "..." # loc_pair
-    $line = 1;
-    pos($contents) = 0;
-    while ($contents =~ m/\G(.*?(?:(\w+|$re_delim)\s*=>\s*($re_delim)[ \{\}\)\],;]*)?$re_loc_pair_suffix)/smgo) {
-        my ( $all, $key, $val ) = ( $1, $2, $10 );
-        $line += ( $all =~ tr/\n/\n/ );
-        $seen{$line}++;
-        unless ( defined $key && defined $val ) {
-            print "\n" unless $errors++;
-            print "  Couldn't process loc_pair at $normalized:$line:\n  $key\n  $val\n";
-            next;
-        }
-        my $interp_key = (substr($key,0,1) eq '"' ? 1 : 0);
-        $key =~ s/\\(['"\\])/$1/g if $key =~ s/^(['"])(.*)\1$/$2/g; # dequote potentially quoted string
-        push @{ $FILECAT{$key} }, [ $normalized, $line, '', $interp_key ];
-
-        my $interp_val = (substr($val,0,1) eq '"' ? 1 : 0);
-        $val = substr($val, 1, -1);    # dequote always quoted string
-        $val  =~ s/\\(['"\\])/$1/g;
-        push @{ $FILECAT{$val} }, [ $normalized, $line, '', $interp_val ];
-    }
+    $extract->(qr/(?:(\w+|$re_delim)\s*=>\s*($re_delim)[ \{\}\)\],;]*)?$re_loc_pair_suffix/smo, sub {
+        $add->($1);
+        $add->($9);
+    });
 
     # Specific key  foo => "...", #loc{foo}
-    $line = 1;
-    pos($contents) = 0;
-    while ($contents =~ m/\G(.*?(\w+|$re_delim)\s*=>\s*($re_delim)(?-s:.*?)\#$re_space_wo_nl*loc\{\2\}$re_space_wo_nl*)$/smgo) {
-        my ( $all, $key, $val ) = ( $1, $2, $10 );
-        $line += ( $all =~ tr/\n/\n/ );
-        $seen{$line}++;
-        unless ( defined $key && defined $val ) {
-            warn "Couldn't process loc_pair at $normalized:$line:\n  $key\n  $val\n";
-            next;
-        }
-        $val = substr($val, 1, -1);    # dequote always quoted string
-        $val  =~ s/\\(['"])/$1/g;
-        push @{ $FILECAT{$val} }, [ $normalized, $line, '' ];
-    }
+    $extract->(qr/(\w+|$re_delim)\s*=>\s*($re_delim)(?-s:.*?)\#$re_space_wo_nl*loc\{\1\}$re_space_wo_nl*$/smo, sub {
+        $add->($9);
+    });
 
     # Check for ones we missed
-    $line = 1;
-    pos($contents) = 0;
-    while ($contents =~ m/\G(.*? \# $re_space_wo_nl* (loc (_\w+|\(\)|{$re_delim})?) $re_space_wo_nl* $)/smgox) {
-        my ($all, $loc_type) = ($1, $2);
-        $line += ( $all =~ tr/\n/\n/ );
-        next if $seen{$line};
+    $extract->(qr/\# $re_space_wo_nl* (loc (_\w+|\(\)|{$re_delim})?) $re_space_wo_nl* $/smox, sub {
+        return if $seen{$line};
         print "\n" unless $errors++;
-        print "  $loc_type that did not match, line $line of $normalized\n";
-    }
+        print "  $1 that did not match, line $line of $normalized\n";
+    });
 
     if ($errors) {
         print "\n"

commit 3ae12fb130ec642d0de59fbeb11c3228b6979fb5
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 22:08:01 2016 -0700

    Inline `$re_` vars, and expand using /x to improve readability

diff --git a/lib/RT/I18N/Extract.pm b/lib/RT/I18N/Extract.pm
index 2c7c1023f..cf8f910b8 100644
--- a/lib/RT/I18N/Extract.pm
+++ b/lib/RT/I18N/Extract.pm
@@ -103,13 +103,6 @@ sub from {
     my %FILECAT = %{$self->{filecat}};
     my $errors = 0;
 
-    my $re_space_wo_nl = qr{(?!\n)\s};
-    my $re_loc_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc $re_space_wo_nl* $}mx;
-    my $re_loc_qw_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_qw $re_space_wo_nl* $}mx;
-    my $re_loc_paren_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc \(\) $re_space_wo_nl* $}mx;
-    my $re_loc_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_pair $re_space_wo_nl* $}mx;
-    my $re_loc_left_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_left_pair $re_space_wo_nl* $}mx;
-    my $re_delim = $RE{delimited}{-delim=>q{'"}}{-keep};
 
     my %seen;
     my $line;
@@ -144,51 +137,90 @@ sub from {
         }
     };
 
+    my $ws = qr{[ ]*};
+    my $punct = qr{[ \{\}\)\],;]*};
+    my $re_delim = $RE{delimited}{-delim=>q{'"}}{-keep};
+
     # Mason filter: <&|/l&>...</&> and <&|/l_unsafe&>...</&>
-    $extract->(qr!<&\|/l(?:_unsafe)?(.*?)&>(.*?)</&>!so, sub {
+    $extract->(qr! <&\|/l(?:_unsafe)?(.*?)&>  (.*?)  </&> !sox, sub {
         $add_noquotes->($2, $1);
     });
 
     # Localization function: loc(...)
-    $extract->(qr/\bloc$RE{balanced}{-parens=>'()'}{-keep}/so, sub {
-        return unless "$1" =~ /\(\s*($re_delim)(.*?)\s*\)$/so;
+    $extract->(qr! \b loc
+                   $RE{balanced}{-parens=>'()'}{-keep}
+                 !sox, sub {
+        # Re-parse what was in the parens for the string and optional arguments
+        return unless "$1" =~ m! \( \s* ($re_delim)  (.*?) \s* \) $ !sox;
         $add->($1, $9);
     });
 
     # Comment-based mark: "..." # loc
-    $extract->(qr/($re_delim)[ \{\}\)\],;]*$re_loc_suffix/smo, sub {
+    $extract->(qr! ($re_delim)      # Quoted string
+                   $punct
+                   $ws \# $ws loc
+                   $ws $
+                 !smox, sub {
         $add->($1);
     });
 
     # Comment-based mark for list to loc():  ("...", $foo, $bar)  # loc()
-    $extract->(qr/$RE{balanced}{-parens=>'()'}{-keep} [ \{\}\)\],;]* $re_loc_paren_suffix/sox, sub {
-        return unless "$1" =~ /\(\s*($re_delim)(.*?)\s*\)$/so;
+    $extract->(qr! $RE{balanced}{-parens=>'()'}{-keep}
+                   $punct
+                   $ws \# $ws loc \(\)
+                   $ws $
+                 !smox, sub {
+        # Re-parse what was in the parens for the string and optional arguments
+        return unless "$1" =~ m! \( \s* ($re_delim)  (.*?) \s* \) $ !sox;
         $add->($1, $9);
     });
 
     # Comment-based qw mark: "qw(...)" # loc_qw
-    $extract->(qr/(?:qw\(([^)]+)\)[ \{\}\)\],;]*)?$re_loc_qw_suffix/smo, sub {
+    $extract->(qr! qw \( ([^)]+) \)
+                   $punct
+                   $ws \# $ws loc_qw
+                   $ws $
+                 !smox, sub {
         $add_noquotes->($_) for split ' ', $1;
     });
 
     # Comment-based left pair mark: "..." => ... # loc_left_pair
-    $extract->(qr/(?:(\w+|$re_delim)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix/smo, sub {
+    $extract->(qr! (\w+|$re_delim)
+                   \s* => [^#\n]+?
+                   $ws \# $ws loc_left_pair
+                   $ws $
+                 !smox, sub {
         $add->($1);
     });
 
     # Comment-based pair mark: "..." => "..." # loc_pair
-    $extract->(qr/(?:(\w+|$re_delim)\s*=>\s*($re_delim)[ \{\}\)\],;]*)?$re_loc_pair_suffix/smo, sub {
+    $extract->(qr! (\w+|$re_delim)
+                   \s* => \s* ($re_delim)
+                   $punct
+                   $ws \# $ws loc_pair
+                   $ws $
+                 !smox, sub {
         $add->($1);
         $add->($9);
     });
 
     # Specific key  foo => "...", #loc{foo}
-    $extract->(qr/(\w+|$re_delim)\s*=>\s*($re_delim)(?-s:.*?)\#$re_space_wo_nl*loc\{\1\}$re_space_wo_nl*$/smo, sub {
+    $extract->(qr! (\w+|$re_delim)
+                   \s* => \s* ($re_delim)
+                   (?-s: .*? ) \# $ws loc\{\1\}  # More lax about what matches before the #
+                   $ws $
+                 !smox, sub {
         $add->($9);
     });
 
     # Check for ones we missed
-    $extract->(qr/\# $re_space_wo_nl* (loc (_\w+|\(\)|{$re_delim})?) $re_space_wo_nl* $/smox, sub {
+    $extract->(qr! \# $ws
+                   (
+                     loc
+                     ( _\w+ | \(\) | {$re_delim} )?
+                   )
+                   $ws $
+                 !smox, sub {
         return if $seen{$line};
         print "\n" unless $errors++;
         print "  $1 that did not match, line $line of $normalized\n";

commit 091de14bae18b8df1866ba5af061cfae8a3585b4
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 22:19:13 2016 -0700

    Simplify $1..$9 vars by removing extraneous `-keep` usage

diff --git a/lib/RT/I18N/Extract.pm b/lib/RT/I18N/Extract.pm
index cf8f910b8..14926c7af 100644
--- a/lib/RT/I18N/Extract.pm
+++ b/lib/RT/I18N/Extract.pm
@@ -139,7 +139,7 @@ sub from {
 
     my $ws = qr{[ ]*};
     my $punct = qr{[ \{\}\)\],;]*};
-    my $re_delim = $RE{delimited}{-delim=>q{'"}}{-keep};
+    my $quoted = $RE{delimited}{-delim=>q{'"}};
 
     # Mason filter: <&|/l&>...</&> and <&|/l_unsafe&>...</&>
     $extract->(qr! <&\|/l(?:_unsafe)?(.*?)&>  (.*?)  </&> !sox, sub {
@@ -148,15 +148,15 @@ sub from {
 
     # Localization function: loc(...)
     $extract->(qr! \b loc
-                   $RE{balanced}{-parens=>'()'}{-keep}
+                   ( $RE{balanced}{-parens=>'()'} )
                  !sox, sub {
         # Re-parse what was in the parens for the string and optional arguments
-        return unless "$1" =~ m! \( \s* ($re_delim)  (.*?) \s* \) $ !sox;
-        $add->($1, $9);
+        return unless "$1" =~ m! \( \s* ($quoted)  (.*?) \s* \) $ !sox;
+        $add->($1, $2);
     });
 
     # Comment-based mark: "..." # loc
-    $extract->(qr! ($re_delim)      # Quoted string
+    $extract->(qr! ($quoted)      # Quoted string
                    $punct
                    $ws \# $ws loc
                    $ws $
@@ -165,14 +165,14 @@ sub from {
     });
 
     # Comment-based mark for list to loc():  ("...", $foo, $bar)  # loc()
-    $extract->(qr! $RE{balanced}{-parens=>'()'}{-keep}
+    $extract->(qr! ( $RE{balanced}{-parens=>'()'} )
                    $punct
                    $ws \# $ws loc \(\)
                    $ws $
                  !smox, sub {
         # Re-parse what was in the parens for the string and optional arguments
-        return unless "$1" =~ m! \( \s* ($re_delim)  (.*?) \s* \) $ !sox;
-        $add->($1, $9);
+        return unless "$1" =~ m! \( \s* ($quoted)  (.*?) \s* \) $ !sox;
+        $add->($1, $2);
     });
 
     # Comment-based qw mark: "qw(...)" # loc_qw
@@ -185,7 +185,7 @@ sub from {
     });
 
     # Comment-based left pair mark: "..." => ... # loc_left_pair
-    $extract->(qr! (\w+|$re_delim)
+    $extract->(qr! (\w+|$quoted)
                    \s* => [^#\n]+?
                    $ws \# $ws loc_left_pair
                    $ws $
@@ -194,30 +194,30 @@ sub from {
     });
 
     # Comment-based pair mark: "..." => "..." # loc_pair
-    $extract->(qr! (\w+|$re_delim)
-                   \s* => \s* ($re_delim)
+    $extract->(qr! (\w+|$quoted)
+                   \s* => \s* ($quoted)
                    $punct
                    $ws \# $ws loc_pair
                    $ws $
                  !smox, sub {
         $add->($1);
-        $add->($9);
+        $add->($2);
     });
 
     # Specific key  foo => "...", #loc{foo}
-    $extract->(qr! (\w+|$re_delim)
-                   \s* => \s* ($re_delim)
+    $extract->(qr! (\w+|$quoted)
+                   \s* => \s* ($quoted)
                    (?-s: .*? ) \# $ws loc\{\1\}  # More lax about what matches before the #
                    $ws $
                  !smox, sub {
-        $add->($9);
+        $add->($2);
     });
 
     # Check for ones we missed
     $extract->(qr! \# $ws
                    (
                      loc
-                     ( _\w+ | \(\) | {$re_delim} )?
+                     ( _\w+ | \(\) | {(\w+|$quoted)} )?
                    )
                    $ws $
                  !smox, sub {

commit 5f3d9eda56dd93e6bcd60da34ac963c2ba63da38
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 22:30:57 2016 -0700

    Make extraction store errors, instead of printing immediately
    
    Also print them in the format that linters often do.

diff --git a/devel/tools/extract-message-catalog b/devel/tools/extract-message-catalog
index 9751506cc..6cb8b0ef6 100755
--- a/devel/tools/extract-message-catalog
+++ b/devel/tools/extract-message-catalog
@@ -65,7 +65,9 @@ $| = 1;
 
 # extract all strings and stuff them into %FILECAT
 # scan html dir for extensions
-our %FILECAT = RT::I18N::Extract->new->all;
+my $extract = RT::I18N::Extract->new;
+our %FILECAT = $extract->all;
+print "$_\n" for $extract->errors;
 
 # ensure proper escaping and [_1] => %1 transformation
 foreach my $str ( sort keys %FILECAT ) {
diff --git a/lib/RT/I18N/Extract.pm b/lib/RT/I18N/Extract.pm
index 14926c7af..a68b9115f 100644
--- a/lib/RT/I18N/Extract.pm
+++ b/lib/RT/I18N/Extract.pm
@@ -56,7 +56,10 @@ use File::Spec;
 use File::Find;
 
 sub new {
-    return bless {filecat => {}}, shift;
+    return bless {
+        filecat => {},
+        errors  => [],
+    }, shift;
 }
 
 sub all {
@@ -87,22 +90,20 @@ sub from {
 
     return unless $self->valid_to_extract($file);
 
-    my $normalized = $file;
-    $normalized =~ s'^\./'';
-    $normalized =~ s'\.in$'';
-    print "Looking at $normalized";
-
     my $fh;
     unless (open $fh, '<', $file) {
-        print "\n  Cannot open $file for reading ($!), skipping.\n\n";
+        push @{$self->{errors}}, "$file:0: Cannot open for reading: $!";
         return;
     }
     my $contents = do { local $/; <$fh> };
     close $fh;
 
     my %FILECAT = %{$self->{filecat}};
-    my $errors = 0;
 
+    # Provide the non-.in filename for the rest of error reporting and
+    # POT file needs, as the .in file will not exist if looking in the
+    # installed tree.
+    $file =~ s/\.in$//;
 
     my %seen;
     my $line;
@@ -121,7 +122,7 @@ sub from {
 
         $vars =~ tr/\n\r//d;
 
-        push @{ $FILECAT{$key} }, [ $normalized, $line, $vars, $interp ];
+        push @{ $FILECAT{$key} }, [ $file, $line, $vars, $interp ];
     };
     my $add = sub {$_add->(1, @_)};
     my $add_noquotes = sub {$_add->(0, @_)};
@@ -222,16 +223,9 @@ sub from {
                    $ws $
                  !smox, sub {
         return if $seen{$line};
-        print "\n" unless $errors++;
-        print "  $1 that did not match, line $line of $normalized\n";
+        push @{$self->{errors}}, "$file:$line: Localization comment '$1' did not match";
     });
 
-    if ($errors) {
-        print "\n"
-    } else {
-        print "\r", " " x 100, "\r";
-    }
-
     $self->{filecat} = \%FILECAT;
 }
 
@@ -240,4 +234,9 @@ sub results {
     return %{$self->{filecat}};
 }
 
+sub errors {
+    my $self = shift;
+    return @{$self->{errors}};
+}
+
 1;

commit be0a016d0c05519022237e9a45a46cf6ece66068
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 22:38:04 2016 -0700

    Move more error-checking into extraction-time
    
    The aggregation done by doing so after all extraction is complete is
    detrimental -- all occurrences of the errors will need to be fixed, so
    only displaying one filename and line number forces the user to do
    grepping.
    
    The check for embedded newlines is moved to only trigger if the string
    was double-quoted, averting a potential false-positive.

diff --git a/devel/tools/extract-message-catalog b/devel/tools/extract-message-catalog
index 6cb8b0ef6..1965314d6 100755
--- a/devel/tools/extract-message-catalog
+++ b/devel/tools/extract-message-catalog
@@ -72,17 +72,6 @@ print "$_\n" for $extract->errors;
 # ensure proper escaping and [_1] => %1 transformation
 foreach my $str ( sort keys %FILECAT ) {
     my $entry = delete $FILECAT{$str};
-    next unless @{$entry};
-
-    my ($filename, $line) = @{ $entry->[0] };
-    my $location = "$filename line $line" . (@{$entry} > 1 ? " (and ".(@{$entry}-1)." other places)" : "");
-
-    if ($str =~ /^\s/m || $str =~ /\s$/m || $str =~ /\\n$/m) {
-        warn "Extraneous whitespace in '$str' at $location\n";
-    }
-    if (grep {$_->[3]} @{$entry} and $str =~ /([\$\@]\w+)/) {
-        warn "Interpolated variable '$1' in '$str' at $location\n";
-    }
 
     my $escape = sub { $_ = shift; s/\b_(\d+)/%$1/; $_ };
     $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
diff --git a/lib/RT/I18N/Extract.pm b/lib/RT/I18N/Extract.pm
index a68b9115f..c42a6522d 100644
--- a/lib/RT/I18N/Extract.pm
+++ b/lib/RT/I18N/Extract.pm
@@ -114,15 +114,27 @@ sub from {
 
         $seen{$line}++;
 
-        my $interp;
         if ($maybe_quoted and $key =~ s/^(['"])(.*)\1$/$2/) {
-            $interp = 1 if $1 eq '"';
+            my $quote = $1;
             $key =~ s/\\(['"\\])/$1/g;
+
+            if ($quote eq '"') {
+                if ($key =~ /([\$\@]\w+)/) {
+                    push @{$self->{errors}}, "$file:$line: Interpolated variable '$1' in \"$key\"";
+                }
+                if ($key =~ /\\n/) {
+                    push @{$self->{errors}}, "$file:$line: Embedded newline in \"$key\"";
+                }
+            }
+        }
+
+        if ($key =~ /^\s/m || $key =~ /\s$/m) {
+            push @{$self->{errors}}, "$file:$line: Extraneous whitespace in '$key'";
         }
 
         $vars =~ tr/\n\r//d;
 
-        push @{ $FILECAT{$key} }, [ $file, $line, $vars, $interp ];
+        push @{ $FILECAT{$key} }, [ $file, $line, $vars ];
     };
     my $add = sub {$_add->(1, @_)};
     my $add_noquotes = sub {$_add->(0, @_)};

commit 6d87c629c20dc3571f06e5c9030a12cf9a9a1737
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 23:54:28 2016 -0700

    Add additional error-checking for nested Mason blocks

diff --git a/lib/RT/I18N/Extract.pm b/lib/RT/I18N/Extract.pm
index c42a6522d..25efbec4a 100644
--- a/lib/RT/I18N/Extract.pm
+++ b/lib/RT/I18N/Extract.pm
@@ -156,7 +156,11 @@ sub from {
 
     # Mason filter: <&|/l&>...</&> and <&|/l_unsafe&>...</&>
     $extract->(qr! <&\|/l(?:_unsafe)?(.*?)&>  (.*?)  </&> !sox, sub {
-        $add_noquotes->($2, $1);
+        my ($key, $vars) = ($2, $1);
+        if ($key =~ m! (<([%&]) .*? \2>) !sox) {
+            push @{$self->{errors}}, "$file:$line: Mason content within loc: '$1'";
+        }
+        $add_noquotes->($key, $vars);
     });
 
     # Localization function: loc(...)

commit 33fcc338b871aa95ac1d5db8da738a498ad49ef8
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 22:49:34 2016 -0700

    Move escaping logic into module; now returns Local::PO objects
    
    This hides the internal datastructures, making the interface cleaner.

diff --git a/devel/tools/extract-message-catalog b/devel/tools/extract-message-catalog
index 1965314d6..383cd5141 100755
--- a/devel/tools/extract-message-catalog
+++ b/devel/tools/extract-message-catalog
@@ -63,35 +63,12 @@ $| = 1;
 # po dir is for extensions
 @ARGV = (<share/po/*.po>, <share/po/*.pot>, <po/*.po>, <po/*.pot>) unless @ARGV;
 
-# extract all strings and stuff them into %FILECAT
+# extract all strings and stuff them into %POT
 # scan html dir for extensions
 my $extract = RT::I18N::Extract->new;
-our %FILECAT = $extract->all;
-print "$_\n" for $extract->errors;
-
-# ensure proper escaping and [_1] => %1 transformation
-foreach my $str ( sort keys %FILECAT ) {
-    my $entry = delete $FILECAT{$str};
-
-    my $escape = sub { $_ = shift; s/\b_(\d+)/%$1/; $_ };
-    $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
-    $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".$escape->($3).")"/eg;
-    $str =~ s/~([\[\]])/$1/g;
-
-    my $po = Locale::PO->new(-msgid => $str, -msgstr => "");
-    $po->reference( join ( ' ', sort map $_->[0].":".$_->[1], @{ $entry } ) );
-    my %seen;
-    my @vars;
-    foreach my $find ( sort { $a->[2] cmp $b->[2] } grep { $_->[2] } @{ $entry } ) {
-        my ( $file, $line, $var ) = @{$find};
-        $var =~ s/^\s*,\s*//;
-        $var =~ s/\s*$//;
-        push @vars, "($var)" unless $seen{$var}++;
-    }
-    $po->automatic( join( "\n", @vars) );
+our %POT = $extract->all;
 
-    $FILECAT{$po->msgid} = $po;
-}
+print "$_\n" for $extract->errors;
 
 # update all language dictionaries
 foreach my $dict (@ARGV) {
@@ -128,7 +105,7 @@ sub update {
 
     # Default to the empty string for new ones
     $lexicon->{$_->msgid} ||= $_
-        for values %FILECAT;
+        for values %POT;
 
     my $errors = 0;
     for my $msgid ( keys %{$lexicon} ) {
@@ -144,7 +121,7 @@ sub update {
         next if not length $entry->dequote($msgid);
 
         # Not found in source?  Drop it
-        my $source = $FILECAT{$msgid};
+        my $source = $POT{$msgid};
         if (not $source) {
             delete $lexicon->{$msgid};
             next;
diff --git a/lib/RT/I18N/Extract.pm b/lib/RT/I18N/Extract.pm
index 25efbec4a..3b9e319d8 100644
--- a/lib/RT/I18N/Extract.pm
+++ b/lib/RT/I18N/Extract.pm
@@ -54,10 +54,11 @@ use warnings;
 use Regexp::Common;
 use File::Spec;
 use File::Find;
+use Locale::PO;
 
 sub new {
     return bless {
-        filecat => {},
+        results => {},
         errors  => [],
     }, shift;
 }
@@ -98,8 +99,6 @@ sub from {
     my $contents = do { local $/; <$fh> };
     close $fh;
 
-    my %FILECAT = %{$self->{filecat}};
-
     # Provide the non-.in filename for the rest of error reporting and
     # POT file needs, as the .in file will not exist if looking in the
     # installed tree.
@@ -134,7 +133,7 @@ sub from {
 
         $vars =~ tr/\n\r//d;
 
-        push @{ $FILECAT{$key} }, [ $file, $line, $vars ];
+        push @{ $self->{results}{$key} }, [ $file, $line, $vars ];
     };
     my $add = sub {$_add->(1, @_)};
     my $add_noquotes = sub {$_add->(0, @_)};
@@ -241,13 +240,36 @@ sub from {
         return if $seen{$line};
         push @{$self->{errors}}, "$file:$line: Localization comment '$1' did not match";
     });
-
-    $self->{filecat} = \%FILECAT;
 }
 
 sub results {
     my $self = shift;
-    return %{$self->{filecat}};
+
+    my %PO;
+    for my $str ( sort keys %{$self->{results}} ) {
+        my $entry = $self->{results}{$str};
+
+        my $escape = sub { $_ = shift; s/\b_(\d+)/%$1/; $_ };
+        $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
+        $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".$escape->($3).")"/eg;
+        $str =~ s/~([\[\]])/$1/g;
+
+        my $po = Locale::PO->new(-msgid => $str, -msgstr => "");
+        $po->reference( join ( ' ', sort map $_->[0].":".$_->[1], @{ $entry } ) );
+        my %seen;
+        my @vars;
+        foreach my $find ( sort { $a->[2] cmp $b->[2] } grep { $_->[2] } @{ $entry } ) {
+            my ( $file, $line, $var ) = @{$find};
+            $var =~ s/^\s*,\s*//;
+            $var =~ s/\s*$//;
+            push @vars, "($var)" unless $seen{$var}++;
+        }
+        $po->automatic( join( "\n", @vars) );
+
+        $PO{$po->msgid} = $po;
+    }
+
+    return %PO;
 }
 
 sub errors {

commit 157e7f9bae510c8a05a48558d4ea1e6d66c0ca54
Author: Alex Vandiver <alex at chmrr.net>
Date:   Wed Jul 27 23:39:11 2016 -0700

    Add a test that verifies that POT strings can be extracted successfully
    
    This does not test that there are no errors in PO files.  Such errors
    should be corrected (via Launchpad) by hand, and should not block the
    PO import.

diff --git a/t/i18n/extract.t b/t/i18n/extract.t
new file mode 100644
index 000000000..a52a831c0
--- /dev/null
+++ b/t/i18n/extract.t
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef, nodb => 1;
+
+use RT::I18N::Extract;
+
+my $extract = RT::I18N::Extract->new;
+ok($extract);
+
+my %PO = $extract->all;
+ok(keys %PO, "Extracted keys successfully");
+
+my @errors = $extract->errors;
+diag "$_" for @errors;
+ok(! @errors, "No errors during extraction");
+
+done_testing;

commit 6dee85f9ea1aae86495a8bbc51e93bd3ad075df1
Merge: 79038f556 157e7f9ba
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Thu Mar 15 04:24:13 2018 +0800

    Merge branch '4.2/po-extraction' into 4.2-trunk
    
    With small tweaks comparing to the original branch:
    
    * Fix a couple of typo in commit messages
    * Update copyright year to 2017
    * Update i18n extract test to not require db


-----------------------------------------------------------------------


More information about the rt-commit mailing list