dslinux/user/perl/lib/I18N/LangTags ChangeLog Detect.pm List.pm README
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:00:45 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/lib/I18N/LangTags
In directory antilope:/tmp/cvs-serv17422/lib/I18N/LangTags
Added Files:
ChangeLog Detect.pm List.pm README
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: README ---
README for I18N::LangTags
Time-stamp: "2004-10-06 23:19:39 ADT"
I18N::LangTags
I18N::LangTags - functions for dealing with RFC3066-style language
tags
Language tags are a formalism, described in RFC 3066 (obsoleting
1766), for declaring what language form (language and possibly
dialect) a given chunk of information is in.
This library provides functions for common tasks involving language
tags (notably the extraction of them, comparing them, and testing the
formal validity of them) as is needed in a variety of protocols and
applications.
I18N::LangTags::List -- tags and names for human languages. This
module goes from known language tag names ("fr-CA") to their English
names ("Canadian French"). Its documentation also lists the several
hundred known tags and some common subforms. You may find this useful
as a reference.
See the POD for more information.
INSTALLATION
You install I18N::LangTags and I18N::LangTags::List, as you would
install any perl module library, by running these commands:
perl Makefile.PL
make
make test
make install
If you want to install a private copy of I18N::LangTags in your home
directory, then you should try to produce the initial Makefile with
something like this command:
perl Makefile.PL LIB=~/perl
See perldoc perlmodinstall for more information on installing modules.
DOCUMENTATION
POD-format documentation is included in LangTags.pm. POD is readable
with the 'perldoc' utility. See ChangeLog for recent changes.
SUPPORT
Questions, bug reports, useful code bits, and suggestions for
I18N::LangTags should just be sent to me at sburke at cpan.org
AVAILABILITY
The latest version of I18N::LangTags is available from the
Comprehensive Perl Archive Network (CPAN). Visit
<http://www.perl.com/CPAN/> to find a CPAN site near you.
COPYRIGHT
Copyright 1998+, Sean M. Burke <sburke at cpan.org>, all rights
reserved.
The programs and documentation in this dist are distributed in
the hope that they will be useful, but without any warranty; without
even the implied warranty of merchantability or fitness for a
particular purpose.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
--- NEW FILE: List.pm ---
require 5;
package I18N::LangTags::List;
# Time-stamp: "2004-10-06 23:26:21 ADT"
use strict;
use vars qw(%Name %Is_Disrec $Debug $VERSION);
$VERSION = '0.35';
# POD at the end.
#----------------------------------------------------------------------
{
# read the table out of our own POD!
my $seeking = 1;
my $count = 0;
my($disrec,$tag,$name);
my $last_name = '';
while(<I18N::LangTags::List::DATA>) {
if($seeking) {
$seeking = 0 if m/=for woohah/;
[...1740 lines suppressed...]
my $xx = splice(@f, 2,1); # pull out the two-letter code
$f[-1] =~ s/^\s+//;
$f[-1] =~ s/\s+$//;
if($xx =~ m/[a-zA-Z]/) { # there's a two-letter code for it
push @codes, [ lc($f[-1]), "$xx\t$f[-1]\n" ];
} else { # print the three-letter codes.
if($f[0] eq $f[1]) {
push @codes, [ lc($f[-1]), "$f[1]\t$f[2]\n" ];
} else { # shouldn't happen
push @codes, [ lc($f[-1]), "@f !!!!!!!!!!\n" ];
}
}
}
print map $_->[1], sort {; $a->[0] cmp $b->[0] } @codes;
print "[ based on $url\n at ", scalar(localtime), "]\n",
"[Note: doesn't include IANA-registered codes.]\n";
exit;
__END__
--- NEW FILE: Detect.pm ---
# Time-stamp: "2004-06-20 21:47:55 ADT"
require 5;
package I18N::LangTags::Detect;
use strict;
use vars qw( @ISA $VERSION $MATCH_SUPERS $USING_LANGUAGE_TAGS
$USE_LITERALS $MATCH_SUPERS_TIGHTLY);
BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } }
# define the constant 'DEBUG' at compile-time
$VERSION = "1.03";
@ISA = ();
use I18N::LangTags qw(alternate_language_tags locale2language_tag);
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:
sub detect () { return __PACKAGE__->ambient_langprefs; }
#===========================================================================
sub ambient_langprefs { # always returns things untainted
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;
foreach my $envname (qw( LANGUAGE LC_ALL LC_MESSAGES LANG )) {
next unless $ENV{$envname};
DEBUG and print "Noting \$$envname: $ENV{$envname}\n";
push @languages,
map locale2language_tag($_),
# if it's a lg tag, fine, pass thru (untainted)
# if it's a locale ID, try converting to a lg tag (untainted),
# otherwise nix it.
split m/[,:]/,
$ENV{$envname}
;
last; # first one wins
}
if($ENV{'IGNORE_WIN32_LOCALE'}) {
# no-op
} elsif(&_try_use('Win32::Locale')) {
# If we have that module installed...
push @languages, Win32::Locale::get_language() || ''
if defined &Win32::Locale::get_language;
}
return _normalize @languages;
}
#---------------------------------------------------------------------------
sub http_accept_langs {
# Deal with HTTP "Accept-Language:" stuff. Hassle.
# This code is more lenient than RFC 3282, which you must read.
# Hm. Should I just move this into I18N::LangTags at some point?
no integer;
my $in = (@_ > 1) ? $_[1] : $ENV{'HTTP_ACCEPT_LANGUAGE'};
# (always ends up untainting)
return() unless defined $in and length $in;
$in =~ s/\([^\)]*\)//g; # nix just about any comment
if( $in =~ m/^\s*([a-zA-Z][-a-zA-Z]+)\s*$/s ) {
# Very common case: just one language tag
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 _normalize( $in =~ m/([a-zA-Z][-a-zA-Z]+)/g );
}
# Else it's complicated...
$in =~ s/\s+//g; # Yes, we can just do without the WS!
my @in = $in =~ m/([^,]+)/g;
my %pref;
my $q;
foreach my $tag (@in) {
next unless $tag =~
m/^([a-zA-Z][-a-zA-Z]+)
(?:
;q=
(
\d* # a bit too broad of a RE, but so what.
(?:
\.\d+
)?
)
)?
$
/sx
;
$q = (defined $2 and length $2) ? $2 : 1;
#print "$1 with q=$q\n";
push @{ $pref{$q} }, lc $1;
}
return _normalize(
# Read off %pref, in descending key order...
map @{$pref{$_}},
sort {$b <=> $a}
keys %pref
);
}
#===========================================================================
my %tried = ();
# memoization of whether we've used this module, or found it unusable.
sub _try_use { # Basically a wrapper around "require Modulename"
# "Many men have tried..." "They tried and failed?" "They tried and died."
return $tried{$_[0]} if exists $tried{$_[0]}; # memoization
my $module = $_[0]; # ASSUME sane module name!
{ no strict 'refs';
return($tried{$module} = 1)
if defined(%{$module . "::Lexicon"}) or defined(@{$module . "::ISA"});
# weird case: we never use'd it, but there it is!
}
print " About to use $module ...\n" if DEBUG;
{
local $SIG{'__DIE__'};
eval "require $module"; # used to be "use $module", but no point in that.
}
if($@) {
print "Error using $module \: $@\n" if DEBUG > 1;
return $tried{$module} = 0;
} else {
print " OK, $module is used\n" if DEBUG;
return $tried{$module} = 1;
}
}
#---------------------------------------------------------------------------
1;
__END__
=head1 NAME
I18N::LangTags::Detect - detect the user's language preferences
=head1 SYNOPSIS
use I18N::LangTags::Detect;
my @user_wants = I18N::LangTags::Detect::detect();
=head1 DESCRIPTION
It is a common problem to want to detect what language(s) the user would
prefer output in.
=head1 FUNCTIONS
This module defines one public function,
C<I18N::LangTags::Detect::detect()>. This function is not exported
(nor is even exportable), and it takes no parameters.
In scalar context, the function returns the most preferred language
tag (or undef if no preference was seen).
In list context (which is usually what you want),
the function returns a
(possibly empty) list of language tags representing (best first) what
languages the user apparently would accept output in. You will
probably want to pass the output of this through
C<I18N::LangTags::implicate_supers_tightly(...)>
or
C<I18N::LangTags::implicate_supers(...)>, like so:
my @languages =
I18N::LangTags::implicate_supers_tightly(
I18N::LangTags::Detect::detect()
);
=head1 ENVIRONMENT
This module looks for several environment variables, including
REQUEST_METHOD, HTTP_ACCEPT_LANGUAGE,
LANGUAGE, LC_ALL, LC_MESSAGES, and LANG.
It will also use the L<Win32::Locale> module, if it's installed.
=head1 SEE ALSO
L<I18N::LangTags>, L<Win32::Locale>, L<Locale::Maketext>.
(This module's core code started out as a routine in Locale::Maketext;
but I moved it here once I realized it was more generally useful.)
=head1 COPYRIGHT
Copyright (c) 1998-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.
The programs and documentation in this dist are distributed in
the hope that they will be useful, but without any warranty; without
even the implied warranty of merchantability or fitness for a
particular purpose.
=head1 AUTHOR
Sean M. Burke C<sburke at cpan.org>
=cut
# a tip: Put a bit of chopped up pickled ginger in your salad. It's tasty!
--- NEW FILE: ChangeLog ---
Revision history for Perl module I18N::LangTags.
Time-stamp: "2004-10-06 23:26:53 ADT"
2004-10-06 Sean M. Burke sburke at cpan.org
* Release 0.35
Bugfix version: locale2language_tag now correctly understands
locale-IDs with at-signs in them, like 'it_IT.utf8 at euro' or
'it_IT at euro'. This is now enforced by the new t/20_locales.t
Thanks to Luca 'loopback' Cavalli for letting me know about these
new locale-ID name-styles.
* Release 0.34 -- never happened, because of an upload error
2004-07-01 Sean M. Burke sburke at cpan.org
* Release 0.33
Minor bugfix version:
The test 80_all_env.t was erroneously failing for people with
LC_ALL or LC_MESSAGES set. Fixed. Thanks to everyone, especially
Nicholas Clark, who patiently helped out with this.
2004-06-20 Sean M. Burke sburke at cpan.org
* Release 0.32
Minor bugfix version:
The test 80_all_env.t was erroneously failing under MSWins that
had Win32::Locale installed. A workaround added.
2004-06-17 Sean M. Burke sburke at 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 at cpan.org
* Release 0.30
New in I18N::LangTags : implicate_supers and
implicate_supers_strictly.
New module: I18N::LangTags::Detect.
Some new tests.
Thanks to Autrijus Tang for catching some errors in my makefile!
2003-10-10 Sean M. Burke sburke at cpan.org
* Release 0.29
Minor bugfix to I18N::LangTags::List code. Addition of the
is_decent function, and the 02decency.t test for it.
Better Makefile. Thanks to everyone who told me about the
INSTALLDIRS trick.
2003-07-20 Sean M. Burke sburke at cpan.org
* Release 0.28
Doc fixes in I18N::LangTags, plus a few added variances (jw/jv,
cre/cr, etc.)
Lots of updates to I18N::LangTags::List
Deleted rfc3066.txt from dist.
Moved test.pl to t/01test.t and added more tests.
2002-02-02 Sean M. Burke sburke at cpan.org
* Release 0.27 -- minor mods to ::List:
Fixing its entries for sv-se and sv-fi.
Typo-fixes and rewordings in the incidental Pod text elsewhere.
2001-06-21 Sean M. Burke sburke at cpan.org
* Release 0.26 -- just making cosmetic changes
to test.pl, at Jarkko's request.
2001-06-20 Sean M. Burke sburke at cpan.org
* Release 0.25 -- just tweaking panic_languages behavior
for Scandinavian languages. Much better now.
Slight tweak to ::List's entries for Greek.
2001-06-20 Sean M. Burke sburke at cpan.org
* Release 0.24
* I18N::LangTags -- some elaborate hacks to make us
recognize legacy aliases like no-nyn == nn.
Added panic_languages().
Added :ALL export tag.
Minor docs fixes, and spiffing up test.pl.
* I18N::LangTags::List -- minor corrections; added
a few aliases.
2001-05-29 Sean M. Burke sburke at cpan.org
* Release 0.23
* I18N::LangTags::List -- minor corrections. And is now
a module, not just documentation.
2001-05-27 Sean M. Burke sburke at cpan.org
* Release 0.22
* Now bundling I18N::LangTags::List, a reference for lang tags,
replacing generate_language_table.plx and language_codes.txt
2001-05-25 Sean M. Burke sburke at cpan.org
* Release 0.21
* extract_language_tags and locale2langauge_tag now
return untainted output. Useful if you feed tainted
things, like $ENV{'LANG'}.
2001-03-13 Sean M. Burke sburke at cpan.org
* Release 0.20
* Added support for RFC 3066 tags: allowing three-letter primary
tags ("nav"), and allowing digits in subtags ("x-borg-prot3252").
* Changed all references from RFC 1766 to RFC 3066.
* Now bundling fulltext of RFC 3066 in the dist.
* Now bundling generate_language_table.plx and language_codes.txt
* Added some nice tests to test.pl
* Inverting order of listings in this ChangeLog file.
2000-05-13 Sean M. Burke sburke at cpan.org
* Release 0.13
* Just noting my new email address.
1999-03-06 Sean M. Burke sburke at netadventure.net
* Release 0.11
* Added functions
similarity_language_tag, is_dialect_of,
locale2language_tag, alternate_language_tags, and
encode_language_tag
1998-12-14 Sean M. Burke sburke at netadventure.net
* Release 0.09
* Added function super_languages()
1998-10-31 Sean M. Burke sburke at netadventure.net
* Release 0.08
* Just changes in the docs and bundle -- no change
in functionality.
1998-04-02 Sean M. Burke sburke at netadventure.net
* Release 0.07
* First public release.
[END OF CHANGELOG]
More information about the dslinux-commit
mailing list