2 # BEGIN BPS TAGGED BLOCK {{{
6 # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
7 # <sales@bestpractical.com>
9 # (Except where explicitly superseded by other copyright notices)
14 # This work is made available to you under the terms of Version 2 of
15 # the GNU General Public License. A copy of that license should have
16 # been provided with this software, but in any event can be snarfed
19 # This work is distributed in the hope that it will be useful, but
20 # WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 # General Public License for more details.
24 # You should have received a copy of the GNU General Public License
25 # along with this program; if not, write to the Free Software
26 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
27 # 02110-1301 or visit their web page on the internet at
28 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
31 # CONTRIBUTION SUBMISSION POLICY:
33 # (The following paragraph is not intended to limit the rights granted
34 # to you to modify and distribute this software under the terms of
35 # the GNU General Public License and is only of importance to you if
36 # you choose to contribute your changes and enhancements to the
37 # community by submitting them to Best Practical Solutions, LLC.)
39 # By intentionally submitting any modifications, corrections or
40 # derivatives to this work, or any other work intended for use with
41 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
42 # you are the copyright holder for those contributions and you grant
43 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
44 # royalty-free, perpetual, license to use, copy, create derivative
45 # works based on those contributions, and sublicense and distribute
46 # those contributions and any derivatives thereof.
48 # END BPS TAGGED BLOCK }}}
49 # Portions Copyright 2002 Autrijus Tang <autrijus@autrijus.org>
58 use vars qw($DEBUG $FILECAT);
62 # po dir is for extensions
63 @ARGV = (<lib/RT/I18N/*.po>, <lib/RT/I18N/*.pot>, <po/*.po>, <po/*.pot>) unless @ARGV;
67 # extract all strings and stuff them into $FILECAT
68 # scan html dir for extensions
69 File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, qw(bin sbin lib share html etc) );
71 # remove msgid with $ in it. XXX: perhaps give some warnings here
72 $FILECAT = { map { $_ => $FILECAT->{$_} } grep { !m/\$/ } keys %$FILECAT };
74 # ensure proper escaping and [_1] => %1 transformation
75 foreach my $str ( sort keys %{$FILECAT} ) {
76 my $entry = $FILECAT->{$str};
81 $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
82 $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".escape($3).")"/eg;
83 $str =~ s/~([\[\]])/$1/g;
85 delete $FILECAT->{$oldstr};
86 $FILECAT->{$str} = $entry;
89 # update all language dictionaries
90 foreach my $dict (@ARGV) {
91 $dict = "lib/RT/I18N/$dict.pot" if ( $dict eq 'rt' );
92 $dict = "lib/RT/I18N/$dict.po" unless -f $dict or $dict =~ m!/!;
103 # {{{ pull strings out of the code.
105 sub extract_strings_from_code {
111 if ( $File::Find::dir =~
112 qr!lib/blib|lib/t/autogen|var|m4|local|share/fonts! );
113 return if ( /\.(?:pot|po|bak|gif|png|psd|jpe?g|svg|css|js)$/ );
114 return if ( /~|,D|,B$|extract-message-catalog$|tweak-template-locstring$/ );
115 return if ( /^[\.#]/ );
116 return if ( -f "$_.in" );
118 print "Looking at $File::Find::name\n";
119 my $filename = $File::Find::name;
120 $filename =~ s'^\./'';
121 $filename =~ s'\.in$'';
123 unless (open _, '<', $file) {
124 print "Cannot open $file for reading ($!), skipping.\n";
128 my $re_space_wo_nl = qr{(?!\n)\s};
129 my $re_loc_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc $re_space_wo_nl* $}mx;
130 my $re_loc_qw_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_qw $re_space_wo_nl* $}mx;
131 my $re_loc_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_pair $re_space_wo_nl* $}mx;
132 my $re_loc_left_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_left_pair $re_space_wo_nl* $}mx;
133 my $re_delim = $RE{delimited}{-delim=>q{'"}}{-keep};
137 # Mason filter: <&|/l>...</&>
139 while (m!\G.*?<&\|/l(.*?)&>(.*?)</&>!sg) {
140 my ( $vars, $str ) = ( $1, $2 );
141 $vars =~ s/[\n\r]//g;
142 $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
144 #print "STR IS $str\n";
145 push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
148 # Localization function: loc(...)
151 while (m/\G.*?\bloc$RE{balanced}{-parens=>'()'}{-keep}/sg) {
153 $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
157 /\(\s*($re_delim)(.*?)\s*\)$/so ) {
159 $str = substr( $1, 1, -1 ); # $str comes before $vars now
166 $vars =~ s/[\n\r]//g;
169 push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
172 # Comment-based mark: "..." # loc
175 while (m/\G.*?($re_delim)[\}\)\],;]*$re_loc_suffix/smgo) {
177 $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
178 unless ( defined $str ) {
179 warn "Couldn't process loc at $filename:$line";
182 $str = substr($str, 1, -1);
184 push @{ $FILECAT->{$str} }, [ $filename, $line, '' ];
187 # Comment-based qw mark: "qw(...)" # loc_qw
190 while (m/\G.*?(?:(qw\([^)]+\))[\}\)\],;]*)?$re_loc_qw_suffix/smgo) {
192 $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
193 unless ( defined $str ) {
194 warn "Couldn't process loc_qw at $filename:$line";
197 foreach my $value (eval($str)) {
198 push @{ $FILECAT->{$value} }, [ $filename, $line, '' ];
202 # Comment-based left pair mark: "..." => ... # loc_left_pair
205 while (m/\G.*?(?:(\w+)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix/smgo) {
207 $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
208 unless ( defined $key ) {
209 warn "Couldn't process loc_left_pair at $filename:$line";
213 push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
216 # Comment-based pair mark: "..." => "..." # loc_pair
219 while (m/\G.*?(?:(\w+)\s*=>\s*($re_delim)[\}\)\],;]*)?$re_loc_pair_suffix/smgo) {
222 $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
223 unless ( defined $key && defined $val ) {
224 warn "Couldn't process loc_pair at $filename:$line";
227 $val = substr($val, 1, -1);
230 push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
231 push @{ $FILECAT->{$val} }, [ $filename, $line, '' ];
236 # }}} extract from strings
241 my ( %Lexicon, %Header);
244 unless (!-e $file or -w $file) {
245 warn "Can't write to $lang, skipping...\n";
249 print "Updating $lang...\n";
252 @lines = (<LEXICON>) if open LEXICON, '<', $file;
253 @lines = grep { !/^(#(:|\.)\s*|$)/ } @lines;
256 $msghdr .= shift @lines while ( $lines[0] && $lines[0] !~ /^(#~ )?msgid/ );
260 # '#~ ' is the prefix of launchpad for msg that's not found the the source
261 # we'll remove the prefix later so we can still show them with our own mark
263 $msgid .= shift @lines while ( $lines[0] && $lines[0] =~ /^(#~ )?(msgid|")/ );
265 $msgstr .= shift @lines while ( $lines[0] && $lines[0] =~ /^(#~ )?(msgstr|")/ );
272 $msgid =~ s/^#~ //mg;
273 $msgstr =~ s/^#~ //mg;
275 $msgid =~ s/^msgid "(.*)"\s*?$/$1/m or warn "$msgid in $file";
277 if ( $msgid eq '' ) {
278 # null msgid, msgstr will have head info
279 $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/ms or warn "$msgstr in $file";
282 $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/m or warn "$msgstr in $file";
285 if ( $msgid ne '' ) {
286 for my $msg ( \$msgid, \$msgstr ) {
287 if ( $$msg =~ /\n/ ) {
288 my @lines = split /\n/, $$msg;
290 shift @lines; # first line don't need to handle any more
298 # convert \\n back to \n
299 $$msg =~ s/(?!\\)\\n/\n/g;
303 $Lexicon{$msgid} = $msgstr;
304 $Header{$msgid} = $msghdr;
307 my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ );
309 foreach my $str ( sort keys %{$FILECAT} ) {
310 $Lexicon{$str} ||= '';
312 foreach ( sort keys %Lexicon ) {
313 my $f = join ( ' ', sort map $_->[0].":".$_->[1], @{ $FILECAT->{$_} } );
317 if ( !$Lexicon{$_} and $Lexicon{$nospace} ) {
319 $Lexicon{$nospace} . ( ' ' x ( length($_) - length($nospace) ) );
322 next if !length( $Lexicon{$_} ) and $is_english;
325 $out .= $Header{$_} if exists $Header{$_};
329 next if (!$f && $_ && !$Lexicon{$_});
330 if ( $f && $f !~ /^\s+$/ ) {
335 $out .= "#: NOT FOUND IN SOURCE\n";
337 foreach my $entry ( grep { $_->[2] } @{ $FILECAT->{$_} } ) {
338 my ( $file, $line, $var ) = @{$entry};
339 $var =~ s/^\s*,\s*//;
341 $out .= "#. ($var)\n" unless $seen{$var}++;
343 $out .= 'msgid ' . fmt($_) . "msgstr \"$Lexicon{$_}\"\n\n";
346 open( PO, '>', $file ) or die "Couldn't open '$file' for writing: $!";
355 $text =~ s/\b_(\d+)/%$1/;
361 return "\"$str\"\n" unless $str =~ /\n/;
363 my $multi_line = ($str =~ /\n(?!\z)/);
364 $str =~ s/\n/\\n"\n"/g;
366 if ($str =~ /\n"$/) {
372 return $multi_line ? qq(""\n"$str) : qq("$str);
378 # c-indentation-style: bsd
380 # indent-tabs-mode: nil
382 # vim: expandtab shiftwidth=4: