This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Encode to CPAN version 2.73
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Thu, 4 Jun 2015 14:05:28 +0000 (15:05 +0100)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Thu, 4 Jun 2015 14:05:28 +0000 (15:05 +0100)
  [DELTA]

$Revision: 2.73 $ $Date: 2015/04/15 23:14:01 $
! MANIFEST
+ t/isa.t
! Encode.pm
  Addressed RT#103253: Encode::XS does not inherit from Encode::Encoding
  https://rt.cpan.org/Public/Bug/Display.html?id=103253
! encoding.pm
+ t/encoding-locale.t
  Pulled: Rewrite of encoding::_get_locale_encoding for more portability #40
! encoding.pm
  Pulled: encoding.pm: more inlining #39
  https://github.com/dankogai/p5-encode/pull/39

MANIFEST
Porting/Maintainers.pl
cpan/Encode/Encode.pm
cpan/Encode/encoding.pm
cpan/Encode/t/isa.t [new file with mode: 0644]

index 21dc425..0bf9222 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -861,6 +861,7 @@ cpan/Encode/t/gb2312.utf            test data
 cpan/Encode/t/grow.t                   test script
 cpan/Encode/t/gsm0338.t                        test script
 cpan/Encode/t/guess.t                  test script
+cpan/Encode/t/isa.t
 cpan/Encode/t/jis7-fallback.t          test script
 cpan/Encode/t/jisx0201.enc             test data
 cpan/Encode/t/jisx0201.utf             test data
index 07139c8..8d8d07c 100755 (executable)
@@ -379,7 +379,7 @@ use File::Glob qw(:case);
     },
 
     'Encode' => {
-        'DISTRIBUTION' => 'DANKOGAI/Encode-2.72.tar.gz',
+        'DISTRIBUTION' => 'DANKOGAI/Encode-2.73.tar.gz',
         'FILES'        => q[cpan/Encode],
     },
 
index 3bb1097..1c1efd5 100644 (file)
@@ -1,10 +1,10 @@
 #
-# $Id: Encode.pm,v 2.72 2015/03/14 02:43:24 dankogai Exp $
+# $Id: Encode.pm,v 2.73 2015/04/15 23:14:01 dankogai Exp dankogai $
 #
 package Encode;
 use strict;
 use warnings;
-our $VERSION = sprintf "%d.%02d", q$Revision: 2.72 $ =~ /(\d+)/g;
+our $VERSION = sprintf "%d.%02d", q$Revision: 2.73 $ =~ /(\d+)/g;
 use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
 use XSLoader ();
 XSLoader::load( __PACKAGE__, $VERSION );
@@ -311,7 +311,11 @@ sub predefine_encodings {
         $Encode::Encoding{Unicode} =
           bless { Name => "Internal" } => "Encode::Internal";
     }
