Upgrade to I18N::LangTags 0.31.

p4raw-id: //depot/perl@22946

5 files changed, 75 insertions, 27 deletions

diff --git a/lib/I18N/LangTags.pm b/lib/I18N/LangTags.pm
index f141ab4bd2..b94ded2de7 100644
--- a/lib/I18N/LangTags.pm
+++ b/lib/I18N/LangTags.pm
@@ -1,5 +1,5 @@
 
-# Time-stamp: "2004-03-30 18:21:55 AST"
+# Time-stamp: "2004-06-17 23:04:06 PDT"
 # Sean M. Burke <sburke@cpan.org>
 
 require 5.000;
@@ -19,7 +19,7 @@ require Exporter;
                );
 %EXPORT_TAGS = ('ALL' => \@EXPORT_OK);
 
-$VERSION = "0.30";
+$VERSION = "0.31";
 
 sub uniq { my %seen; return grep(!($seen{$_}++), @_); } # a util function
 
diff --git a/lib/I18N/LangTags/ChangeLog b/lib/I18N/LangTags/ChangeLog
index e59c637d53..22e0210e5d 100644
--- a/lib/I18N/LangTags/ChangeLog
+++ b/lib/I18N/LangTags/ChangeLog
@@ -1,6 +1,24 @@
 Revision history for Perl module I18N::LangTags.
-                                        Time-stamp: "2004-03-30 21:38:00 AST"
+                                        Time-stamp: "2004-06-17 23:07:01 PDT"
 
+2004-06-17  Sean M. Burke  sburke@cpan.org
+
+	* Release 0.31
+	
+        Corrected some unevennesses in when/whether the return values from
+	I18N::LangTags::Detect's various internal functions would be
+	downcased.  Now they're /always/ downcased, and are /always/ fed
+	thru alternate_language_tags()!
+
+	Also, spiffed up and generally improved the earlier test
+	80_all_env.t, which not even I could make sense of, and I wrote
+	the damned thing.  Now it's sane, and checks both scalar and
+	list return values.  Thanks to Rafael Garcia-Suarez and the
+	various CPAN-Testers for prodding me to fix this.  (Hopefully the
+	earlier problems /are/ now fixed!  Otherwise there'll be another
+	version of this module out real soon!)
+
+	
 2004-03-30  Sean M. Burke  sburke@cpan.org
 
 	* Release 0.30
@@ -14,7 +32,7 @@ Revision history for Perl module I18N::LangTags.
 
 	Thanks to Autrijus Tang for catching some errors in my makefile!
 
-	
+
 	
 2003-10-10  Sean M. Burke  sburke@cpan.org
 	
diff --git a/lib/I18N/LangTags/Detect.pm b/lib/I18N/LangTags/Detect.pm
index 9c451687a7..ccef6dd5a2 100644
--- a/lib/I18N/LangTags/Detect.pm
+++ b/lib/I18N/LangTags/Detect.pm
@@ -1,5 +1,5 @@
 
-# Time-stamp: "2004-03-30 17:28:24 AST"
+# Time-stamp: "2004-06-17 22:59:06 PDT"
 
 require 5;
 package I18N::LangTags::Detect;
@@ -11,11 +11,19 @@ use vars qw( @ISA $VERSION $MATCH_SUPERS $USING_LANGUAGE_TAGS
 BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } }
  # define the constant 'DEBUG' at compile-time
 
-$VERSION = "1.01";
+$VERSION = "1.02";
 @ISA = ();
 use I18N::LangTags qw(alternate_language_tags locale2language_tag);
 
-sub uniq { my %seen; return grep(!($seen{$_}++), @_); }
+sub _uniq { my %seen; return grep(!($seen{$_}++), @_); }
+sub _normalize {
+  my(@languages) =
+    map lc($_),
+    grep $_,
+    map {; $_, alternate_language_tags($_) } @_;
+  return _uniq(@languages) if wantarray;
+  return $languages[0];
+}
 
 #---------------------------------------------------------------------------
 # The extent of our functional interface:
