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.

Reply via email to