Change 22126 by [EMAIL PROTECTED] on 2004/01/13 07:16:33
Upgrade to Locale::Maketext 1.07.
Affected files ...
... //depot/perl/MANIFEST#1127 edit
... //depot/perl/lib/Locale/Maketext.pm#8 edit
... //depot/perl/lib/Locale/Maketext.pod#9 edit
... //depot/perl/lib/Locale/Maketext/ChangeLog#6 edit
... //depot/perl/lib/Locale/Maketext/README#4 edit
... //depot/perl/lib/Locale/Maketext/t/04super.t#1 add
... //depot/perl/lib/Locale/Maketext/t/05super.t#1 add
Differences ...
==== //depot/perl/MANIFEST#1127 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1126~22101~ Thu Jan 8 13:00:56 2004
+++ perl/MANIFEST Mon Jan 12 23:16:33 2004
@@ -1124,7 +1124,7 @@
lib/ExtUtils/MakeMaker/vmsish.pm Platform agnostic vmsish.pm
lib/ExtUtils/Manifest.pm Utilities to write MANIFEST files
lib/ExtUtils/MANIFEST.SKIP The default MANIFEST.SKIP
-lib/ExtUtils/META.yml ExtUtils::MakeMaker metadata
+lib/ExtUtils/META.yml ExtUtils::MakeMaker metadata
lib/ExtUtils/Mkbootstrap.pm Writes a bootstrap file (see MakeMaker)
lib/ExtUtils/Mksymlists.pm Writes a linker options file for extensions
lib/ExtUtils/MM_Any.pm MakeMaker methods for Any OS
@@ -1148,7 +1148,7 @@
lib/ExtUtils/t/00compile.t See if MakeMaker modules compile
lib/ExtUtils/t/backwards.t Check MakeMaker's backwards compatibility
lib/ExtUtils/t/basic.t See if MakeMaker can build a module
-lib/ExtUtils/t/bytes.t Test ExtUtils::MakeMaker::bytes
+lib/ExtUtils/t/bytes.t Test ExtUtils::MakeMaker::bytes
lib/ExtUtils/t/Command.t See if ExtUtils::Command works (Win32 only)
lib/ExtUtils/t/Constant.t See if ExtUtils::Constant works
lib/ExtUtils/t/Embed.t See if ExtUtils::Embed and embedding works
@@ -1313,10 +1313,13 @@
lib/Locale/Maketext.pm Locale::Maketext
lib/Locale/Maketext.pod Locale::Maketext documentation
lib/Locale/Maketext/README Locale::Maketext
+lib/Locale/Maketext/META.yml Locale::Maketext
lib/Locale/Maketext/t/00about.t See if Locale::Maketext works
lib/Locale/Maketext/t/01make.t See if Locale::Maketext works
lib/Locale/Maketext/t/02get.t See if Locale::Maketext works
lib/Locale/Maketext/t/03http.t See if Locale::Maketext works
+lib/Locale/Maketext/t/04super.t See if Locale::Maketext works
+lib/Locale/Maketext/t/05super.t See if Locale::Maketext works
lib/Locale/Maketext/t/90utf8.t Locale::Maketext
lib/Locale/Maketext/TPJ13.pod Locale::Maketext documentation article
lib/locale.pm For "use locale"
@@ -2488,7 +2491,7 @@
proto.h Prototypes
qnx/ar QNX implementation of "ar" utility
qnx/cpp QNX implementation of preprocessor filter
-README The Instructions
+README The Instructions
README.aix Perl notes for AIX
README.amiga Perl notes for AmigaOS
README.apollo Perl notes for Apollo DomainOS
@@ -2509,7 +2512,7 @@
README.machten Perl notes for Power MachTen
README.macos Perl notes for Mac OS (Classic)
README.macosx Perl notes for Mac OS X
-README.micro Notes about microperl
+README.micro Notes about microperl
README.mint Perl notes for MiNT
README.mpeix Perl notes for MPE/iX
README.netware Perl notes for NetWare
@@ -2526,7 +2529,7 @@
README.vms Perl notes for VMS
README.vos Perl notes for Stratus VOS
README.win32 Perl notes for Windows
-README.Y2K Notes about Year 2000 concerns
+README.Y2K Notes about Year 2000 concerns
reentr.c Reentrant interfaces
reentr.h Reentrant interfaces
reentr.pl Reentrant interfaces
==== //depot/perl/lib/Locale/Maketext.pm#8 (text) ====
Index: perl/lib/Locale/Maketext.pm
--- perl/lib/Locale/Maketext.pm#7~19987~ Fri Jul 4 06:09:04 2003
+++ perl/lib/Locale/Maketext.pm Mon Jan 12 23:16:33 2004
@@ -1,11 +1,11 @@
-# Time-stamp: "2003-06-21 23:41:57 AHDT"
+# Time-stamp: "2004-01-11 19:02:37 AST"
require 5;
package Locale::Maketext;
use strict;
use vars qw( @ISA $VERSION $MATCH_SUPERS $USING_LANGUAGE_TAGS
- $USE_LITERALS);
+ $USE_LITERALS $MATCH_SUPERS_TIGHTLY);
use Carp ();
use I18N::LangTags 0.21 ();
@@ -14,11 +14,12 @@
BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } }
# define the constant 'DEBUG' at compile-time
-$VERSION = "1.06";
+$VERSION = "1.07";
@ISA = ();
$MATCH_SUPERS = 1;
-$USING_LANGUAGE_TAGS = 1;
+$MATCH_SUPERS_TIGHTLY = 1;
+$USING_LANGUAGE_TAGS = 1;
# Turning this off is somewhat of a security risk in that little or no
# checking will be done on the legality of tokens passed to the
# eval("use $module_name") in _try_use. If you turn this off, you have
@@ -246,36 +247,31 @@
sub get_handle { # This is a constructor and, yes, it CAN FAIL.
# Its class argument has to be the base class for the current
# application's l10n files.
+
my($base_class, @languages) = @_;
$base_class = ref($base_class) || $base_class;
# Complain if they use __PACKAGE__ as a project base class?
- unless(@languages) { # Calling with no args is magical! wooo, magic!
- if(length( $ENV{'REQUEST_METHOD'} || '' )) { # I'm a CGI
- @languages = $base_class->_http_accept_langs;
- # it's off in its own routine because it's complicated
-
- } else { # Not running as a CGI: try to puzzle out from the environment
- if(length( $ENV{'LANG'} || '' )) {
- push @languages, split m/[,:]/, $ENV{'LANG'};
- # LANG can be only /one/ locale as far as I know, but what the hey.
- }
- if(length( $ENV{'LANGUAGE'} || '' )) {
- push @languages, split m/[,:]/, $ENV{'LANGUAGE'};
- }
- print "Noting ENV LANG ", join(',', @languages),"\n" if DEBUG;
- # Those are really locale IDs, but they get xlated a few lines down.
-
- if(&_try_use('Win32::Locale')) {
- # If we have that module installed...
- push @languages, Win32::Locale::get_language()
- if defined &Win32::Locale::get_language;
- }
- }
+ @languages = $base_class->_ambient_langprefs() unless @languages;
+ @languages = $base_class->_langtag_munging(@languages);
+
+ my %seen;
+ foreach my $module_name ( map { $base_class . "::" . $_ } @languages ) {
+ next unless length $module_name; # sanity
+ next if $seen{$module_name}++ # Already been here, and it was no-go
+ || !&_try_use($module_name); # Try to use() it, but can't it.
+ return($module_name->new); # Make it!
}
- #------------------------------------------------------------------------
- print "Lgs1: ", map("<$_>", @languages), "\n" if DEBUG;
+ return undef; # Fail!
+}
+
+###########################################################################
+
+sub _langtag_munging {
+ my($base_class, @languages) = @_;
+
+ DEBUG and print "Lgs1: ", map("<$_>", @languages), "\n";
if($USING_LANGUAGE_TAGS) {
@languages = map &I18N::LangTags::locale2language_tag($_), @languages;
@@ -283,17 +279,21 @@
# if it's a locale ID, try converting to a lg tag (untainted),
# otherwise nix it.
- push @languages, map I18N::LangTags::super_languages($_), @languages
- if $MATCH_SUPERS;
-
- @languages = map { $_, I18N::LangTags::alternate_language_tags($_) }
+ @languages = map {; $_, I18N::LangTags::alternate_language_tags($_) }
@languages; # catch alternation
+ DEBUG and print "Lgs\@", __LINE__, ": ", map("<$_>", @languages), "\n";
+
+ if( defined &I18N::LangTags::panic_languages ) {
+ push @languages, I18N::LangTags::panic_languages(@languages);
+ DEBUG and print "After adding panic languages:\n",
+ " Lgs\@", __LINE__, ": ", map("<$_>", @languages), "\n";
+ }
- push @languages, I18N::LangTags::panic_languages(@languages)
- if defined &I18N::LangTags::panic_languages;
+ @languages = $base_class->_add_supers( @languages );
push @languages, $base_class->fallback_languages;
# You are free to override fallback_languages to return empty-list!
+ DEBUG and print "Lgs\@", __LINE__, ": ", map("<$_>", @languages), "\n";
@languages = # final bit of processing:
map {
@@ -303,23 +303,99 @@
$it;
} @languages
;
+ DEBUG and print "Nearing end of munging:\n",
+ " Lgs\@", __LINE__, ": ", map("<$_>", @languages), "\n";
+ } else {
+ DEBUG and print "Bypassing language-tags.\n",
+ " Lgs\@", __LINE__, ": ", map("<$_>", @languages), "\n";
}
- print "Lgs2: ", map("<$_>", @languages), "\n" if DEBUG > 1;
+
+ DEBUG and print "Before adding fallback classes:\n",
+ " Lgs\@", __LINE__, ": ", map("<$_>", @languages), "\n";
push @languages, $base_class->fallback_language_classes;
# You are free to override that to return whatever.
+ DEBUG and print "Finally:\n",
+ " Lgs\@", __LINE__, ": ", map("<$_>", @languages), "\n";
- my %seen = ();
- foreach my $module_name ( map { $base_class . "::" . $_ } @languages )
- {
- next unless length $module_name; # sanity
- next if $seen{$module_name}++ # Already been here, and it was no-go
- || !&_try_use($module_name); # Try to use() it, but can't it.
- return($module_name->new); # Make it!
+ return @languages;
+}
+
+###########################################################################
+
+sub _ambient_langprefs {
+ my $base_class = $_[0];
+
+ return $base_class->_http_accept_langs
+ if length( $ENV{'REQUEST_METHOD'} || '' ); # I'm a CGI
+ # it's off in its own routine because it's complicated
+
+ # Not running as a CGI: try to puzzle out from the environment
+ my @languages;
+
+ if(length( $ENV{'LANG'} || '' )) {
+ push @languages, split m/[,:]/, $ENV{'LANG'};
+ # LANG can be only /one/ locale as far as I know, but what the hey.
}
- return undef; # Fail!
+ if(length( $ENV{'LANGUAGE'} || '' )) {
+ push @languages, split m/[,:]/, $ENV{'LANGUAGE'};
+ }
+
+ print "Noting ENV LANG ", join(',', @languages),"\n" if DEBUG;
+ # Those are really locale IDs, but they get xlated a few lines down.
+
+ if(&_try_use('Win32::Locale')) {
+ # If we have that module installed...
+ push @languages, Win32::Locale::get_language() || ''
+ if defined &Win32::Locale::get_language;
+ }
+
+ return @languages;
+}
+
+###########################################################################
+
+sub _add_supers {
+ my($base_class, @languages) = @_;
+
+ if(!$MATCH_SUPERS) {
+ # Nothing
+ DEBUG and print "Bypassing any super-matching.\n",
+ " Lgs\@", __LINE__, ": ", map("<$_>", @languages), "\n";
+
+ } elsif( $MATCH_SUPERS_TIGHTLY ) {
+ DEBUG and print "Before adding new supers tightly:\n",
+ " Lgs\@", __LINE__, ": ", map("<$_>", @languages), "\n";
+
+ my %seen_encoded;
+ foreach my $lang (@languages) {
+ $seen_encoded{ I18N::LangTags::encode_language_tag($lang) } = 1
+ }
+
+ my(@output_languages);
+ foreach my $lang (@languages) {
+ push @output_languages, $lang;
+ foreach my $s ( I18N::LangTags::super_languages($lang) ) {
+ # Note that super_languages returns the longest first.
+ last if $seen_encoded{ I18N::LangTags::encode_language_tag($s) };
+ push @output_languages, $s;
+ }
+ }
+ @languages = @output_languages;
+
+ DEBUG and print "After adding new supers tightly:\n",
+ " Lgs\@", __LINE__, ": ", map("<$_>", @languages), "\n";
+
+ } else {
+
+ push @languages, map I18N::LangTags::super_languages($_), @languages;
+ DEBUG and print "After adding supers to end:\n",
+ " Lgs\@", __LINE__, ": ", map("<$_>", @languages), "\n";
+ }
+
+ return @languages;
}
###########################################################################
==== //depot/perl/lib/Locale/Maketext.pod#9 (text) ====
Index: perl/lib/Locale/Maketext.pod
--- perl/lib/Locale/Maketext.pod#8~19149~ Sat Apr 5 12:44:25 2003
+++ perl/lib/Locale/Maketext.pod Mon Jan 12 23:16:33 2004
@@ -1,5 +1,5 @@
-# Time-stamp: "2003-04-02 11:10:32 AHST"
+# Time-stamp: "2004-01-11 18:35:34 AST"
=head1 NAME
@@ -1304,7 +1304,7 @@
=head1 COPYRIGHT AND DISCLAIMER
-Copyright (c) 1999-2003 Sean M. Burke. All rights reserved.
+Copyright (c) 1999-2004 Sean M. Burke. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
==== //depot/perl/lib/Locale/Maketext/ChangeLog#6 (text) ====
Index: perl/lib/Locale/Maketext/ChangeLog
--- perl/lib/Locale/Maketext/ChangeLog#5~19987~ Fri Jul 4 06:09:04 2003
+++ perl/lib/Locale/Maketext/ChangeLog Mon Jan 12 23:16:33 2004
@@ -1,6 +1,26 @@
Revision history for Perl suite Locale::Maketext
- Time-stamp: "2003-06-21 23:38:38 AHDT"
+ Time-stamp: "2004-01-11 18:30:43 AST"
+2004-01-11 Sean M. Burke [EMAIL PROTECTED]
+
+ * Release 1.07: Now uses a new and different rule for implicating
+ superordinate language tags in accept-language lists. Previously,
+ superordinates were just tacked onto the, so "en-US, ja", turned
+ into "en-US, ja, en". However, this turned out to be suboptimal
+ for many users of RT, a popular system using Maketext. The new
+ rule is that a tag implicates superordinate forms right after it,
+ unless those tags are explicitly stated elsewhere in the
+ accept-languages list. So "en-US ja" becomes "en-US en ja". If
+ you want "en" to be really lower, you have to actually state it
+ there: "en-US ja en" is left as-is.
+
+ The 04super.t and 05super.t tests in t/ have many many examples of
+ this, including some strange corner cases.
+
+ (In implementing this change, I also refactored some code in
+ Maketext.pm, for hopefully improved readability. However,
+ the above is the only actual change in behavior.)
+
2003-06-21 Sean M. Burke [EMAIL PROTECTED]
* Release 1.06: Now has "use utf8" to make the things work
happily. Some fancy footwork is required to make this work under
==== //depot/perl/lib/Locale/Maketext/README#4 (text) ====
Index: perl/lib/Locale/Maketext/README
--- perl/lib/Locale/Maketext/README#3~19149~ Sat Apr 5 12:44:25 2003
+++ perl/lib/Locale/Maketext/README Mon Jan 12 23:16:33 2004
@@ -1,5 +1,5 @@
README for Locale::Maketext
- Time-stamp: "2003-04-02 11:06:17 AHST"
+ Time-stamp: "2004-01-11 18:36:09 AST"
Locale::Maketext
@@ -61,7 +61,7 @@
COPYRIGHT
-Copyright 1999-2003, Sean M. Burke <[EMAIL PROTECTED]>, all rights
+Copyright 1999-2004, Sean M. Burke <[EMAIL PROTECTED]>, all rights
reserved. This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
==== //depot/perl/lib/Locale/Maketext/t/04super.t#1 (text) ====
Index: perl/lib/Locale/Maketext/t/04super.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/lib/Locale/Maketext/t/04super.t Mon Jan 12 23:16:33 2004
@@ -0,0 +1,78 @@
+
+#sub Locale::Maketext::DEBUG () {10}
+use Locale::Maketext;
+
+use Test;
+BEGIN { plan tests => 19 };
+
+print "#\n# Testing non-tight insertion of super-ordinate language tags...\n#\n";
+
+my @in = grep m/\S/, split /[\n\r]/, q{
+ NIX => NIX
+ sv => sv
+ en => en
+ hai => hai
+
+ pt-br => pt-br pt
+ pt-br fr => pt-br fr pt
+ pt-br fr pt => pt-br fr pt pt
+ pt-br fr pt de => pt-br fr pt de pt
+ de pt-br fr pt => de pt-br fr pt pt
+ de pt-br fr => de pt-br fr pt
+ hai pt-br fr => hai pt-br fr pt
+
+# Now test multi-part complicateds:
+ pt-br-janeiro fr => pt-br-janeiro fr pt-br pt
+pt-br-janeiro de fr => pt-br-janeiro de fr pt-br pt
+pt-br-janeiro de pt fr => pt-br-janeiro de pt fr pt-br pt
+
+ja pt-br-janeiro fr => ja pt-br-janeiro fr pt-br pt
+ja pt-br-janeiro de fr => ja pt-br-janeiro de fr pt-br pt
+ja pt-br-janeiro de pt fr => ja pt-br-janeiro de pt fr pt-br pt
+
+pt-br-janeiro de pt-br fr => pt-br-janeiro de pt-br fr pt-br pt pt
+ # an odd case, since we don't filter for uniqueness in this sub
+
+};
+
+$Locale::Maketext::MATCH_SUPERS_TIGHTLY = 0;
+
+foreach my $in (@in) {
+ $in =~ s/^\s+//s;
+ $in =~ s/\s+$//s;
+ $in =~ s/#.+//s;
+ next unless $in =~ m/\S/;
+
+ my(@in, @should);
+ {
+ die "What kind of line is <$in>?!"
+ unless $in =~ m/^(.+)=>(.+)$/s;
+
+ my($i,$s) = ($1, $2);
+ @in = ($i =~ m/(\S+)/g);
+ @should = ($s =~ m/(\S+)/g);
+ #print "[EMAIL PROTECTED]@should}\n";
+ }
+ my @out = Locale::Maketext->_add_supers(
+ ("@in" eq 'NIX') ? () : @in
+ );
+ #print "O: ", join(' ', map "<$_>", @out), "\n";
+ @out = 'NIX' unless @out;
+
+
+ if( @out == @should
+ and lc( join "\e", @out ) eq lc( join "\e", @should )
+ ) {
+ print "# Happily got [EMAIL PROTECTED] from [$in]\n";
+ ok 1;
+ } else {
+ ok 0;
+ print "#!!Got: [EMAIL PROTECTED]",
+ "#!! but wanted: [EMAIL PROTECTED]",
+ "#!! from \"$in\"\n#\n";
+ }
+}
+
+print "#\n#\n# Bye-bye!\n";
+ok 1;
+
==== //depot/perl/lib/Locale/Maketext/t/05super.t#1 (text) ====
Index: perl/lib/Locale/Maketext/t/05super.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/lib/Locale/Maketext/t/05super.t Mon Jan 12 23:16:33 2004
@@ -0,0 +1,87 @@
+
+#sub Locale::Maketext::DEBUG () {10}
+use Locale::Maketext;
+
+use Test;
+BEGIN { plan tests => 26 };
+print "#\n# Testing tight insertion of super-ordinate language tags...\n#\n";
+
+my @in = grep m/\S/, split /[\n\r]/, q{
+ NIX => NIX
+ sv => sv
+ en => en
+ hai => hai
+
+ pt-br => pt-br pt
+ pt-br fr => pt-br pt fr
+ pt-br fr pt => pt-br fr pt
+
+ pt-br fr pt de => pt-br fr pt de
+ de pt-br fr pt => de pt-br fr pt
+ de pt-br fr => de pt-br pt fr
+ hai pt-br fr => hai pt-br pt fr
+
+ # Now test multi-part complicateds:
+ pt-br-janeiro => pt-br-janeiro pt-br pt
+ pt-br-janeiro fr => pt-br-janeiro pt-br pt fr
+ pt-br-janeiro de fr => pt-br-janeiro pt-br pt de fr
+ pt-br-janeiro de pt fr => pt-br-janeiro pt-br de pt fr
+
+ pt-br-janeiro pt-br-saopaolo => pt-br-janeiro pt-br pt pt-br-saopaolo
+ pt-br-janeiro fr pt-br-saopaolo => pt-br-janeiro pt-br pt fr pt-br-saopaolo
+ pt-br-janeiro de pt-br-saopaolo fr => pt-br-janeiro pt-br pt de pt-br-saopaolo fr
+ pt-br-janeiro de pt-br fr pt-br-saopaolo => pt-br-janeiro de pt-br pt fr
pt-br-saopaolo
+
+ pt-br de en fr pt-br-janeiro => pt-br pt de en fr pt-br-janeiro
+ pt-br de en fr => pt-br pt de en fr
+
+ ja pt-br-janeiro fr => ja pt-br-janeiro pt-br pt fr
+ ja pt-br-janeiro de fr => ja pt-br-janeiro pt-br pt de fr
+ ja pt-br-janeiro de pt fr => ja pt-br-janeiro pt-br de pt fr
+
+ pt-br-janeiro de pt-br fr => pt-br-janeiro de pt-br pt fr
+# an odd case, since we don't filter for uniqueness in this sub
+
+};
+
+sub uniq { my %seen; return grep(!($seen{$_}++), @_); }
+
+foreach my $in (@in) {
+ $in =~ s/^\s+//s;
+ $in =~ s/\s+$//s;
+ $in =~ s/#.+//s;
+ next unless $in =~ m/\S/;
+
+ my(@in, @should);
+ {
+ die "What kind of line is <$in>?!"
+ unless $in =~ m/^(.+)=>(.+)$/s;
+
+ my($i,$s) = ($1, $2);
+ @in = ($i =~ m/(\S+)/g);
+ @should = ($s =~ m/(\S+)/g);
+ #print "[EMAIL PROTECTED]@should}\n";
+ }
+ my @out = uniq( Locale::Maketext->_add_supers(
+ ("@in" eq 'NIX') ? () : @in
+ ) );
+ #print "O: ", join(' ', map "<$_>", @out), "\n";
+ @out = 'NIX' unless @out;
+
+
+ if( @out == @should
+ and lc( join "\e", @out ) eq lc( join "\e", @should )
+ ) {
+ print "# Happily got [EMAIL PROTECTED] from [$in]\n";
+ ok 1;
+ } else {
+ ok 0;
+ print "#!!Got: [EMAIL PROTECTED]",
+ "#!! but wanted: [EMAIL PROTECTED]",
+ "#!! from \"$in\"\n#\n";
+ }
+}
+
+print "#\n#\n# Bye-bye!\n";
+ok 1;
+
End of Patch.
