diff options
author | Karl Berry <karl@freefriends.org> | 2012-05-21 00:15:27 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2012-05-21 00:15:27 +0000 |
commit | a4c42bfb2337d37da89d789cb8cc226367994e32 (patch) | |
tree | c3eabdef5d565a4e515d2be0d9d4d0540bde0250 /Master/tlpkg/tlperl/lib/Encode | |
parent | 8274475057f024d35332ac47c2e2f23ea156e6ed (diff) |
perl 5.14.2 from siep
git-svn-id: svn://tug.org/texlive/trunk@26525 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Encode')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Encode/Alias.pm | 19 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Encode/Guess.pm | 6 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Encode/Locale.pm | 348 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm | 7 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Encode/Unicode/UTF7.pm | 8 |
5 files changed, 373 insertions, 15 deletions
diff --git a/Master/tlpkg/tlperl/lib/Encode/Alias.pm b/Master/tlpkg/tlperl/lib/Encode/Alias.pm index f142403ca9c..f517a5a75a8 100644 --- a/Master/tlpkg/tlperl/lib/Encode/Alias.pm +++ b/Master/tlpkg/tlperl/lib/Encode/Alias.pm @@ -2,7 +2,7 @@ package Encode::Alias; use strict; use warnings; no warnings 'redefine'; -our $VERSION = do { my @r = ( q$Revision: 2.12 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; +our $VERSION = do { my @r = ( q$Revision: 2.13 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; sub DEBUG () { 0 } use base qw(Exporter); @@ -90,9 +90,9 @@ sub define_alias { DEBUG and warn "delete \$Alias\{$k\}"; delete $Alias{$k}; } - elsif ( ref($alias) eq 'CODE' ) { + elsif ( ref($alias) eq 'CODE' && $alias->($k) ) { DEBUG and warn "delete \$Alias\{$k\}"; - delete $Alias{ $alias->($name) }; + delete $Alias{$k}; } } } @@ -286,7 +286,9 @@ Encode::Alias - alias definitions to encodings use Encode; use Encode::Alias; - define_alias( newName => ENCODING); + define_alias( "newName" => ENCODING); + define_alias( qr/.../ => ENCODING); + define_alias( sub { return ENCODING if ...; } ); =head1 DESCRIPTION @@ -294,7 +296,8 @@ Allows newName to be used as an alias for ENCODING. ENCODING may be either the name of an encoding or an encoding object (as described in L<Encode>). -Currently I<newName> can be specified in the following ways: +Currently the first argument to define_alias() can be specified in the +following ways: =over 4 @@ -321,7 +324,7 @@ experienced. Use this feature with caution. The same effect as the example above in a different way. The coderef takes the alias name as an argument and returns a canonical name on -success or undef if not. Note the second argument is not required. +success or undef if not. Note the second argument is ignored if provided. Use this with even more caution than the regex version. =back @@ -369,6 +372,10 @@ to do so. And gets the factory settings back. +Note that define_alias() will not be able to override the canonical name +of encodings. Encodings are first looked up by canonical name before +potential aliases are tried. + =head1 SEE ALSO L<Encode>, L<Encode::Supported> diff --git a/Master/tlpkg/tlperl/lib/Encode/Guess.pm b/Master/tlpkg/tlperl/lib/Encode/Guess.pm index 1ad7147e7f5..9636a8ad8a5 100644 --- a/Master/tlpkg/tlperl/lib/Encode/Guess.pm +++ b/Master/tlpkg/tlperl/lib/Encode/Guess.pm @@ -2,7 +2,7 @@ package Encode::Guess; use strict; use warnings; use Encode qw(:fallbacks find_encoding); -our $VERSION = do { my @r = ( q$Revision: 2.3 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; +our $VERSION = do { my @r = ( q$Revision: 2.4 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; my $Canon = 'Guess'; sub DEBUG () { 0 } @@ -53,7 +53,7 @@ sub decode($$;$) { require Carp; Carp::croak($guessed); } - my $utf8 = $guessed->decode( $octet, $chk ); + my $utf8 = $guessed->decode( $octet, $chk || 0 ); $_[1] = $octet if $chk; return $utf8; } @@ -279,7 +279,7 @@ the internal suspects list. my $decoder = guess_encoding($data, qw/euc-jp euc-kr euc-cn/); die $decoder unless ref($decoder); my $utf8 = $decoder->decode($data); - # check only ascii and utf8 + # check only ascii, utf8 and UTF-(16|32) with BOM my $decoder = guess_encoding($data); =back diff --git a/Master/tlpkg/tlperl/lib/Encode/Locale.pm b/Master/tlpkg/tlperl/lib/Encode/Locale.pm new file mode 100644 index 00000000000..b14e10a01a8 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Encode/Locale.pm @@ -0,0 +1,348 @@ +package Encode::Locale; + +use strict; +our $VERSION = "1.03"; + +use base 'Exporter'; +our @EXPORT_OK = qw( + decode_argv env + $ENCODING_LOCALE $ENCODING_LOCALE_FS + $ENCODING_CONSOLE_IN $ENCODING_CONSOLE_OUT +); + +use Encode (); +use Encode::Alias (); + +our $ENCODING_LOCALE; +our $ENCODING_LOCALE_FS; +our $ENCODING_CONSOLE_IN; +our $ENCODING_CONSOLE_OUT; + +sub DEBUG () { 0 } + +sub _init { + if ($^O eq "MSWin32") { + unless ($ENCODING_LOCALE) { + # Try to obtain what the Windows ANSI code page is + eval { + unless (defined &GetACP) { + require Win32::API; + Win32::API->Import('kernel32', 'int GetACP()'); + }; + if (defined &GetACP) { + my $cp = GetACP(); + $ENCODING_LOCALE = "cp$cp" if $cp; + } + }; + } + + unless ($ENCODING_CONSOLE_IN) { + # If we have the Win32::Console module installed we can ask + # it for the code set to use + eval { + require Win32::Console; + my $cp = Win32::Console::InputCP(); + $ENCODING_CONSOLE_IN = "cp$cp" if $cp; + $cp = Win32::Console::OutputCP(); + $ENCODING_CONSOLE_OUT = "cp$cp" if $cp; + }; + # Invoking the 'chcp' program might also work + if (!$ENCODING_CONSOLE_IN && (qx(chcp) || '') =~ /^Active code page: (\d+)/) { + $ENCODING_CONSOLE_IN = "cp$1"; + } + } + } + + unless ($ENCODING_LOCALE) { + eval { + require I18N::Langinfo; + $ENCODING_LOCALE = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET()); + + # Workaround of Encode < v2.25. The "646" encoding alias was + # introduced in Encode-2.25, but we don't want to require that version + # quite yet. Should avoid the CPAN testers failure reported from + # openbsd-4.7/perl-5.10.0 combo. + $ENCODING_LOCALE = "ascii" if $ENCODING_LOCALE eq "646"; + + # https://rt.cpan.org/Ticket/Display.html?id=66373 + $ENCODING_LOCALE = "hp-roman8" if $^O eq "hpux" && $ENCODING_LOCALE eq "roman8"; + }; + $ENCODING_LOCALE ||= $ENCODING_CONSOLE_IN; + } + + if ($^O eq "darwin") { + $ENCODING_LOCALE_FS ||= "UTF-8"; + } + + # final fallback + $ENCODING_LOCALE ||= $^O eq "MSWin32" ? "cp1252" : "UTF-8"; + $ENCODING_LOCALE_FS ||= $ENCODING_LOCALE; + $ENCODING_CONSOLE_IN ||= $ENCODING_LOCALE; + $ENCODING_CONSOLE_OUT ||= $ENCODING_CONSOLE_IN; + + unless (Encode::find_encoding($ENCODING_LOCALE)) { + my $foundit; + if (lc($ENCODING_LOCALE) eq "gb18030") { + eval { + require Encode::HanExtra; + }; + if ($@) { + die "Need Encode::HanExtra to be installed to support locale codeset ($ENCODING_LOCALE), stopped"; + } + $foundit++ if Encode::find_encoding($ENCODING_LOCALE); + } + die "The locale codeset ($ENCODING_LOCALE) isn't one that perl can decode, stopped" + unless $foundit; + + } + + # use Data::Dump; ddx $ENCODING_LOCALE, $ENCODING_LOCALE_FS, $ENCODING_CONSOLE_IN, $ENCODING_CONSOLE_OUT; +} + +_init(); +Encode::Alias::define_alias(sub { + no strict 'refs'; + no warnings 'once'; + return ${"ENCODING_" . uc(shift)}; +}, "locale"); + +sub _flush_aliases { + no strict 'refs'; + for my $a (keys %Encode::Alias::Alias) { + if (defined ${"ENCODING_" . uc($a)}) { + delete $Encode::Alias::Alias{$a}; + warn "Flushed alias cache for $a" if DEBUG; + } + } +} + +sub reinit { + $ENCODING_LOCALE = shift; + $ENCODING_LOCALE_FS = shift; + $ENCODING_CONSOLE_IN = $ENCODING_LOCALE; + $ENCODING_CONSOLE_OUT = $ENCODING_LOCALE; + _init(); + _flush_aliases(); +} + +sub decode_argv { + die if defined wantarray; + for (@ARGV) { + $_ = Encode::decode(locale => $_, @_); + } +} + +sub env { + my $k = Encode::encode(locale => shift); + my $old = $ENV{$k}; + if (@_) { + my $v = shift; + if (defined $v) { + $ENV{$k} = Encode::encode(locale => $v); + } + else { + delete $ENV{$k}; + } + } + return Encode::decode(locale => $old) if defined wantarray; +} + +1; + +__END__ + +=head1 NAME + +Encode::Locale - Determine the locale encoding + +=head1 SYNOPSIS + + use Encode::Locale; + use Encode; + + $string = decode(locale => $bytes); + $bytes = encode(locale => $string); + + if (-t) { + binmode(STDIN, ":encoding(console_in)"); + binmode(STDOUT, ":encoding(console_out)"); + binmode(STDERR, ":encoding(console_out)"); + } + + # Processing file names passed in as arguments + my $uni_filename = decode(locale => $ARGV[0]); + open(my $fh, "<", encode(locale_fs => $uni_filename)) + || die "Can't open '$uni_filename': $!"; + binmode($fh, ":encoding(locale)"); + ... + +=head1 DESCRIPTION + +In many applications it's wise to let Perl use Unicode for the strings it +processes. Most of the interfaces Perl has to the outside world are still byte +based. Programs therefore need to decode byte strings that enter the program +from the outside and encode them again on the way out. + +The POSIX locale system is used to specify both the language conventions +requested by the user and the preferred character set to consume and +output. The C<Encode::Locale> module looks up the charset and encoding (called +a CODESET in the locale jargon) and arranges for the L<Encode> module to know +this encoding under the name "locale". It means bytes obtained from the +environment can be converted to Unicode strings by calling C<< +Encode::encode(locale => $bytes) >> and converted back again with C<< +Encode::decode(locale => $string) >>. + +Where file systems interfaces pass file names in and out of the program we also +need care. The trend is for operating systems to use a fixed file encoding +that don't actually depend on the locale; and this module determines the most +appropriate encoding for file names. The L<Encode> module will know this +encoding under the name "locale_fs". For traditional Unix systems this will +be an alias to the same encoding as "locale". + +For programs running in a terminal window (called a "Console" on some systems) +the "locale" encoding is usually a good choice for what to expect as input and +output. Some systems allows us to query the encoding set for the terminal and +C<Encode::Locale> will do that if available and make these encodings known +under the C<Encode> aliases "console_in" and "console_out". For systems where +we can't determine the terminal encoding these will be aliased as the same +encoding as "locale". The advice is to use "console_in" for input known to +come from the terminal and "console_out" for output known to go from the +terminal. + +In addition to arranging for various Encode aliases the following functions and +variables are provided: + +=over + +=item decode_argv( ) + +=item decode_argv( Encode::FB_CROAK ) + +This will decode the command line arguments to perl (the C<@ARGV> array) in-place. + +The function will by default replace characters that can't be decoded by +"\x{FFFD}", the Unicode replacement character. + +Any argument provided is passed as CHECK to underlying Encode::decode() call. +Pass the value C<Encode::FB_CROAK> to have the decoding croak if not all the +command line arguments can be decoded. See L<Encode/"Handling Malformed Data"> +for details on other options for CHECK. + +=item env( $uni_key ) + +=item env( $uni_key => $uni_value ) + +Interface to get/set environment variables. Returns the current value as a +Unicode string. The $uni_key and $uni_value arguments are expected to be +Unicode strings as well. Passing C<undef> as $uni_value deletes the +environment variable named $uni_key. + +The returned value will have the characters that can't be decoded replaced by +"\x{FFFD}", the Unicode replacement character. + +There is no interface to request alternative CHECK behavior as for +decode_argv(). If you need that you need to call encode/decode yourself. +For example: + + my $key = Encode::encode(locale => $uni_key, Encode::FB_CROAK); + my $uni_value = Encode::decode(locale => $ENV{$key}, Encode::FB_CROAK); + +=item reinit( ) + +=item reinit( $encoding ) + +Reinitialize the encodings from the locale. You want to call this function if +you changed anything in the environment that might influence the locale. + +This function will croak if the determined encoding isn't recognized by +the Encode module. + +With argument force $ENCODING_... variables to set to the given value. + +=item $ENCODING_LOCALE + +The encoding name determined to be suitable for the current locale. +L<Encode> know this encoding as "locale". + +=item $ENCODING_LOCALE_FS + +The encoding name determined to be suiteable for file system interfaces +involving file names. +L<Encode> know this encoding as "locale_fs". + +=item $ENCODING_CONSOLE_IN + +=item $ENCODING_CONSOLE_OUT + +The encodings to be used for reading and writing output to the a console. +L<Encode> know these encodings as "console_in" and "console_out". + +=back + +=head1 NOTES + +This table summarizes the mapping of the encodings set up +by the C<Encode::Locale> module: + + Encode | | | + Alias | Windows | Mac OS X | POSIX + ------------+---------+--------------+------------ + locale | ANSI | nl_langinfo | nl_langinfo + locale_fs | ANSI | UTF-8 | nl_langinfo + console_in | OEM | nl_langinfo | nl_langinfo + console_out | OEM | nl_langinfo | nl_langinfo + +=head2 Windows + +Windows has basically 2 sets of APIs. A wide API (based on passing UTF-16 +strings) and a byte based API based a character set called ANSI. The +regular Perl interfaces to the OS currently only uses the ANSI APIs. +Unfortunately ANSI is not a single character set. + +The encoding that corresponds to ANSI varies between different editions of +Windows. For many western editions of Windows ANSI corresponds to CP-1252 +which is a character set similar to ISO-8859-1. Conceptually the ANSI +character set is a similar concept to the POSIX locale CODESET so this module +figures out what the ANSI code page is and make this available as +$ENCODING_LOCALE and the "locale" Encoding alias. + +Windows systems also operate with another byte based character set. +It's called the OEM code page. This is the encoding that the Console +takes as input and output. It's common for the OEM code page to +differ from the ANSI code page. + +=head2 Mac OS X + +On Mac OS X the file system encoding is always UTF-8 while the locale +can otherwise be set up as normal for POSIX systems. + +File names on Mac OS X will at the OS-level be converted to +NFD-form. A file created by passing a NFC-filename will come +in NFD-form from readdir(). See L<Unicode::Normalize> for details +of NFD/NFC. + +Actually, Apple does not follow the Unicode NFD standard since not all +character ranges are decomposed. The claim is that this avoids problems with +round trip conversions from old Mac text encodings. See L<Encode::UTF8Mac> for +details. + +=head2 POSIX (Linux and other Unixes) + +File systems might vary in what encoding is to be used for +filenames. Since this module has no way to actually figure out +what the is correct it goes with the best guess which is to +assume filenames are encoding according to the current locale. +Users are advised to always specify UTF-8 as the locale charset. + +=head1 SEE ALSO + +L<I18N::Langinfo>, L<Encode> + +=head1 AUTHOR + +Copyright 2010 Gisle Aas <gisle@aas.no>. + +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm b/Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm index 9728dc32d89..c41797c7035 100644 --- a/Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm +++ b/Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm @@ -3,7 +3,7 @@ use strict; use warnings; no warnings 'redefine'; -our $VERSION = do { my @r = ( q$Revision: 2.11 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; +our $VERSION = do { my @r = ( q$Revision: 2.13 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; use Encode qw(find_encoding encode_utf8 decode_utf8); use MIME::Base64; use Carp; @@ -95,7 +95,7 @@ sub decode_q { my $especials = join( '|' => map { quotemeta( chr($_) ) } - unpack( "C*", qq{()<>@,;:"'/[]?.=} ) ); + unpack( "C*", qq{()<>,;:"'/[]?=} ) ); my $re_encoded_word = qr{ =\? # begin encoded word @@ -127,11 +127,12 @@ sub encode($$;$) { for my $word (@word) { use bytes (); if ( bytes::length($subline) + bytes::length($word) > - $obj->{bpl} ) + $obj->{bpl} - 1 ) { push @subline, $subline; $subline = ''; } + $subline .= ' ' if ($subline =~ /\?=$/ and $word =~ /^=\?/); $subline .= $word; } $subline and push @subline, $subline; diff --git a/Master/tlpkg/tlperl/lib/Encode/Unicode/UTF7.pm b/Master/tlpkg/tlperl/lib/Encode/Unicode/UTF7.pm index 6ee46195854..1d639627549 100644 --- a/Master/tlpkg/tlperl/lib/Encode/Unicode/UTF7.pm +++ b/Master/tlpkg/tlperl/lib/Encode/Unicode/UTF7.pm @@ -1,5 +1,5 @@ # -# $Id: UTF7.pm,v 2.4 2006/06/03 20:28:48 dankogai Exp $ +# $Id: UTF7.pm,v 2.5 2010/09/18 18:39:51 dankogai Exp $ # package Encode::Unicode::UTF7; use strict; @@ -7,7 +7,7 @@ use warnings; no warnings 'redefine'; use base qw(Encode::Encoding); __PACKAGE__->Define('UTF-7'); -our $VERSION = do { my @r = ( q$Revision: 2.4 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; +our $VERSION = do { my @r = ( q$Revision: 2.5 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; use MIME::Base64; use Encode; @@ -35,7 +35,9 @@ sub encode($$;$) { my $bytes = ''; while ( pos($str) < $len ) { if ( $str =~ /\G($re_asis+)/ogc ) { - $bytes .= $1; + my $octets = $1; + utf8::downgrade($octets); + $bytes .= $octets; } elsif ( $str =~ /\G($re_encoded+)/ogsc ) { if ( $1 eq "+" ) { |