Upgrade to Encode 2.39

diff --git a/cpan/Encode/AUTHORS b/cpan/Encode/AUTHORS
index a470e57..bdbf08d 100644 (file)
--- a/cpan/Encode/AUTHORS
+++ b/cpan/Encode/AUTHORS
@@ -32,6 +32,7 @@ H.Merijn Brand                        <h.m.brand@xs4all.nl>
 Hugo van der Sanden            <hv@crypt.org>
 Inaba Hiroto                   <inaba@st.rim.or.jp>
 Jarkko Hietaniemi              <jhi@iki.fi>
+Jesse Vincent                  <jesse@fsck.com>
 Jungshik Shin                  <jshin@mailaps.org>
 KONNO Hiroharu                 <hiroharu.konno@bowneglobal.co.jp>
 Laszlo Molnar                  <ml1050@freemail.hu>

diff --git a/cpan/Encode/Changes b/cpan/Encode/Changes
index 6c045f7..37868a0 100644 (file)
--- a/cpan/Encode/Changes
+++ b/cpan/Encode/Changes
@@ -1,7 +1,14 @@
 # Revision history for Perl extension Encode.
 #
-# $Id: Changes,v 2.38 2009/11/16 14:08:13 dankogai Exp dankogai $
-$Revision: 2.38 $ $Date: 2009/11/16 14:08:13 $
+# $Id: Changes,v 2.39 2009/11/26 09:23:59 dankogai Exp dankogai $
+! Encode.xs t/fallback.t
+  $utf8 = decode('utf8', $malformed, sub{ ... }) # now works!
+  http://rt.cpan.org/Ticket/Display.html?id=51204
+! t/CJKT.t t/guess.t t/perlio.t
+  $ENV{'PERL_CORE'} tricks removed since they are no longer necessary.
+  Message-Id: <20091116161513.GA25556@bestpractical.com>
+
+$Revision: 2.39 $ $Date: 2009/11/26 09:23:59 $
 ! Encode.xs
   Addressed: Encode memory corruption [perl #70528]
   Message-Id: <alpine.LFD.2.00.0911152328070.9483@ein.m-l.org>

diff --git a/cpan/Encode/Encode.pm b/cpan/Encode/Encode.pm
index 267642c..f1dff78 100644 (file)
--- a/cpan/Encode/Encode.pm
+++ b/cpan/Encode/Encode.pm
@@ -1,10 +1,10 @@
 #
-# $Id: Encode.pm,v 2.38 2009/11/16 14:08:01 dankogai Exp $
+# $Id: Encode.pm,v 2.39 2009/11/26 09:23:48 dankogai Exp $
 #
 package Encode;
 use strict;
 use warnings;
-our $VERSION = sprintf "%d.%02d", q$Revision: 2.38 $ =~ /(\d+)/g;
+our $VERSION = sprintf "%d.%02d", q$Revision: 2.39 $ =~ /(\d+)/g;
 sub DEBUG () { 0 }
 use XSLoader ();
 XSLoader::load( __PACKAGE__, $VERSION );

diff --git a/cpan/Encode/Encode.xs b/cpan/Encode/Encode.xs
index 5b8d84c..b2e9127 100644 (file)
--- a/cpan/Encode/Encode.xs
+++ b/cpan/Encode/Encode.xs
@@ -1,5 +1,5 @@
 /*
- $Id: Encode.xs,v 2.17 2009/11/16 14:08:13 dankogai Exp dankogai $
+ $Id: Encode.xs,v 2.18 2009/11/26 09:23:59 dankogai Exp dankogai $
  */
 
 #define PERL_NO_GET_CONTEXT
@@ -301,11 +301,23 @@ strict_utf8(pTHX_ SV* sv)
 }
 
 static U8*
