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
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
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"
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
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
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
-# 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 ();
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
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;
# 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 {
$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;
}
###########################################################################
-# Time-stamp: "2003-04-02 11:10:32 AHST"
+# Time-stamp: "2004-01-11 18:35:34 AST"
=head1 NAME
=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.
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 sburke@cpan.org
+
+ * 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 sburke@cpan.org
* Release 1.06: Now has "use utf8" to make the things work
happily. Some fancy footwork is required to make this work under
README for Locale::Maketext
- Time-stamp: "2003-04-02 11:06:17 AHST"
+ Time-stamp: "2004-01-11 18:36:09 AST"
Locale::Maketext
COPYRIGHT
-Copyright 1999-2003, Sean M. Burke <sburke@cpan.org>, all rights
+Copyright 1999-2004, Sean M. Burke <sburke@cpan.org>, all rights
reserved. This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
--- /dev/null
+
+#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 "{@in}{@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 [@out] from [$in]\n";
+ ok 1;
+ } else {
+ ok 0;
+ print "#!!Got: [@out]\n",
+ "#!! but wanted: [@should]\n",
+ "#!! from \"$in\"\n#\n";
+ }
+}
+
+print "#\n#\n# Bye-bye!\n";
+ok 1;
+
--- /dev/null
+
+#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 "{@in}{@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 [@out] from [$in]\n";
+ ok 1;
+ } else {
+ ok 0;
+ print "#!!Got: [@out]\n",
+ "#!! but wanted: [@should]\n",
+ "#!! from \"$in\"\n#\n";
+ }
+}
+
+print "#\n#\n# Bye-bye!\n";
+ok 1;
+
projects / p5sagit/p5-mst-13.2.git / commitdiff