From e131b1f71f08b69abb832c1687d1f29682d171f8 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 9 Jul 2015 22:18:55 -0700 Subject: RT 4.2.11, ticket#13852 --- rt/devel/tools/cmd-boilerplate | 89 ++++++++ rt/devel/tools/css_tidy | 59 ++++++ rt/devel/tools/extract-message-catalog | 365 +++++++++++++++++--------------- rt/devel/tools/factory | 373 --------------------------------- rt/devel/tools/merge-rosetta.pl | 51 ----- rt/devel/tools/rt-apache | 46 +++- rt/devel/tools/rt-attributes-editor | 15 +- rt/devel/tools/rt-message-catalog | 224 ++++++++++++++++++++ rt/devel/tools/rt-static-docs | 20 +- 9 files changed, 622 insertions(+), 620 deletions(-) create mode 100644 rt/devel/tools/cmd-boilerplate create mode 100644 rt/devel/tools/css_tidy delete mode 100644 rt/devel/tools/factory delete mode 100644 rt/devel/tools/merge-rosetta.pl create mode 100644 rt/devel/tools/rt-message-catalog (limited to 'rt/devel/tools') diff --git a/rt/devel/tools/cmd-boilerplate b/rt/devel/tools/cmd-boilerplate new file mode 100644 index 0000000..3e8c1bf --- /dev/null +++ b/rt/devel/tools/cmd-boilerplate @@ -0,0 +1,89 @@ +#!/usr/bin/env perl + + +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# +# +# (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 }}} +use strict; +use warnings; +use File::Find; + +File::Find::find({ no_chdir => 1, wanted => \&tag_it}, 'sbin', 'bin'); + +sub tag_it { + my $file = $_; + return unless (-f $file); + return if $file !~ /.in$/; + open( FILE, '<', $file ) or die "Failed to open $file"; + my $content = (join "", ); + close (FILE); + my $new = q'BEGIN { # BEGIN RT CMD BOILERPLATE + require File::Spec; + require Cwd; + my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1]; + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +}'; + unless ($content =~ s/^BEGIN \{ # BEGIN RT CMD BOILERPLATE.*?^\}$/$new/ms) { + return; + } + + warn $file; + + open( FILE, '>', $file ) or die "couldn't write new file"; + print FILE $content; + close FILE; + +} diff --git a/rt/devel/tools/css_tidy b/rt/devel/tools/css_tidy new file mode 100644 index 0000000..a494149 --- /dev/null +++ b/rt/devel/tools/css_tidy @@ -0,0 +1,59 @@ +#!/bin/bash +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# +# +# (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 }}} +set -e + +tmpfile=$(mktemp) + +curl -F css=@$1 -F source=file \ + -F property_formatting=newline -F braces=default -F indent_size=4 \ + -F blank_line_rules_chk=1 -F blank_line_rules=1 \ + -F safe_chk=1 -F safe=1 \ + http://procssor.com/process > $tmpfile + +xml_grep --text_only '*/textarea[@id="download_me"]' --html $tmpfile | expand -t4 | tail -n +2 > $1 diff --git a/rt/devel/tools/extract-message-catalog b/rt/devel/tools/extract-message-catalog index cba84d2..5dd89b8 100644 --- a/rt/devel/tools/extract-message-catalog +++ b/rt/devel/tools/extract-message-catalog @@ -51,10 +51,14 @@ use strict; use warnings; +use open qw/ :std :encoding(UTF-8) /; + use File::Find; use File::Copy; use Regexp::Common; use Carp; +use Locale::PO; +$| = 1; # po dir is for extensions @ARGV = (, , , ) unless @ARGV; @@ -67,17 +71,37 @@ File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, qw(bin # ensure proper escaping and [_1] => %1 transformation foreach my $str ( sort keys %FILECAT ) { - my $entry = $FILECAT{$str}; - my $oldstr = $str; + my $entry = delete $FILECAT{$str}; + next unless @{$entry}; + + my ($filename, $line) = @{ $entry->[0] }; + my $location = "$filename line $line" . (@{$entry} > 1 ? " (and ".(@{$entry}-1)." other places)" : ""); + + if ($str =~ /^\s/m || $str =~ /\s$/m || $str =~ /\\n$/m) { + warn "Extraneous whitespace in '$str' at $location\n"; + } + if (grep {$_->[3]} @{$entry} and $str =~ /([\$\@]\w+)/) { + warn "Interpolated variable '$1' in '$str' at $location\n"; + } - $str =~ s/\\/\\\\/g; - $str =~ s/\"/\\"/g; + my $escape = sub { $_ = shift; s/\b_(\d+)/%$1/; $_ }; $str =~ s/((?($3).")"/eg; $str =~ s/~([\[\]])/$1/g; - delete $FILECAT{$oldstr}; - $FILECAT{$str} = $entry; + 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) ); + + $FILECAT{$po->msgid} = $po; } # update all language dictionaries @@ -93,28 +117,6 @@ foreach my $dict (@ARGV) { update($lang, $dict); } -# warn about various red flags in loc strings -foreach my $str ( sort keys %FILECAT ) { - my $entry = $FILECAT{$str}; - my $entry_count = @$entry; - - # doesn't exist in the current codebase, ignore for now - next if $entry_count == 0; - - my ($filename, $line) = @{ $entry->[0] }; - - my $location = "$filename line $line" . ($entry_count > 1 ? " (and ".($entry_count-1)." other places)" : ""); - - if ($str =~ /^\s/m || $str =~ /\s$/m || $str =~ /\\n$/m) { - warn "Extraneous whitespace in '$str' at $location\n"; - } - - if ($str =~ /([\$\@]\w+)/) { - warn "Interpolated variable '$1' in '$str' at $location\n"; - } -} - - sub extract_strings_from_code { my $file = $_; @@ -129,19 +131,22 @@ sub extract_strings_from_code { return if ( /^[\.#]/ ); return if ( -f "$_.in" ); - print "Looking at $File::Find::name\n"; + print "Looking at $File::Find::name"; my $filename = $File::Find::name; $filename =~ s'^\./''; $filename =~ s'\.in$''; unless (open _, '<', $file) { - print "Cannot open $file for reading ($!), skipping.\n"; + print "\n Cannot open $file for reading ($!), skipping.\n\n"; return; } + my $errors = 0; + 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_paren_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc \(\) $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}; @@ -154,8 +159,7 @@ sub extract_strings_from_code { my ( $all, $vars, $str ) = ( $1, $2, $3 ); $vars =~ s/[\n\r]//g; $line += ( $all =~ tr/\n/\n/ ); - $str =~ s/\\'/\'/g; - #print "STR IS $str\n"; + $str =~ s/\\(['"\\])/$1/g; push @{ $FILECAT{$str} }, [ $filename, $line, $vars ]; } @@ -167,45 +171,73 @@ sub extract_strings_from_code { $line += ( $all =~ tr/\n/\n/ ); my ( $vars, $str ); - if ( $match =~ - /\(\s*($re_delim)(.*?)\s*\)$/so ) { + next unless ( $match =~ /\(\s*($re_delim)(.*?)\s*\)$/so ); - $str = substr( $1, 1, -1 ); # $str comes before $vars now - $vars = $9; - } - else { - next; - } + my $interp = (substr($1,0,1) eq '"' ? 1 : 0); + $str = substr( $1, 1, -1 ); # $str comes before $vars now + $vars = $9; $vars =~ s/[\n\r]//g; - $str =~ s/\\'/\'/g; + $str =~ s/\\(['"\\])/$1/g; - push @{ $FILECAT{$str} }, [ $filename, $line, $vars ]; + push @{ $FILECAT{$str} }, [ $filename, $line, $vars, $interp ]; } + my %seen; # Comment-based mark: "..." # loc $line = 1; pos($_) = 0; - while (m/\G(.*?($re_delim)[\}\)\],;]*$re_loc_suffix)/smgo) { + while (m/\G(.*?($re_delim)[ \{\}\)\],;]*$re_loc_suffix)/smgo) { my ( $all, $str ) = ( $1, $2 ); $line += ( $all =~ tr/\n/\n/ ); + $seen{$line}++; unless ( defined $str ) { - warn "Couldn't process loc at $filename:$line"; + print "\n" unless $errors++; + print " Couldn't process loc at $filename:$line:\n $str\n"; next; } + my $interp = (substr($str,0,1) eq '"' ? 1 : 0); $str = substr($str, 1, -1); - $str =~ s/\\'/\'/g; - push @{ $FILECAT{$str} }, [ $filename, $line, '' ]; + $str =~ s/\\(['"\\])/$1/g; + push @{ $FILECAT{$str} }, [ $filename, $line, '', $interp ]; + } + + # Comment-based mark for list to loc(): ("...", $foo, $bar) # loc() + $line = 1; + pos($_) = 0; + while (m/\G(.*? $RE{balanced}{-parens=>'()'}{-keep} [ \{\}\)\],;]* $re_loc_paren_suffix)/sgx) { + my ( $all, $match ) = ( $1, $2 ); + $line += ( $all =~ tr/\n/\n/ ); + + my ( $vars, $str ); + unless ( $match =~ + /\(\s*($re_delim)(.*?)\s*\)$/so ) { + print "\n" unless $errors++; + print " Failed to match delimited against $match, line $line"; + next; + } + + my $interp = (substr($1,0,1) eq '"' ? 1 : 0); + $str = substr( $1, 1, -1 ); # $str comes before $vars now + $vars = $9; + $seen{$line}++; + + $vars =~ s/[\n\r]//g; + $str =~ s/\\(['"\\])/$1/g; + + push @{ $FILECAT{$str} }, [ $filename, $line, $vars, $interp ]; } # Comment-based qw mark: "qw(...)" # loc_qw $line = 1; pos($_) = 0; - while (m/\G(.*?(?:qw\(([^)]+)\)\s*[\{\}\)\],; ]*)?$re_loc_qw_suffix)/smgo) { + while (m/\G(.*?(?:qw\(([^)]+)\)[ \{\}\)\],;]*)?$re_loc_qw_suffix)/smgo) { my ( $all, $str ) = ( $1, $2 ); $line += ( $all =~ tr/\n/\n/ ); + $seen{$line}++; unless ( defined $str ) { - warn "Couldn't process loc_qw at $filename:$line"; + print "\n" unless $errors++; + print " Couldn't process loc_qw at $filename:$line:\n $str\n"; next; } foreach my $value (split ' ', $str) { @@ -219,167 +251,164 @@ sub extract_strings_from_code { while (m/\G(.*?(?:(\w+|$re_delim)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix)/smgo) { my ( $all, $key ) = ( $1, $2 ); $line += ( $all =~ tr/\n/\n/ ); + $seen{$line}++; unless ( defined $key ) { - warn "Couldn't process loc_left_pair at $filename:$line"; + print "\n" unless $errors++; + print " Couldn't process loc_left_pair at $filename:$line:\n $key\n"; next; } - $key =~ s/\\'/\'/g; - push @{ $FILECAT{$key} }, [ $filename, $line, '' ]; + my $interp = (substr($key,0,1) eq '"' ? 1 : 0); + $key =~ s/\\(['"\\])/$1/g if $key =~ s/^(['"])(.*)\1$/$2/g; # dequote potentially quoted string + push @{ $FILECAT{$key} }, [ $filename, $line, '', $interp ]; } # Comment-based pair mark: "..." => "..." # loc_pair $line = 1; pos($_) = 0; - while (m/\G(.*?(?:(\w+)\s*=>\s*($re_delim)[\}\)\],;]*)?$re_loc_pair_suffix)/smgo) { - my ( $all, $key, $val ) = ( $1, $2, $3 ); + while (m/\G(.*?(?:(\w+|$re_delim)\s*=>\s*($re_delim)[ \{\}\)\],;]*)?$re_loc_pair_suffix)/smgo) { + my ( $all, $key, $val ) = ( $1, $2, $10 ); + $line += ( $all =~ tr/\n/\n/ ); + $seen{$line}++; + unless ( defined $key && defined $val ) { + print "\n" unless $errors++; + print " Couldn't process loc_pair at $filename:$line:\n $key\n $val\n"; + next; + } + my $interp_key = (substr($key,0,1) eq '"' ? 1 : 0); + $key =~ s/\\(['"\\])/$1/g if $key =~ s/^(['"])(.*)\1$/$2/g; # dequote potentially quoted string + push @{ $FILECAT{$key} }, [ $filename, $line, '', $interp_key ]; + + my $interp_val = (substr($val,0,1) eq '"' ? 1 : 0); + $val = substr($val, 1, -1); # dequote always quoted string + $val =~ s/\\(['"\\])/$1/g; + push @{ $FILECAT{$val} }, [ $filename, $line, '', $interp_val ]; + } + + # Specific key foo => "...", #loc{foo} + $line = 1; + pos($_) = 0; + while (m/\G(.*?(\w+|$re_delim)\s*=>\s*($re_delim)(?-s:.*?)\#$re_space_wo_nl*loc\{\2\}$re_space_wo_nl*)$/smgo) { + my ( $all, $key, $val ) = ( $1, $2, $10 ); $line += ( $all =~ tr/\n/\n/ ); + $seen{$line}++; unless ( defined $key && defined $val ) { - warn "Couldn't process loc_pair at $filename:$line"; + warn "Couldn't process loc_pair at $filename:$line:\n $key\n $val\n"; next; } - $val = substr($val, 1, -1); - $key =~ s/\\'/\'/g; - $val =~ s/\\'/\'/g; - push @{ $FILECAT{$key} }, [ $filename, $line, '' ]; - push @{ $FILECAT{$val} }, [ $filename, $line, '' ]; + $val = substr($val, 1, -1); # dequote always quoted string + $val =~ s/\\(['"])/$1/g; + push @{ $FILECAT{$val} }, [ $filename, $line, '' ]; + } + + # Check for ones we missed + $line = 1; + pos($_) = 0; + while (m/\G(.*? \# $re_space_wo_nl* (loc (_\w+|\(\)|{$re_delim})?) $re_space_wo_nl* $)/smgox) { + my ($all, $loc_type) = ($1, $2); + $line += ( $all =~ tr/\n/\n/ ); + next if $seen{$line}; + print "\n" unless $errors++; + print " $loc_type that did not match, line $line of $filename\n"; + } + + if ($errors) { + print "\n" + } else { + print "\r", " " x 100, "\r"; } close (_); } +sub uniq { + my %seen; + return grep { !$seen{$_}++ } @_; +} + 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; + warn "Can't write to $lang, skipping...\n"; + return; } - print "Updating $lang...\n"; - - my @lines; - @lines = () 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; + my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ ); - chomp $msgid; - chomp $msgstr; + print "Updating $lang"; + my $lexicon = Locale::PO->load_file_ashash( $file, "utf-8" ); - $msgid =~ s/^#~ //mg; - $msgstr =~ s/^#~ //mg; + # Default to the empty string for new ones + $lexicon->{$_->msgid} ||= $_ + for values %FILECAT; - $msgid =~ s/^msgid "(.*)"\s*?$/$1/m or warn "$msgid in $file"; + my $errors = 0; + for my $msgid ( keys %{$lexicon} ) { + my $entry = $lexicon->{$msgid}; - 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"; + # Don't output empty translations for english + if (not length $entry->dequote($entry->msgstr) and $is_english) { + delete $lexicon->{$msgid}; + next; } - 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; - } - } + # The PO properties at the top are always fine to leave as-is + next if not length $entry->dequote($msgid); - $Lexicon{$msgid} = $msgstr; - $Header{$msgid} = $msghdr; - } - - my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ ); - - foreach my $str ( 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) ) ); + # Not found in source? Drop it + my $source = $FILECAT{$msgid}; + if (not $source) { + delete $lexicon->{$msgid}; + next; } - next if !length( $Lexicon{$_} ) and $is_english; - - my %seen; - $out .= $Header{$_} if exists $Header{$_}; + # Pull in the properties from the source + $entry->reference( $source->reference ); + $entry->automatic( $source->automatic ); + my $fail = validate_msgstr($lang, + map {$entry->dequote($_)} + $entry->msgid, $entry->msgstr); + next unless $fail; + print "\n" unless $errors++; + print $fail; + } + my @order = map {$_->[0]} + sort {$a->[1] cmp $b->[1]} + map {[$_, $_->dequote($_->msgid)]} + values %{$lexicon}; - next if (!$f && $_ && !$Lexicon{$_}); - if ( $f && $f !~ /^\s+$/ ) { + Locale::PO->save_file_fromarray($file, \@order, "utf-8") + or die "Couldn't update '$file': $!"; - $out .= "#: $f\n"; - } - elsif ($_) { - $out .= "#: NOT FOUND IN SOURCE\n"; - } - foreach my $entry ( sort { $a->[2] cmp $b->[2] } 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"; + if ($errors) { + print "\n"; + } else { + print "\r", " "x100, "\r"; } - - 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 validate_msgstr { + my $lang = shift; + my $msgid = shift; + my $msgstr = shift; -sub fmt { - my $str = shift; - return "\"$str\"\n" unless $str =~ /\n/; + return if not defined $msgstr or $msgstr eq ''; # no translation for this string - my $multi_line = ($str =~ /\n(?!\z)/); - $str =~ s/\n/\\n"\n"/g; + # we uniq because a string can use a placeholder more than once + # (eg %1 %quant(%1, ...) like in our czech localization + my @expected_variables = uniq($msgid =~ /%\d+/g); + my @got_variables = uniq($msgstr =~ /%\d+/g); - if ($str =~ /\n"$/) { - chop $str; - } - else { - $str .= "\"\n"; - } - return $multi_line ? qq(""\n"$str) : qq("$str); + # this catches the case where expected uses %1,%2 and got uses %1,%3 + # unlike a simple @expected_variables == @got_variables + my $expected = join ", ", sort @expected_variables; + my $got = join ", ", sort @got_variables; + return if $expected eq $got; + + return " expected (" . $expected . ") in msgid: $msgid\n" . + " got (" . $got . ") in msgstr: $msgstr\n"; } diff --git a/rt/devel/tools/factory b/rt/devel/tools/factory deleted file mode 100644 index e37fc8f..0000000 --- a/rt/devel/tools/factory +++ /dev/null @@ -1,373 +0,0 @@ -#!/usr/bin/env perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# -# -# (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 }}} -use strict; -use warnings; -use DBI; - -die "Usage: $0 database namespace" if @ARGV != 2; - -my $database = shift; -my $namespace = shift; - -my $CollectionBaseclass = 'RT::SearchBuilder'; -my $RecordBaseclass = 'RT::Record'; - -my $driver = 'mysql'; -my $hostname = 'localhost'; -my $user = 'root'; -my $password = ''; - - -my $LicenseBlock = ''; -my $Attribution = ''; - -my $dsn = "DBI:$driver:database=$database;host=$hostname"; - -my $dbh = DBI->connect( $dsn, $user, $password ); - -#get all tables out of database -my @tables = map { s/^\`\Q$database\E\`\.//; $_ } $dbh->tables(); - -my ( %tablemap, $typemap, %modulemap ); - -foreach my $table (@tables) { - $table =~ s/\`//g; - next if ($table eq 'sessions'); - $table = ucfirst($table); - $table =~ s/field/Field/; - $table =~ s/group/Group/; - $table =~ s/custom/Custom/; - $table =~ s/member/Member/; - $table =~ s/Scripaction/ScripAction/g; - $table =~ s/condition/Condition/g; - $table =~ s/value/Value/; - $table =~ s/Acl/ACL/g; - $tablemap{$table} = $table; - $modulemap{$table} = $table; - if ( $table =~ /^(.*)s$/ ) { - $tablemap{$1} = $table; - $modulemap{$1} = $1; - } -} -$tablemap{'CreatedBy'} = 'User'; -$tablemap{'UpdatedBy'} = 'User'; - -my %typemap; -$typemap{'id'} = 'ro'; -$typemap{'Creator'} = 'auto'; -$typemap{'Created'} = 'auto'; -$typemap{'Updated'} = 'auto'; -$typemap{'UpdatedBy'} = 'auto'; -$typemap{'LastUpdated'} = 'auto'; -$typemap{'LastUpdatedBy'} = 'auto'; - -foreach my $table (@tables) { - next if ($table eq 'sessions'); - my $tablesingle = $table; - $tablesingle =~ s/s$//; - my $tableplural = $tablesingle . "s"; - - if ( $tablesingle eq 'ACL' ) { - $tablesingle = "ACE"; - $tableplural = "ACL"; - } - - my %requirements; - - my $CollectionClassName = $namespace . "::" . $tableplural; - my $RecordClassName = $namespace . "::" . $tablesingle; - - my $path = $namespace; - $path =~ s/::/\//g; - - my $RecordClassPath = $path . "/" . $tablesingle . ".pm"; - my $CollectionClassPath = $path . "/" . $tableplural . ".pm"; - - #create a collection class - my $CreateInParams; - my $CreateOutParams; - my $ClassAccessible = ""; - my $FieldsPod = ""; - my $CreatePod = ""; - my $RecordInit = ""; - my %fields; - - - my $introspection = $dbh->prepare("SELECT * from $table where id is null"); - $introspection->execute(); - my @names =@{ $introspection->{'NAME'}}; - my @types = @{$introspection->{'TYPE'}}; - my @is_blob = @{$introspection->{'mysql_is_blob'}}; - my @is_num = @{$introspection->{'mysql_is_num'}}; - - my %blobness = (); - my %sqltypes = (); - my %numeric = (); - foreach my $name (@names) { - $sqltypes{$name} = shift @types; - $blobness{$name} = (shift @is_blob || "0"); - $numeric{$name} = (shift @is_num || "0"); - } - - - my $sth = $dbh->prepare("DESCRIBE $table"); - $sth->execute; - - while ( my $row = $sth->fetchrow_hashref() ) { - my $field = $row->{'Field'}; - my $type = $row->{'Type'}; - my $default = $row->{'Default'}; - my $length = 0; - if ($type =~ /^(?:.*?)\((\d+)\)$/) { - $length = $1; - } - $fields{$field} = 1; - - #generate the 'accessible' datastructure - - no warnings 'uninitialized'; - - if ( $typemap{$field} eq 'auto' ) { - $ClassAccessible .= " $field => - {read => 1, auto => 1,"; - } - elsif ( $typemap{$field} eq 'ro' ) { - $ClassAccessible .= " $field => - {read => 1,"; - } - else { - $ClassAccessible .= " $field => - {read => 1, write => 1,"; - - } - $ClassAccessible .= " sql_type => $sqltypes{$field}, length => $length, is_blob => $blobness{$field}, is_numeric => $numeric{$field}, "; - $ClassAccessible .= " type => '$type', default => '$default'},\n"; - - #generate pod for the accessible fields - $FieldsPod .= " -=head2 $field - -Returns the current value of $field. -(In the database, $field is stored as $type.) - -"; - - unless ( exists $typemap{$field} && ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' )) { - $FieldsPod .= " - -=head2 Set$field VALUE - - -Set $field to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, $field will be stored as a $type.) - -"; - } - - $FieldsPod .= " -=cut - -"; - - if ( $modulemap{$field} ) { - $FieldsPod .= " -=head2 ${field}Obj - -Returns the $modulemap{$field} Object which has the id returned by $field - - -=cut - -sub ${field}Obj { - my \$self = shift; - my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser); - \$$field->Load(\$self->__Value('$field')); - return(\$$field); -} -"; - $requirements{ $tablemap{$field} } = - "use ${namespace}::$modulemap{$field};"; - - } - - unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) { - - #generate create statement - $CreateInParams .= " $field => '$default',\n"; - $CreateOutParams .= - " $field => \$args{'$field'},\n"; - - #gerenate pod for the create statement - $CreatePod .= " $type '$field'"; - $CreatePod .= " defaults to '$default'" if ($default); - $CreatePod .= ".\n"; - - } - - } - - my $Create = ""; - $CreatePod .= "\n=cut\n\n"; - - my $CollectionClass = $LicenseBlock . $Attribution . - - " -use $RecordClassName; - -use base '$CollectionBaseclass'; - -sub Table { '$table'} - -sub _Init { -"; - - if ( $fields{'SortOrder'} && $fields{'Name'} ) { - $CollectionClass .= " - - # By default, order by SortOrder - \$self->OrderByCols( - { ALIAS => 'main', - FIELD => 'SortOrder', - ORDER => 'ASC' }, - { ALIAS => 'main', - FIELD => 'Name', - ORDER => 'ASC' }, - { ALIAS => 'main', - FIELD => 'id', - ORDER => 'ASC' }, - ); -"; - } - elsif ( $fields{'SortOrder'} ) { - - $CollectionClass .= " - - # By default, order by SortOrder - \$self->OrderByCols( - { ALIAS => 'main', - FIELD => 'SortOrder', - ORDER => 'ASC' }, - { ALIAS => 'main', - FIELD => 'id', - ORDER => 'ASC' }, - ); -"; - } - $CollectionClass .= " - return ( \$self->SUPER::_Init(\@_) ); -} - - -=head2 NewItem - -Returns an empty new $RecordClassName item - -=cut - -sub NewItem { - my \$self = shift; - return($RecordClassName->new(\$self->CurrentUser)); -} -" . MagicImport($CollectionClassName); - - my $RecordClassHeader = $Attribution . " -"; - - foreach my $key ( keys %requirements ) { - $RecordClassHeader .= $requirements{$key} . "\n"; - } - $RecordClassHeader .= "use base '$RecordBaseclass'; - -sub Table {'$table'} - -"; - - my $RecordClass = $LicenseBlock . $RecordClassHeader . " - -$RecordInit - -$FieldsPod - -sub _CoreAccessible { - { - -$ClassAccessible - } -}; - -" . MagicImport($RecordClassName); - - print "About to make $RecordClassPath, $CollectionClassPath\n"; - `mkdir -p $path`; - - open( RECORD, '>>', $RecordClassPath ) or die $!; - print RECORD $RecordClass; - close(RECORD); - - open( COL, '>>', $CollectionClassPath ) or die $!; - print COL $CollectionClass; - close(COL); - -} - -sub MagicImport { - my $class = shift; - - #if (exists \$warnings::{unimport}) { - # no warnings qw(redefine); - - my $content = "RT::Base->_ImportOverlays(); - -1; -"; - return $content; -} - - diff --git a/rt/devel/tools/merge-rosetta.pl b/rt/devel/tools/merge-rosetta.pl deleted file mode 100644 index 3d40a99..0000000 --- a/rt/devel/tools/merge-rosetta.pl +++ /dev/null @@ -1,51 +0,0 @@ -#!/usr/bin/env perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# -# -# (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 }}} -use strict; -use warnings; -exec('sbin/rt-message-catalog', 'rosetta', @ARGV); diff --git a/rt/devel/tools/rt-apache b/rt/devel/tools/rt-apache index f9942ed..23290a0 100644 --- a/rt/devel/tools/rt-apache +++ b/rt/devel/tools/rt-apache @@ -77,6 +77,7 @@ GetOptions( \%opt, "port|p=i", "ssl:i", "single|X", + "auth|A:s", "modules=s", @@ -125,6 +126,21 @@ unless ($opt{port}) { # Set ssl port if they want it but didn't provide a number $opt{ssl} = 4430 if defined $opt{ssl} and not $opt{ssl}; +# Default auth to on if they set $WebRemoteUserAuth +$opt{auth} = '' if not exists $opt{auth} and parseconf( "WebRemoteUserAuth" ); + +# Set an auth path if they want it but didn't pass a path +if (defined $opt{auth} and not $opt{auth}) { + $opt{auth} = "$opt{root}/var/htpasswd"; + unless (-f $opt{auth}) { + open(my $fh, ">", $opt{auth}) or die "Can't create default htpasswd: $!"; + print $fh 'root:$apr1$TZA4Y0DL$DS5ZhDH8QrhB.uAtvNJmh.' . "\n"; + close $fh or die "Can't create default htpasswd: $!"; + } +} elsif ($opt{auth} and not -f $opt{auth}) { + die "Can't read htpasswd file $opt{auth}!"; +} + # Parse out the WebPath my $path = parseconf( "WebPath" ) || ""; @@ -133,6 +149,7 @@ $template =~ s/\$PORT/$opt{port}/g; $template =~ s!\$PATH/!$path/!g; $template =~ s!\$PATH!$path || "/"!ge; $template =~ s/\$SSL/$opt{ssl} || 0/ge; +$template =~ s/\$AUTH/$opt{auth}/ge; $template =~ s/\$RTHOME/$opt{root}/g; $template =~ s/\$MODULES/$opt{modules}/g; $template =~ s/\$TOOLS/$FindBin::Bin/g; @@ -227,7 +244,7 @@ environment variable, or C. Determines the Apache module which is used. By default, the first one of that list which exists will be used. See also L. -=item --port B +=item --port B, -p Choses the port to listen on. By default, this is parsed from the F, and falling back to 8888. @@ -238,6 +255,13 @@ Also listens on the provided port with HTTPS, using a self-signed certificate for C. If the port number is not specified, defaults to port 4430. +=item --auth [F], -A + +Turns on HTTP Basic Authentication; this is done automatically if +C<$WebRemoteUserAuth> is set in the F. The provided +path should be to a F file; if not given, defaults to a file +containing only user C with password C. + =item --single, -X Run only one process or thread, for ease of debugging. @@ -402,10 +426,10 @@ Alias $PATH/NoAuth/images/ $RTHOME/share/html/NoAuth/images/ FastCgiServer $RTHOME/bin/mason_handler.fcgi -processes $PROCESSES -idle-timeout 300 ScriptAlias $PATH $RTHOME/bin/mason_handler.fcgi/ - Order allow,deny - Allow from all - Options +ExecCGI - AddHandler fastcgi-script fcgi + Order allow,deny + Allow from all + Options +ExecCGI + AddHandler fastcgi-script fcgi @@ -416,10 +440,10 @@ Alias $PATH/NoAuth/images/ $RTHOME/share/html/NoAuth/images/ FcgidMaxRequestLen 1073741824 ScriptAlias $PATH $RTHOME/bin/mason_handler.fcgi/ - Order allow,deny - Allow from all - Options +ExecCGI - AddHandler fcgid-script fcgi + Order allow,deny + Allow from all + Options +ExecCGI + AddHandler fcgid-script fcgi @@ -433,7 +457,7 @@ Alias $PATH/NoAuth/images/ $RTHOME/share/html/NoAuth/images/ SSLMutex file:$RTHOME/var/ssl_mutex SSLEngine on - SSLCertificateFile $TOOLS/localhost.crt - SSLCertificateKeyFile $TOOLS/localhost.key + SSLCertificateFile $TOOLS/localhost.crt + SSLCertificateKeyFile $TOOLS/localhost.key diff --git a/rt/devel/tools/rt-attributes-editor b/rt/devel/tools/rt-attributes-editor index 15436ac..cc69a02 100644 --- a/rt/devel/tools/rt-attributes-editor +++ b/rt/devel/tools/rt-attributes-editor @@ -49,19 +49,12 @@ use strict; use warnings; use Term::EditorEdit; -use Getopt::Long; -my ($help, $key, $id); -GetOptions('help|h' => \$help, 'key|k=s' => \$key, 'id=i' => \$id); -if ( $help || !$id ) { - require Pod::Usage; - Pod::Usage::pod2usage({ verbose => 2 }); - exit; -} +use RT::Interface::CLI qw(Init); +my ($key, $id); +Init('key|k=s' => \$key, 'id=i' => \$id); -require RT; -RT::LoadConfig(); -RT::Init(); +Pod::Usage::pod2usage({ verbose => 2 }) unless $id; require RT::Attribute; my $attr = RT::Attribute->new( RT->SystemUser ); diff --git a/rt/devel/tools/rt-message-catalog b/rt/devel/tools/rt-message-catalog new file mode 100644 index 0000000..f1a3158 --- /dev/null +++ b/rt/devel/tools/rt-message-catalog @@ -0,0 +1,224 @@ +#!/usr/bin/env perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# +# +# (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 }}} +use strict; +use warnings; + +use Locale::PO; +use Getopt::Long; +use File::Temp 'tempdir'; + +use constant PO_DIR => 'share/po'; + +use constant BOUNDARY => 20; + +sub usage { + warn @_, "\n\n" if @_; + warn <<' USAGE'; +usages: + + rt-message-catalog stats [po-directory] + rt-message-catalog clean + rt-message-catalog rosetta download-url + rt-message-catalog extract [po-file ...] + +stats: Print stats for each translation. + +clean: Remove unused and identity translations + +rosetta: Merge translations from Launchpad's Rosetta; Requires a + Launchpad translations export url. + +extract: Extract message catalogs from source code and report common errors. + + If passed a specific translation file, only that file is updated. + (Not recommended except for debugging.) + + USAGE + exit 1; +} + +my $command = shift; +usage() unless $command; +usage("Unknown command '$command'") + unless main->can($command); + +main->can($command)->( @ARGV ); + +exit; + +sub stats { + my $dir = shift || PO_DIR; + + my $max = 0; + my %res = (); + + foreach my $po_file (<$dir/*.po>) { + my $array = Locale::PO->load_file_asarray( $po_file, "utf-8" ); + + $res{$po_file} = 0; + + my $size = 0; + foreach my $entry ( splice @$array, 1 ) { + next if $entry->obsolete; + next if $entry->reference && $entry->reference =~ /NOT FOUND IN SOURCE/; + $size++; + next unless length $entry->dequote( $entry->msgstr ); + $res{$po_file}++; + } + $max = $size if $max < $size; + } + + my $width = length($max); + foreach my $po_file ( sort { $res{$b} <=> $res{$a} } keys %res ) { + my $tr = $res{$po_file}; + my $perc = int($tr*1000/$max)/10; + printf "%-20s %${width}d/%${width}d (%.1f%%)\n", "$po_file:", $tr, $max, $perc; + } +} + +sub clean { + my $dir = shift || PO_DIR; + + foreach my $po_file (<$dir/*.po>) { + my $array = Locale::PO->load_file_asarray( $po_file, "utf-8" ); + foreach my $entry ( splice @$array, 1 ) { + # Replace identical translations with the empty string + $entry->msgstr("") if $entry->msgstr eq $entry->msgid; + + # Skip NOT FOUND IN SOURCE entries + next if $entry->obsolete; + next if $entry->reference && $entry->reference =~ /NOT FOUND IN SOURCE/; + + push @$array, $entry; + } + Locale::PO->save_file_fromarray($po_file, $array, "utf-8"); + } +} + +sub rosetta { + my $url = shift or die 'must provide Rosetta download url or directory with new po files'; + + my $dir; + if ( $url =~ m{^[a-z]+://} ) { + $dir = tempdir(); + my ($fname) = $url =~ m{([^/]+)$}; + + print "Downloading $url\n"; + require LWP::Simple; + LWP::Simple::getstore($url => "$dir/$fname"); + + print "Extracting $dir/$fname\n"; + require Archive::Extract; + my $ae = Archive::Extract->new(archive => "$dir/$fname"); + my $ok = $ae->extract( to => $dir ); + } + elsif ( -e $url && -d _ ) { + $dir = $url; + } + else { + die "Is not URL or directory: '$url'"; + } + + my @files = ( <$dir/*/*/*.po>, <$dir/*/*.po>, <$dir/*.po> ); + unless ( @files ) { + print STDERR "No files in $dir/rt/*.po and $dir/*.po\n"; + exit; + } + + for my $file ( @files ) { + my ($lang) = $file =~ m/([\w_]+)\.po/; + my $fn_orig = PO_DIR . "/$lang.po"; + + my $load_from = $fn_orig; + $load_from = PO_DIR . "/rt.pot" unless -e $load_from; + my $orig = Locale::PO->load_file_ashash( $fn_orig, "utf-8" ); + + print "$file -> $fn_orig\n"; + + my $rosetta = Locale::PO->load_file_asarray( $file, "utf-8" ); + + # We're merging in the current hash as fallbacks for the rosetta hash + my $translated = 0; + foreach my $entry ( splice @$rosetta, 1 ) { + # Skip no longer in source entries + next if $entry->obsolete; + next if $entry->reference && $entry->reference =~ /NOT FOUND IN SOURCE/; + + # Update to what the old po file had, if we have nothing + my $oldval = $orig->{$entry->msgid}; + if (not length $entry->dequote($entry->msgstr) and $oldval) { + $entry->msgstr($oldval->dequote($oldval->msgstr)); + } + + # Replace identical translations with the empty string + $entry->msgstr("") if $entry->msgstr eq $entry->msgid; + + # Drop "fuzzy" information + $entry->fuzzy_msgctxt(undef); + $entry->fuzzy_msgid(undef); + $entry->fuzzy_msgid_plural(undef); + + $translated++ if length $entry->dequote($entry->msgstr); + push @$rosetta, $entry; + } + + my $perc = int($translated/(@$rosetta - 1) * 100 + 0.5); + if ( $perc < BOUNDARY and $lang !~ /^en(_[A-Z]{2})?$/) { + unlink $fn_orig; + next; + } + + Locale::PO->save_file_fromarray($fn_orig, $rosetta, "utf-8"); + } + extract(); +} + +sub extract { + system($^X, 'devel/tools/extract-message-catalog', @_); +} diff --git a/rt/devel/tools/rt-static-docs b/rt/devel/tools/rt-static-docs index 8ad86b1..c8038c0 100644 --- a/rt/devel/tools/rt-static-docs +++ b/rt/devel/tools/rt-static-docs @@ -54,6 +54,7 @@ use File::Temp; use File::Spec; use File::Path qw(make_path rmtree); use File::Copy qw(copy); +use Encode qw(decode_utf8); use HTML::Entities qw(encode_entities); use RT::Pod::HTMLBatch; @@ -142,14 +143,21 @@ for my $file () { open my $source, "<", $file or warn "Can't open $file: $!", next; - open my $html, ">", $dest - or warn "Can't open $dest: $!", next; + my $str = ""; + $str .= encode_entities(decode_utf8($_)) while <$source>; + close $source; - print $html "
";
-    print $html encode_entities($_) while <$source>;
-    print $html "
"; + $str = "
$str
"; + $str =~ s{\bdocs/([a-z_-]+)\.pod\b}{docs/$1.pod}ig; + $str =~ s{\betc/(RT_Config)\.pm\b}{etc/$1.pm}g; + $str =~ s{\betc/(UPRGADING\.mysql)\b}{etc/$1}g; + $str =~ s{\b(https?://(?!rt\.example\.com)[.a-z0-9/_:-]+(?$1}ig; + $str =~ s{\b([\w-]+\@(lists\.)?bestpractical.com)\b}{$1}g; - close $source; close $html; + open my $html, ">", $dest + or warn "Can't open $dest: $!", next; + print $html $str; + close $html; $converter->note_for_contents_file([$name], $file, $dest); } -- cgit v1.1