-process_utf8(pTHX_ SV* dst, U8* s, U8* e, int check,
+process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv,
              bool encode, bool strict, bool stop_at_partial)
 {
     UV uv;
     STRLEN ulen;
+    SV *fallback_cb;
+    int check;
+
+    if (SvROK(check_sv)) {
+       /* croak("UTF-8 decoder doesn't support callback CHECK"); */
+       fallback_cb = check_sv;
+       check = ENCODE_PERLQQ|ENCODE_LEAVE_SRC; /* same as perlqq */
+    }
+    else {
+       fallback_cb = &PL_sv_undef;
+       check = SvIV(check_sv);
+    }
 
     SvPOK_only(dst);
     SvCUR_set(dst,0);
@@ -378,9 +390,16 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, int check,
                 break;
         }
         if (check & (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
-            SV* subchar = newSVpvf(check & ENCODE_PERLQQ ? (ulen == 1 ? "\\x%02" UVXf : "\\x{%04" UVXf "}"):
-                                   check & ENCODE_HTMLCREF ? "&#%" UVuf ";" :
-                                   "&#x%" UVxf ";", uv);
+           SV* subchar =
+               (fallback_cb != &PL_sv_undef)
+               ? do_fallback_cb(aTHX_ uv, fallback_cb)
+               : newSVpvf(check & ENCODE_PERLQQ 
+                          ? (ulen == 1 ? "\\x%02" UVXf : "\\x{%04" UVXf "}")
+                          :  check & ENCODE_HTMLCREF ? "&#%" UVuf ";" 
+                          : "&#x%" UVxf ";", uv);
+           if (encode){
+               SvUTF8_off(subchar); /* make sure no decoded string gets in */
+           }
             sv_catsv(dst, subchar);
             SvREFCNT_dec(subchar);
         } else {
@@ -413,17 +432,11 @@ PREINIT:
 CODE:
 {
     dSP; ENTER; SAVETMPS;
-    if (SvROK(check_sv)) {
-       croak("UTF-8 decoder doesn't support callback CHECK");
-    }
-    else {
-       check = SvIV(check_sv);
-    }
     if (src == &PL_sv_undef) src = newSV(0);
     s = (U8 *) SvPV(src, slen);
     e = (U8 *) SvEND(src);
     dst = newSV(slen>0?slen:1); /* newSV() abhors 0 -- inaba */
-
+    check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvIV(check_sv);
     /* 
      * PerlIO check -- we assume the object is of PerlIO if renewed
      */
@@ -453,7 +466,7 @@ CODE:
     }
     }
 
-    s = process_utf8(aTHX_ dst, s, e, check, 0, strict_utf8(aTHX_ obj), renewed);
+    s = process_utf8(aTHX_ dst, s, e, check_sv, 0, strict_utf8(aTHX_ obj), renewed);
 
     /* Clear out translated part of source unless asked not to */
     if (check && !(check & ENCODE_LEAVE_SRC)){
@@ -482,12 +495,7 @@ PREINIT:
     int check;
 CODE:
 {
-    if (SvROK(check_sv)) {
-       croak("UTF-8 encoder doesn't support callback CHECK");
-    }
-    else {
-       check = SvIV(check_sv);
-    }
+    check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvIV(check_sv);
     if (src == &PL_sv_undef) src = newSV(0);
     s = (U8 *) SvPV(src, slen);
     e = (U8 *) SvEND(src);
@@ -495,7 +503,7 @@ CODE:
     if (SvUTF8(src)) {
     /* Already encoded */
     if (strict_utf8(aTHX_ obj)) {
-        s = process_utf8(aTHX_ dst, s, e, check, 1, 1, 0);
+        s = process_utf8(aTHX_ dst, s, e, check_sv, 1, 1, 0);
     }
         else {
             /* trust it and just copy the octets */

diff --git a/cpan/Encode/META.yml b/cpan/Encode/META.yml
index 70090af..2a5c1ab 100644 (file)
--- a/cpan/Encode/META.yml
+++ b/cpan/Encode/META.yml
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Encode
-version:            2.38
+version:            2.39
 abstract:           ~
 author:  []
 license:            unknown

diff --git a/cpan/Encode/Unicode/Unicode.xs b/cpan/Encode/Unicode/Unicode.xs
index d8ef569..9741626 100644 (file)
--- a/cpan/Encode/Unicode/Unicode.xs
+++ b/cpan/Encode/Unicode/Unicode.xs
@@ -1,5 +1,5 @@
 /*
- $Id: Unicode.xs,v 2.6 2009/11/16 14:08:13 dankogai Exp dankogai $
+ $Id: Unicode.xs,v 2.6 2009/11/16 14:08:13 dankogai Exp $
  */
 
 #define PERL_NO_GET_CONTEXT

diff --git a/cpan/Encode/t/Unicode.t b/cpan/Encode/t/Unicode.t
index d6dd1ec..baa502c 100644 (file)
--- a/cpan/Encode/t/Unicode.t
+++ b/cpan/Encode/t/Unicode.t
@@ -1,5 +1,5 @@
 #
-# $Id: Unicode.t,v 2.2 2009/11/16 14:08:13 dankogai Exp dankogai $
+# $Id: Unicode.t,v 2.2 2009/11/16 14:08:13 dankogai Exp $
 #
 # This script is written entirely in ASCII, even though quoted literals
 # do include non-BMP unicode characters -- Are you happy, jhi?

diff --git a/cpan/Encode/t/fallback.t b/cpan/Encode/t/fallback.t
index f6fcc5a..8ef8ab3 100644 (file)
--- a/cpan/Encode/t/fallback.t
+++ b/cpan/Encode/t/fallback.t
@@ -17,7 +17,7 @@ BEGIN {
 
 use strict;
 #use Test::More qw(no_plan);
-use Test::More tests => 48;
+use Test::More tests => 50;
 use Encode q(:all);
 
 my $uo = '';
@@ -175,3 +175,10 @@ $dst = $ascii->decode($src, sub{ $_[0] });
 is $dst, 0xFF."", qq{$ascii->encode(\$src, sub{ \$_[0] } )};
 $dst = decode("ascii", (pack "C*", 0xFF), sub{ $_[0] });
 is $dst, 0xFF."", qq{decode("ascii", (pack "C*", 0xFF), sub{ \$_[0] })};
+
+
+$src = pack "C*", 0x80;
+$dst = $utf8->decode($src, sub{ $_[0] });
+is $dst, 0x80."", qq{$utf8->encode(\$src, sub{ \$_[0] } )};
+$dst = decode("utf8", $src, sub{ $_[0] });
+is $dst, 0x80."", qq{decode("utf8", (pack "C*", 0x80), sub{ \$_[0] })};

diff --git a/cpan/Encode/t/piconv.t b/cpan/Encode/t/piconv.t
index ee8a814..ed084b4 100644 (file)
--- a/cpan/Encode/t/piconv.t
+++ b/cpan/Encode/t/piconv.t
@@ -1,5 +1,5 @@
 #
-# $Id: piconv.t,v 0.3 2009/11/16 14:08:13 dankogai Exp dankogai $
+# $Id: piconv.t,v 0.3 2009/11/16 14:08:13 dankogai Exp $
 #
 
 BEGIN {