+++ /dev/null
-#!/usr/bin/perl -w
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 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 }}}
-# Portions Copyright 2002 Autrijus Tang <autrijus@autrijus.org>
-
-use strict;
-
-use File::Find;
-use File::Copy;
-use Regexp::Common;
-use Carp;
-
-use vars qw($DEBUG $FILECAT);
-
-$DEBUG = 1;
-
-# po dir is for extensions
-@ARGV = (<lib/RT/I18N/*.po>, <lib/RT/I18N/*.pot>, <po/*.po>, <po/*.pot>) unless @ARGV;
-
-$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) );
-
-# remove msgid with $ in it. XXX: perhaps give some warnings here
-$FILECAT = { map { $_ => $FILECAT->{$_} } grep { !m/\$/ } keys %$FILECAT };
-
-# ensure proper escaping and [_1] => %1 transformation
-foreach my $str ( sort keys %{$FILECAT} ) {
- my $entry = $FILECAT->{$str};
- my $oldstr = $str;
-
- $str =~ s/\\/\\\\/g;
- $str =~ s/\"/\\"/g;
- $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
- $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".escape($3).")"/eg;
- $str =~ s/~([\[\]])/$1/g;
-
- delete $FILECAT->{$oldstr};
- $FILECAT->{$str} = $entry;
-}
-
-# update all language dictionaries
-foreach my $dict (@ARGV) {
- $dict = "lib/RT/I18N/$dict.pot" if ( $dict eq 'rt' );
- $dict = "lib/RT/I18N/$dict.po" unless -f $dict or $dict =~ m!/!;
-
- my $lang = $dict;
- $lang =~ s|.*/||;
- $lang =~ s|\.po$||;
- $lang =~ s|\.pot$||;
-
- update($lang, $dict);
-}
-
-
-# {{{ pull strings out of the code.
-
-sub extract_strings_from_code {
- my $file = $_;
-
- local $/;
- return if ( -d $_ );
- 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 ( /^[\.#]/ );
- return if ( -f "$_.in" );
-
- print "Looking at $File::Find::name\n";
- my $filename = $File::Find::name;
- $filename =~ s'^\./'';
- $filename =~ s'\.in$'';
-
- unless (open _, '<', $file) {
- print "Cannot open $file for reading ($!), skipping.\n";
- return;
- }
-
- 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_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>...</&>
- my $line = 1;
- while (m!\G.*?<&\|/l(.*?)&>(.*?)</&>!sg) {
- my ( $vars, $str ) = ( $1, $2 );
- $vars =~ s/[\n\r]//g;
- $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
- $str =~ s/\\'/\'/g;
- #print "STR IS $str\n";
- push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
- }
-
- # Localization function: loc(...)
- $line = 1;
- pos($_) = 0;
- while (m/\G.*?\bloc$RE{balanced}{-parens=>'()'}{-keep}/sg) {
- my $match = $1;
- $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
-
- my ( $vars, $str );
- if ( $match =~
- /\(\s*($re_delim)(.*?)\s*\)$/so ) {
-
- $str = substr( $1, 1, -1 ); # $str comes before $vars now
- $vars = $9;
- }
- else {
- next;
- }
-
- $vars =~ s/[\n\r]//g;
- $str =~ s/\\'/\'/g;
-
- push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
- }
-
- # Comment-based mark: "..." # loc
- $line = 1;
- pos($_) = 0;
- while (m/\G.*?($re_delim)[\}\)\],;]*$re_loc_suffix/smgo) {
- my $str = $1;
- $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
- unless ( defined $str ) {
- warn "Couldn't process loc at $filename:$line";
- next;
- }
- $str = substr($str, 1, -1);
- $str =~ s/\\'/\'/g;
- push @{ $FILECAT->{$str} }, [ $filename, $line, '' ];
- }
-
- # Comment-based qw mark: "qw(...)" # loc_qw
- $line = 1;
- pos($_) = 0;
- while (m/\G.*?(?:(qw\([^)]+\))[\}\)\],;]*)?$re_loc_qw_suffix/smgo) {
- my $str = $1;
- $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
- unless ( defined $str ) {
- warn "Couldn't process loc_qw at $filename:$line";
- next;
- }
- foreach my $value (eval($str)) {
- push @{ $FILECAT->{$value} }, [ $filename, $line, '' ];
- }
- }
-
- # Comment-based left pair mark: "..." => ... # loc_left_pair
- $line = 1;
- pos($_) = 0;
- while (m/\G.*?(?:(\w+)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix/smgo) {
- my $key = $1;
- $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
- unless ( defined $key ) {
- warn "Couldn't process loc_left_pair at $filename:$line";
- next;
- }
- $key =~ s/\\'/\'/g;
- push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
- }
-
- # Comment-based pair mark: "..." => "..." # loc_pair
- $line = 1;
- pos($_) = 0;
- while (m/\G.*?(?:(\w+)\s*=>\s*($re_delim)[\}\)\],;]*)?$re_loc_pair_suffix/smgo) {
- my $key = $1;
- my $val = $2;
- $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
- unless ( defined $key && defined $val ) {
- warn "Couldn't process loc_pair at $filename:$line";
- next;
- }
- $val = substr($val, 1, -1);
- $key =~ s/\\'/\'/g;
- $val =~ s/\\'/\'/g;
- push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
- push @{ $FILECAT->{$val} }, [ $filename, $line, '' ];
- }
-
- close (_);
-}
-# }}} extract from strings
-
-sub update {
- my $lang = shift;
- my $file = shift;
- my ( %Lexicon, %Header);
- my $out = '';
-
- unless (!-e $file or -w $file) {
- warn "Can't write to $lang, skipping...\n";
- return;
- }
-
- print "Updating $lang...\n";
-
- my @lines;
- @lines = (<LEXICON>) if open LEXICON, '<', $file;
- @lines = grep { !/^(#(:|\.)\s*|$)/ } @lines;
- while (@lines) {
- my $msghdr = "";
- $msghdr .= shift @lines while ( $lines[0] && $lines[0] !~ /^(#~ )?msgid/ );
-
- my $msgid = "";
-
-# '#~ ' is the prefix of launchpad for msg that's not found the the source
-# we'll remove the prefix later so we can still show them with our own mark
-
- $msgid .= shift @lines while ( $lines[0] && $lines[0] =~ /^(#~ )?(msgid|")/ );
- my $msgstr = "";
- $msgstr .= shift @lines while ( $lines[0] && $lines[0] =~ /^(#~ )?(msgstr|")/ );
-
- last unless $msgid;
-
- chomp $msgid;
- chomp $msgstr;
-
- $msgid =~ s/^#~ //mg;
- $msgstr =~ s/^#~ //mg;
-
- $msgid =~ s/^msgid "(.*)"\s*?$/$1/m or warn "$msgid in $file";
-
- if ( $msgid eq '' ) {
- # null msgid, msgstr will have head info
- $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/ms or warn "$msgstr in $file";
- }
- else {
- $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/m or warn "$msgstr in $file";
- }
-
- if ( $msgid ne '' ) {
- for my $msg ( \$msgid, \$msgstr ) {
- if ( $$msg =~ /\n/ ) {
- my @lines = split /\n/, $$msg;
- $$msg =
- shift @lines; # first line don't need to handle any more
- for (@lines) {
- if (/^"(.*)"\s*$/) {
- $$msg .= $1;
- }
- }
- }
-
- # convert \\n back to \n
- $$msg =~ s/(?!\\)\\n/\n/g;
- }
- }
-
- $Lexicon{$msgid} = $msgstr;
- $Header{$msgid} = $msghdr;
- }
-
- my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ );
-
- foreach my $str ( sort keys %{$FILECAT} ) {
- $Lexicon{$str} ||= '';
- }
- foreach ( sort keys %Lexicon ) {
- my $f = join ( ' ', sort map $_->[0].":".$_->[1], @{ $FILECAT->{$_} } );
- my $nospace = $_;
- $nospace =~ s/ +$//;
-
- if ( !$Lexicon{$_} and $Lexicon{$nospace} ) {
- $Lexicon{$_} =
- $Lexicon{$nospace} . ( ' ' x ( length($_) - length($nospace) ) );
- }
-
- next if !length( $Lexicon{$_} ) and $is_english;
-
- my %seen;
- $out .= $Header{$_} if exists $Header{$_};
-
-
-
- next if (!$f && $_ && !$Lexicon{$_});
- if ( $f && $f !~ /^\s+$/ ) {
-
- $out .= "#: $f\n";
- }
- elsif ($_) {
- $out .= "#: NOT FOUND IN SOURCE\n";
- }
- foreach my $entry ( grep { $_->[2] } @{ $FILECAT->{$_} } ) {
- my ( $file, $line, $var ) = @{$entry};
- $var =~ s/^\s*,\s*//;
- $var =~ s/\s*$//;
- $out .= "#. ($var)\n" unless $seen{$var}++;
- }
- $out .= 'msgid ' . fmt($_) . "msgstr \"$Lexicon{$_}\"\n\n";
- }
-
- open( PO, '>', $file ) or die "Couldn't open '$file' for writing: $!";
- print PO $out;
- close PO;
-
- return 1;
-}
-
-sub escape {
- my $text = shift;
- $text =~ s/\b_(\d+)/%$1/;
- return $text;
-}
-
-sub fmt {
- my $str = shift;
- return "\"$str\"\n" unless $str =~ /\n/;
-
- my $multi_line = ($str =~ /\n(?!\z)/);
- $str =~ s/\n/\\n"\n"/g;
-
- if ($str =~ /\n"$/) {
- chop $str;
- }
- else {
- $str .= "\"\n";
- }
- return $multi_line ? qq(""\n"$str) : qq("$str);
-}
-
-
-__END__
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
projects / freeside.git / blobdiff