1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2019 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
30 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
47 # END BPS TAGGED BLOCK }}}
49 package RT::I18N::Extract;
68 my $merged = sub { $self->from($File::Find::name) };
70 { wanted => $merged, no_chdir => 1, follow => 1 },
71 grep {-d $_} qw(bin sbin lib share/html html etc),
73 return $self->results;
76 sub valid_to_extract {
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";
92 return unless $self->valid_to_extract($file);
95 unless (open $fh, '<', $file) {
96 push @{$self->{errors}}, "$file:0: Cannot open for reading: $!";
99 my $contents = do { local $/; <$fh> };
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
111 my ($maybe_quoted, $key, $vars) = @_;
112 $vars = '' unless defined $vars;
116 if ($maybe_quoted and $key =~ s/^(['"])(.*)\1$/$2/) {
118 $key =~ s/\\(['"\\])/$1/g;
121 if ($key =~ /([\$\@]\w+)/) {
122 push @{$self->{errors}}, "$file:$line: Interpolated variable '$1' in \"$key\"";
125 push @{$self->{errors}}, "$file:$line: Embedded newline in \"$key\"";
130 if ($key =~ /^\s/m || $key =~ /\s$/m) {
131 push @{$self->{errors}}, "$file:$line: Extraneous whitespace in '$key'";
136 push @{ $self->{results}{$key} }, [ $file, $line, $vars ];
138 my $add = sub {$_add->(1, @_)};
139 my $add_noquotes = sub {$_add->(0, @_)};
142 my ($regex, $run) = @_;
145 while ($contents =~ m!\G.*?$regex!sg) {
146 my $match = substr($contents,$-[0],$+[0]-$-[0]);
147 $line += ( $match =~ tr/\n/\n/ );
153 my $punct = qr{[ \{\}\)\],;]*};
154 my $quoted = $RE{delimited}{-delim=>q{'"}};
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'";
162 $add_noquotes->($key, $vars);
165 # Localization function: loc(...)
166 $extract->(qr! \b loc
167 ( $RE{balanced}{-parens=>'()'} )
169 # Re-parse what was in the parens for the string and optional arguments
170 return unless "$1" =~ m! \( \s* ($quoted) (.*?) \s* \) $ !sox;
174 # Comment-based mark: "..." # loc
175 $extract->(qr! ($quoted) # Quoted string
183 # Comment-based mark for list to loc(): ("...", $foo, $bar) # loc()
184 $extract->(qr! ( $RE{balanced}{-parens=>'()'} )
189 # Re-parse what was in the parens for the string and optional arguments
190 return unless "$1" =~ m! \( \s* ($quoted) (.*?) \s* \) $ !sox;
194 # Comment-based qw mark: "qw(...)" # loc_qw
195 $extract->(qr! qw \( ([^)]+) \)
200 $add_noquotes->($_) for split ' ', $1;
203 # Comment-based left pair mark: "..." => ... # loc_left_pair
204 $extract->(qr! (\w+|$quoted)
206 $ws \# $ws loc_left_pair
212 # Comment-based pair mark: "..." => "..." # loc_pair
213 $extract->(qr! (\w+|$quoted)
223 # Specific key foo => "...", #loc{foo}
224 $extract->(qr! (\w+|$quoted)
226 (?-s: .*? ) \# $ws loc\{\1\} # More lax about what matches before the #
232 # Check for ones we missed
233 $extract->(qr! \# $ws
236 ( _\w+ | \(\) | {(\w+|$quoted)} )?
240 return if $seen{$line};
241 push @{$self->{errors}}, "$file:$line: Localization comment '$1' did not match";
249 for my $str ( sort keys %{$self->{results}} ) {
250 my $entry = $self->{results}{$str};
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;
257 my $po = Locale::PO->new(-msgid => $str, -msgstr => "");
258 $po->reference( join ( ' ', sort map $_->[0].":".$_->[1], @{ $entry } ) );
261 foreach my $find ( sort { $a->[2] cmp $b->[2] } grep { $_->[2] } @{ $entry } ) {
262 my ( $file, $line, $var ) = @{$find};
263 $var =~ s/^\s*,\s*//;
265 push @vars, "($var)" unless $seen{$var}++;
267 $po->automatic( join( "\n", @vars) );
269 $PO{$po->msgid} = $po;
277 return @{$self->{errors}};