From: Rafael Garcia-Suarez Date: Fri, 18 Jun 2004 07:44:34 +0000 (+0000) Subject: Upgrade to I18N::LangTags 0.31. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8575f5e6a8b0b4cbc4c8e4c30f15a255a153e404;p=p5sagit%2Fp5-mst-13.2.git Upgrade to I18N::LangTags 0.31. p4raw-id: //depot/perl@22946 --- diff --git a/lib/I18N/LangTags.pm b/lib/I18N/LangTags.pm index f141ab4..b94ded2 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 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 e59c637..22e0210 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 9c45168..ccef6dd 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 377056b..36341f7 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 e93a6f5..3711318 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"]}; +