+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2019 Best Practical Solutions, LLC
+# <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package RT::I18N::Extract;
+
+use strict;
+use warnings;
+
+use Regexp::Common;
+use File::Spec;
+use File::Find;
+use Locale::PO;
+
+sub new {
+ return bless {
+ results => {},
+ errors => [],
+ }, shift;
+}
+
+sub all {
+ my $self = shift;
+ my $merged = sub { $self->from($File::Find::name) };
+ File::Find::find(
+ { wanted => $merged, no_chdir => 1, follow => 1 },
+ 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) = (@_);
+
+ return unless $self->valid_to_extract($file);
+
+ my $fh;
+ unless (open $fh, '<', $file) {
+ push @{$self->{errors}}, "$file:0: Cannot open for reading: $!";
+ return;
+ }
+ my $contents = do { local $/; <$fh> };
+ close $fh;
+
+ # 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;
+
+ my $_add = sub {
+ my ($maybe_quoted, $key, $vars) = @_;
+ $vars = '' unless defined $vars;
+
+ $seen{$line}++;
+
+ if ($maybe_quoted and $key =~ s/^(['"])(.*)\1$/$2/) {
+ 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 @{ $self->{results}{$key} }, [ $file, $line, $vars ];
+ };
+ 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->();
+ }
+ };
+
+ my $ws = qr{[ ]*};
+ my $punct = qr{[ \{\}\)\],;]*};
+ my $quoted = $RE{delimited}{-delim=>q{'"}};
+
+ # Mason filter: <&|/l&>...</&> and <&|/l_unsafe&>...</&>
+ $extract->(qr! <&\|/l(?:_unsafe)?(.*?)&> (.*?) </&> !sox, sub {
+ 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(...)
+ $extract->(qr! \b loc
+ ( $RE{balanced}{-parens=>'()'} )
+ !sox, sub {
+ # Re-parse what was in the parens for the string and optional arguments
+ return unless "$1" =~ m! \( \s* ($quoted) (.*?) \s* \) $ !sox;
+ $add->($1, $2);
+ });
+
+ # Comment-based mark: "..." # loc
+ $extract->(qr! ($quoted) # 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=>'()'} )
+ $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* ($quoted) (.*?) \s* \) $ !sox;
+ $add->($1, $2);
+ });
+
+ # Comment-based qw mark: "qw(...)" # loc_qw
+ $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+|$quoted)
+ \s* => [^#\n]+?
+ $ws \# $ws loc_left_pair
+ $ws $
+ !smox, sub {
+ $add->($1);
+ });
+
+ # Comment-based pair mark: "..." => "..." # loc_pair
+ $extract->(qr! (\w+|$quoted)
+ \s* => \s* ($quoted)
+ $punct
+ $ws \# $ws loc_pair
+ $ws $
+ !smox, sub {
+ $add->($1);
+ $add->($2);
+ });
+
+ # Specific key foo => "...", #loc{foo}
+ $extract->(qr! (\w+|$quoted)
+ \s* => \s* ($quoted)
+ (?-s: .*? ) \# $ws loc\{\1\} # More lax about what matches before the #
+ $ws $
+ !smox, sub {
+ $add->($2);
+ });
+
+ # Check for ones we missed
+ $extract->(qr! \# $ws
+ (
+ loc
+ ( _\w+ | \(\) | {(\w+|$quoted)} )?
+ )
+ $ws $
+ !smox, sub {
+ return if $seen{$line};
+ push @{$self->{errors}}, "$file:$line: Localization comment '$1' did not match";
+ });
+}
+
+sub results {
+ my $self = shift;
+
+ 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 {
+ my $self = shift;
+ return @{$self->{errors}};
+}
+
+1;
projects / freeside.git / commitdiff