summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Encode
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2012-05-21 00:15:27 +0000
committerKarl Berry <karl@freefriends.org>2012-05-21 00:15:27 +0000
commita4c42bfb2337d37da89d789cb8cc226367994e32 (patch)
treec3eabdef5d565a4e515d2be0d9d4d0540bde0250 /Master/tlpkg/tlperl/lib/Encode
parent8274475057f024d35332ac47c2e2f23ea156e6ed (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.pm19
-rw-r--r--Master/tlpkg/tlperl/lib/Encode/Guess.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/Encode/Locale.pm348
-rw-r--r--Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm7
-rw-r--r--Master/tlpkg/tlperl/lib/Encode/Unicode/UTF7.pm8
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 "+" ) {