rt/lib/RT/I18N/Extract.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2019 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 package RT::I18N::Extract;
  50
  51 use strict;
  52 use warnings;
  53
  54 use Regexp::Common;
  55 use File::Spec;
  56 use File::Find;
  57 use Locale::PO;
  58
  59 sub new {
  60     return bless {
  61         results => {},
  62         errors  => [],
  63     }, shift;
  64 }
  65
  66 sub all {
  67     my $self = shift;
  68     my $merged = sub { $self->from($File::Find::name) };
  69     File::Find::find(
  70         { wanted => $merged, no_chdir => 1, follow => 1 },
  71         grep {-d $_} qw(bin sbin lib share/html html etc),
  72     );
  73     return $self->results;
  74 }
  75
  76 sub valid_to_extract {
  77     my $self = shift;
  78     my ($file) = @_;
  79
  80     return unless -f $file;
  81     return if $file eq "lib/RT/StyleGuide.pod";
  82     return if $file eq "lib/RT/I18N/Extract.pm";
  83     return if $file =~ m{/[\.#][^/]*$} or $file =~ /\.bak$/;
  84     return if -f "$file.in";
  85     return 1;
  86 }
  87
  88 sub from {
  89     my $self = shift;
  90     my ($file) = (@_);
  91
  92     return unless $self->valid_to_extract($file);
  93
  94     my $fh;
  95     unless (open $fh, '<', $file) {
  96         push @{$self->{errors}}, "$file:0: Cannot open for reading: $!";
  97         return;
  98     }
  99     my $contents = do { local $/; <$fh> };
 100     close $fh;
 101
 102     # Provide the non-.in filename for the rest of error reporting and
 103     # POT file needs, as the .in file will not exist if looking in the
 104     # installed tree.
 105     $file =~ s/\.in$//;
 106
 107     my %seen;
 108     my $line;
 109
 110     my $_add = sub {
 111         my ($maybe_quoted, $key, $vars) = @_;
 112         $vars = '' unless defined $vars;
 113
 114         $seen{$line}++;
 115
 116         if ($maybe_quoted and $key =~ s/^(['"])(.*)\1$/$2/) {
 117             my $quote = $1;
 118             $key =~ s/\\(['"\\])/$1/g;
 119
 120             if ($quote eq '"') {
 121                 if ($key =~ /([\$\@]\w+)/) {
 122                     push @{$self->{errors}}, "$file:$line: Interpolated variable '$1' in \"$key\"";
 123                 }
 124                 if ($key =~ /\\n/) {
 125                     push @{$self->{errors}}, "$file:$line: Embedded newline in \"$key\"";
 126                 }
 127             }
 128         }
 129
 130         if ($key =~ /^\s/m || $key =~ /\s$/m) {
 131             push @{$self->{errors}}, "$file:$line: Extraneous whitespace in '$key'";
 132         }
 133
 134         $vars =~ tr/\n\r//d;
 135
 136         push @{ $self->{results}{$key} }, [ $file, $line, $vars ];
 137     };
 138     my $add = sub {$_add->(1, @_)};
 139     my $add_noquotes = sub {$_add->(0, @_)};
 140
 141     my $extract = sub {
 142         my ($regex, $run) = @_;
 143         $line = 1;
 144         pos($contents) = 0;
 145         while ($contents =~ m!\G.*?$regex!sg) {
 146             my $match = substr($contents,$-[0],$+[0]-$-[0]);
 147             $line += ( $match =~ tr/\n/\n/ );
 148             $run->();
 149         }
 150     };
 151
 152     my $ws = qr{[ ]*};
 153     my $punct = qr{[ \{\}\)\],;]*};
 154     my $quoted = $RE{delimited}{-delim=>q{'"}};
 155
 156     # Mason filter: <&|/l&>...</&> and <&|/l_unsafe&>...</&>
 157     $extract->(qr! <&\|/l(?:_unsafe)?(.*?)&>  (.*?)  </&> !sox, sub {
 158         my ($key, $vars) = ($2, $1);
 159         if ($key =~ m! (<([%&]) .*? \2>) !sox) {
 160             push @{$self->{errors}}, "$file:$line: Mason content within loc: '$1'";
 161         }
 162         $add_noquotes->($key, $vars);
 163     });
 164
 165     # Localization function: loc(...)
 166     $extract->(qr! \b loc
 167                    ( $RE{balanced}{-parens=>'()'} )
 168                  !sox, sub {
 169         # Re-parse what was in the parens for the string and optional arguments
 170         return unless "$1" =~ m! \( \s* ($quoted)  (.*?) \s* \) $ !sox;
 171         $add->($1, $2);
 172     });
 173
 174     # Comment-based mark: "..." # loc
 175     $extract->(qr! ($quoted)      # Quoted string
 176                    $punct
 177                    $ws \# $ws loc
 178                    $ws $
 179                  !smox, sub {
 180         $add->($1);
 181     });
 182
 183     # Comment-based mark for list to loc():  ("...", $foo, $bar)  # loc()
 184     $extract->(qr! ( $RE{balanced}{-parens=>'()'} )
 185                    $punct
 186                    $ws \# $ws loc \(\)
 187                    $ws $
 188                  !smox, sub {
 189         # Re-parse what was in the parens for the string and optional arguments
 190         return unless "$1" =~ m! \( \s* ($quoted)  (.*?) \s* \) $ !sox;
 191         $add->($1, $2);
 192     });
 193
 194     # Comment-based qw mark: "qw(...)" # loc_qw
 195     $extract->(qr! qw \( ([^)]+) \)
 196                    $punct
 197                    $ws \# $ws loc_qw
 198                    $ws $
 199                  !smox, sub {
 200         $add_noquotes->($_) for split ' ', $1;
 201     });
 202
 203     # Comment-based left pair mark: "..." => ... # loc_left_pair
 204     $extract->(qr! (\w+|$quoted)
 205                    \s* => [^#\n]+?
 206                    $ws \# $ws loc_left_pair
 207                    $ws $
 208                  !smox, sub {
 209         $add->($1);
 210     });
 211
 212     # Comment-based pair mark: "..." => "..." # loc_pair
 213     $extract->(qr! (\w+|$quoted)
 214                    \s* => \s* ($quoted)
 215                    $punct
 216                    $ws \# $ws loc_pair
 217                    $ws $
 218                  !smox, sub {
 219         $add->($1);
 220         $add->($2);
 221     });
 222
 223     # Specific key  foo => "...", #loc{foo}
 224     $extract->(qr! (\w+|$quoted)
 225                    \s* => \s* ($quoted)
 226                    (?-s: .*? ) \# $ws loc\{\1\}  # More lax about what matches before the #
 227                    $ws $
 228                  !smox, sub {
 229         $add->($2);
 230     });
 231
 232     # Check for ones we missed
 233     $extract->(qr! \# $ws
 234                    (
 235                      loc
 236                      ( _\w+ | \(\) | {(\w+|$quoted)} )?
 237                    )
 238                    $ws $
 239                  !smox, sub {
 240         return if $seen{$line};
 241         push @{$self->{errors}}, "$file:$line: Localization comment '$1' did not match";
 242     });
 243 }
 244
 245 sub results {
 246     my $self = shift;
 247
 248     my %PO;
 249     for my $str ( sort keys %{$self->{results}} ) {
 250         my $entry = $self->{results}{$str};
 251
 252         my $escape = sub { $_ = shift; s/\b_(\d+)/%$1/; $_ };
 253         $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
 254         $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".$escape->($3).")"/eg;
 255         $str =~ s/~([\[\]])/$1/g;
 256
 257         my $po = Locale::PO->new(-msgid => $str, -msgstr => "");
 258         $po->reference( join ( ' ', sort map $_->[0].":".$_->[1], @{ $entry } ) );
 259         my %seen;
 260         my @vars;
 261         foreach my $find ( sort { $a->[2] cmp $b->[2] } grep { $_->[2] } @{ $entry } ) {
 262             my ( $file, $line, $var ) = @{$find};
 263             $var =~ s/^\s*,\s*//;
 264             $var =~ s/\s*$//;
 265             push @vars, "($var)" unless $seen{$var}++;
 266         }
 267         $po->automatic( join( "\n", @vars) );
 268
 269         $PO{$po->msgid} = $po;
 270     }
 271
 272     return %PO;
 273 }
 274
 275 sub errors {
 276     my $self = shift;
 277     return @{$self->{errors}};
 278 }
 279
 280 1;