-
+    {
+        # https://rt.cpan.org/Public/Bug/Display.html?id=103253
+        package Encode::XS;
+        push @Encode::XS::ISA, 'Encode::Encoding';
+    }
     {
 
         # was in Encode::utf8
index fde410d..a2831eb 100644 (file)
@@ -1,12 +1,16 @@
-# $Id: encoding.pm,v 2.14 2015/03/14 02:44:39 dankogai Exp dankogai $
+# $Id: encoding.pm,v 2.15 2015/04/15 23:14:01 dankogai Exp dankogai $
 package encoding;
-our $VERSION = sprintf "%d.%02d", q$Revision: 2.14 $ =~ /(\d+)/g;
+our $VERSION = sprintf "%d.%02d", q$Revision: 2.15 $ =~ /(\d+)/g;
 
 use Encode;
 use strict;
 use warnings;
 
-use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
+use constant {
+    DEBUG => !!$ENV{PERL_ENCODE_DEBUG},
+    HAS_PERLIO => eval { require PerlIO::encoding; PerlIO::encoding->VERSION(0.02) },
+    PERL_5_21_7 => $^V && $^V ge v5.21.7,
+};
 
 BEGIN {
     if ( ord("A") == 193 ) {
@@ -15,12 +19,6 @@ BEGIN {
     }
 }
 
-our $HAS_PERLIO = 0;
-eval { require PerlIO::encoding };
-unless ($@) {
-    $HAS_PERLIO = ( PerlIO::encoding->VERSION >= 0.02 );
-}
-
 sub _exception {
     my $name = shift;
     $] > 5.008 and return 0;    # 5.8.1 or higher then no
@@ -39,64 +37,79 @@ sub in_locale { $^H & ( $locale::hint_bits || 0 ) }
 sub _get_locale_encoding {
     my $locale_encoding;
 
+    if ($^O eq 'MSWin32') {
+        my @tries = (
+            # First try to get the OutputCP. This will work only if we
+            # are attached to a console
+            'Win32.pm' => 'Win32::GetConsoleOutputCP',
+            'Win32/Console.pm' => 'Win32::Console::OutputCP',
+            # If above failed, this means that we are a GUI app
+            # Let's assume that the ANSI codepage is what matters
+            'Win32.pm' => 'Win32::GetACP',
+        );
+        while (@tries) {
+            my $cp = eval {
+                require $tries[0];
+                no strict 'refs';
+                &{$tries[1]}()
+            };
+            if ($cp) {
+                if ($cp == 65001) { # Code page for UTF-8
+                    $locale_encoding = 'UTF-8';
+                } else {
+                    $locale_encoding = 'cp' . $cp;
+                }
+                return $locale_encoding;
+            }
+            splice(@tries, 0, 2)
+        }
+    }
+
     # I18N::Langinfo isn't available everywhere
-    eval {
+    $locale_encoding = eval {
         require I18N::Langinfo;
-        I18N::Langinfo->import(qw(langinfo CODESET));
-        $locale_encoding = langinfo( CODESET() );
+        find_encoding(
+            I18N::Langinfo::langinfo( I18N::Langinfo::CODESET() )
+        )->name
     };
+    return $locale_encoding if defined $locale_encoding;
 
-    my $country_language;
-
-    no warnings 'uninitialized';
-
-    if ( (not $locale_encoding) && in_locale() ) {
-        if ( $ENV{LC_ALL} =~ /^([^.]+)\.([^.@]+)(@.*)?$/ ) {
-            ( $country_language, $locale_encoding ) = ( $1, $2 );
-        }
-        elsif ( $ENV{LANG} =~ /^([^.]+)\.([^.@]+)(@.*)?$/ ) {
+    eval {
+        require POSIX;
+        # Get the current locale
+        # Remember that MSVCRT impl is quite different from Unixes
+        my $locale = POSIX::setlocale(POSIX::LC_CTYPE());
+        if ( $locale =~ /^([^.]+)\.([^.@]+)(?:@.*)?$/ ) {
+            my $country_language;
             ( $country_language, $locale_encoding ) = ( $1, $2 );
-        }
-
-        # LANGUAGE affects only LC_MESSAGES only on glibc
-    }
-    elsif ( not $locale_encoding ) {
-        if (   $ENV{LC_ALL} =~ /\butf-?8\b/i
-            || $ENV{LANG} =~ /\butf-?8\b/i )
-        {
-            $locale_encoding = 'utf8';
-        }
 
-        # Could do more heuristics based on the country and language
-        # parts of LC_ALL and LANG (the parts before the dot (if any)),
-        # since we have Locale::Country and Locale::Language available.
-        # TODO: get a database of Language -> Encoding mappings
-        # (the Estonian database at http://www.eki.ee/letter/
-        # would be excellent!) --jhi
-    }
-    if (   defined $locale_encoding
-        && lc($locale_encoding) eq 'euc'
-        && defined $country_language )
-    {
-        if ( $country_language =~ /^ja_JP|japan(?:ese)?$/i ) {
-            $locale_encoding = 'euc-jp';
-        }
-        elsif ( $country_language =~ /^ko_KR|korean?$/i ) {
-            $locale_encoding = 'euc-kr';
-        }
-        elsif ( $country_language =~ /^zh_CN|chin(?:a|ese)$/i ) {
-            $locale_encoding = 'euc-cn';
-        }
-        elsif ( $country_language =~ /^zh_TW|taiwan(?:ese)?$/i ) {
-            $locale_encoding = 'euc-tw';
-        }
-        else {
-            require Carp;
-            Carp::croak(
-                "encoding: Locale encoding '$locale_encoding' too ambiguous"
-            );
+            # Could do more heuristics based on the country and language
+            # since we have Locale::Country and Locale::Language available.
+            # TODO: get a database of Language -> Encoding mappings
+            # (the Estonian database at http://www.eki.ee/letter/
+            # would be excellent!) --jhi
+            if (lc($locale_encoding) eq 'euc') {
+                if ( $country_language =~ /^ja_JP|japan(?:ese)?$/i ) {
+                    $locale_encoding = 'euc-jp';
+                }
+                elsif ( $country_language =~ /^ko_KR|korean?$/i ) {
+                    $locale_encoding = 'euc-kr';
+                }
+                elsif ( $country_language =~ /^zh_CN|chin(?:a|ese)$/i ) {
+                    $locale_encoding = 'euc-cn';
+                }
+                elsif ( $country_language =~ /^zh_TW|taiwan(?:ese)?$/i ) {
+                    $locale_encoding = 'euc-tw';
+                }
+                else {
+                    require Carp;
+                    Carp::croak(
+                        "encoding: Locale encoding '$locale_encoding' too ambiguous"
+                    );
+                }
+            }
         }
-    }
+    };
 
     return $locale_encoding;
 }
@@ -132,7 +145,7 @@ sub import {
     unless ( $arg{Filter} ) {
         DEBUG and warn "_exception($name) = ", _exception($name);
         if (! _exception($name)) {
-            if (!$^V || $^V lt v5.21.7) {
+            if (!PERL_5_21_7) {
                 ${^ENCODING} = $enc;
             }
             else {
@@ -143,11 +156,11 @@ sub import {
                 ${^E_NCODING} = $enc;
             }
         }
-        $HAS_PERLIO or return 1;
+        HAS_PERLIO or return 1;
     }
     else {
         defined( ${^ENCODING} ) and undef ${^ENCODING};
-        undef ${^E_NCODING} if $^V && $^V ge v5.21.7;
+        undef ${^E_NCODING} if PERL_5_21_7;
 
         # implicitly 'use utf8'
         require utf8;      # to fetch $utf8::hint_bits;
@@ -197,8 +210,8 @@ sub import {
 sub unimport {
     no warnings;
     undef ${^ENCODING};
-    undef ${^E_NCODING} if $^V && $^V ge v5.21.7;
-    if ($HAS_PERLIO) {
+    undef ${^E_NCODING} if PERL_5_21_7;
+    if (HAS_PERLIO) {
         binmode( STDIN,  ":raw" );
         binmode( STDOUT, ":raw" );
     }
diff --git a/cpan/Encode/t/isa.t b/cpan/Encode/t/isa.t
new file mode 100644 (file)
index 0000000..84703a5
--- /dev/null
@@ -0,0 +1,10 @@
+#
+# $Id: isa.t,v 1.1 2015/04/02 12:08:24 dankogai Exp $
+#
+use strict;
+use Encode qw/find_encoding/;
+use Test::More;
+my @enc = Encode->encodings(":all");
+plan tests => 0+@enc;
+isa_ok find_encoding($_), "Encode::Encoding" for @enc;
+