@@ -54,11 +62,7 @@ sub ambient_langprefs { # always returns things untainted
     push @languages, Win32::Locale::get_language() || ''
      if defined &Win32::Locale::get_language;
   }
-
-  @languages = map {; $_, alternate_language_tags($_) } @languages;
-
-  return uniq(@languages) if wantarray;
-  return $languages[0];
+  return _normalize @languages;
 }
 
 #---------------------------------------------------------------------------
@@ -78,10 +82,10 @@ sub http_accept_langs {
   
   if( $in =~ m/^\s*([a-zA-Z][-a-zA-Z]+)\s*$/s ) {
     # Very common case: just one language tag
-    return lc $1;
+    return _normalize $1;
   } elsif( $in =~ m/^\s*[a-zA-Z][-a-zA-Z]+(?:\s*,\s*[a-zA-Z][-a-zA-Z]+)*\s*$/s ) {
     # Common case these days: just "foo, bar, baz"
-    return map lc($_), $in =~ m/([a-zA-Z][-a-zA-Z]+)/g;
+    return _normalize( $in =~ m/([a-zA-Z][-a-zA-Z]+)/g );
   }
 
   # Else it's complicated...
@@ -111,10 +115,12 @@ sub http_accept_langs {
     push @{ $pref{$q} }, lc $1;
   }
 
-  return # Read off %pref, in descending key order...
+  return _normalize(
+    # Read off %pref, in descending key order...
     map @{$pref{$_}},
     sort {$b <=> $a}
-    keys %pref;
+    keys %pref
+  );
 }
 
 #===========================================================================
diff --git a/lib/I18N/LangTags/t/10_http.t b/lib/I18N/LangTags/t/10_http.t
index 377056b319..36341f77cf 100644
--- a/lib/I18N/LangTags/t/10_http.t
+++ b/lib/I18N/LangTags/t/10_http.t
@@ -1,5 +1,5 @@
 
-# Time-stamp: "2004-03-30 16:59:14 AST"
+# Time-stamp: "2004-06-17 23:06:22 PDT"
 
 use I18N::LangTags::Detect;
 
@@ -15,8 +15,8 @@ my @in = grep m/\S/, split /\n/, q{
 [ en-us   ]  en-US
 [ en-us   ]  EN-US
 
-[ en-au en i-klingon en-gb en-us mt-mt mt ja ]  EN-au, JA;q=0.14, i-klingon;q=0.83, en-gb;q=0.71, en-us;q=0.57, mt-mt;q=0.43, mt;q=0.29, en;q=0.86
-[ en-au en i-klingon en-gb en-us mt-mt mt tli ja ]  EN-au, tli;q=0.201, JA;q=0.14, i-klingon;q=0.83, en-gb;q=0.71, en-us;q=0.57, mt-mt;q=0.43, mt;q=0.29, en;q=0.86
+[ en-au en i-klingon x-klingon en-gb en-us mt-mt mt ja ]  EN-au, JA;q=0.14, i-klingon;q=0.83, en-gb;q=0.71, en-us;q=0.57, mt-mt;q=0.43, mt;q=0.29, en;q=0.86
+[ en-au en i-klingon x-klingon en-gb en-us mt-mt mt tli ja ]  EN-au, tli;q=0.201, JA;q=0.14, i-klingon;q=0.83, en-gb;q=0.71, en-us;q=0.57, mt-mt;q=0.43, mt;q=0.29, en;q=0.86
 [ en-au en en-gb en-us ja  ]  en-au, ja;q=0.20, en-gb;q=0.60, en-us;q=0.40, en;q=0.80
 
 [ en-au en en-gb en-us mt-mt mt ja ]  EN-au, JA;q=0.14, en-gb;q=0.71, en-us;q=0.57, mt-mt;q=0.43, mt;q=0.29, en;q=0.86
diff --git a/lib/I18N/LangTags/t/80_all_env.t b/lib/I18N/LangTags/t/80_all_env.t
index e93a6f5575..3711318e93 100644
--- a/lib/I18N/LangTags/t/80_all_env.t
+++ b/lib/I18N/LangTags/t/80_all_env.t
@@ -1,12 +1,14 @@
 
 require 5;
 use Test;
-# Time-stamp: "2004-03-30 17:51:06 AST"
-BEGIN { plan tests => 9; }
+# Time-stamp: "2004-06-17 22:59:30 PDT"
+BEGIN { plan tests => 14; }
 use I18N::LangTags::Detect 1.01;
 print "# Hi there...\n";
 ok 1;
 
+print "# Using I18N::LangTags::Detect v$I18N::LangTags::Detect::VERSION\n";
+
 print "# Make sure we can assign to ENV entries\n",
       "# (Otherwise we can't run the subsequent tests)...\n";
 $ENV{'MYORP'}   = 'Zing';          ok $ENV{'MYORP'}, 'Zing';
@@ -15,30 +17,52 @@ $ENV{'SWUZ'}   = 'KLORTHO HOOBOY'; ok $ENV{'SWUZ'}, 'KLORTHO HOOBOY';
 delete $ENV{'MYORP'};
 delete $ENV{'SWUZ'};
 
-sub show { print "#  (Seeing [@_] at line ", (caller)[2], ")\n";  return @_ }
+sub j { "[" . join(' ', map "\"$_\"", @_) . "]" ;}
+
+sub show {
+  print "#  (Seeing {", join(' ',
+    map(qq{<$_>}, @_)), "} at line ", (caller)[2], ")\n";
+  printenv();
+  return $_[0] || '';
+}
+sub printenv {
+  print "# ENV:\n";
+  foreach my $k (sort keys %ENV) {
+    my $p = $ENV{$k};  $p =~ s/\n/\n#/g;
+    print "#   [$k] = [$p]\n"; }
+  print "# [end of ENV]\n#\n";
+}
+
 
 print "# Test LANG...\n";
 $ENV{'REQUEST_METHOD'} = '';
 $ENV{'LANG'}     = 'Eu_MT';
 $ENV{'LANGUAGE'} = '';
-ok show I18N::LangTags::Detect::detect();
+ok show( scalar I18N::LangTags::Detect::detect()),    "eu-mt";
+ok show( j      I18N::LangTags::Detect::detect()), q{["eu-mt"]};
 
 print "# Test LANGUAGE...\n";
 $ENV{'LANG'}     = '';
 $ENV{'LANGUAGE'} = 'Eu-MT';
-ok show I18N::LangTags::Detect::detect();
+ok show( scalar I18N::LangTags::Detect::detect()),    "eu-mt";
+ok show( j      I18N::LangTags::Detect::detect()), q{["eu-mt"]};
 
 
 print "# Test HTTP_ACCEPT_LANGUAGE...\n";
 $ENV{'REQUEST_METHOD'}       = 'GET';
 $ENV{'HTTP_ACCEPT_LANGUAGE'} = 'eu-MT';
-ok show I18N::LangTags::Detect::detect();
+ok show( scalar I18N::LangTags::Detect::detect()),    "eu-mt";
+ok show( j      I18N::LangTags::Detect::detect()), q{["eu-mt"]};
+
 
 $ENV{'HTTP_ACCEPT_LANGUAGE'} = 'x-plorp, zaz, eu-MT, i-klung';
-ok show I18N::LangTags::Detect::detect();
+ok show( scalar I18N::LangTags::Detect::detect()), "x-plorp";
+ok show( j      I18N::LangTags::Detect::detect()), qq{["x-plorp" "i-plorp" "zaz" "eu-mt" "i-klung" "x-klung"]};
 
 $ENV{'HTTP_ACCEPT_LANGUAGE'} = 'x-plorp, zaz, eU-Mt, i-klung';
-ok show I18N::LangTags::Detect::detect();
+ok show( scalar I18N::LangTags::Detect::detect()), "x-plorp";
+ok show( j      I18N::LangTags::Detect::detect()), qq{["x-plorp" "i-plorp" "zaz" "eu-mt" "i-klung" "x-klung"]};
+