Upgrade to Encode 2.00.

[p5sagit/p5-mst-13.2.git] / ext / Encode / Unicode / Unicode.xs

diff --git a/ext/Encode/Unicode/Unicode.xs b/ext/Encode/Unicode/Unicode.xs
index 2163fb5..6dadbdc 100644 (file)
--- a/ext/Encode/Unicode/Unicode.xs
+++ b/ext/Encode/Unicode/Unicode.xs
@@ -1,5 +1,5 @@
 /*
- $Id: Unicode.xs,v 1.7 2003/02/20 14:42:34 dankogai Exp $
+ $Id: Unicode.xs,v 2.0 2004/05/16 20:55:16 dankogai Exp $
  */
 
 #define PERL_NO_GET_CONTEXT
@@ -54,7 +54,7 @@ enc_unpack(pTHX_ U8 **sp,U8 *e,STRLEN size,U8 endian)
 void
 enc_pack(pTHX_ SV *result,STRLEN size,U8 endian,UV value)
 {
-    U8 *d = (U8 *)SvGROW(result,SvCUR(result)+size);
+    U8 *d = (U8 *)SvGROW(result,SvCUR(result)+size+1);
     switch(endian) {
     case 'v':
     case 'V':
@@ -84,6 +84,9 @@ MODULE = Encode::Unicode PACKAGE = Encode::Unicode
 
 PROTOTYPES: DISABLE
 
+#define attr(k, l)  (hv_exists((HV *)SvRV(obj),k,l) ? \
+    *hv_fetch((HV *)SvRV(obj),k,l,0) : &PL_sv_undef)
+
 void
 decode_xs(obj, str, check = 0)
 SV *   obj
@@ -91,10 +94,11 @@ SV *        str
 IV     check
 CODE:
 {
-    int size    = SvIV(*hv_fetch((HV *)SvRV(obj),"size",4,0));
-    U8 endian   = *((U8 *)SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"endian",6,0)));
-    int ucs2    = SvTRUE(*hv_fetch((HV *)SvRV(obj),"ucs2",4,0));
-    SV *result = newSVpvn("",0);
+    U8 endian   = *((U8 *)SvPV_nolen(attr("endian", 6)));
+    int size    =   SvIV(attr("size",   4));
+    int ucs2    = SvTRUE(attr("ucs2",   4));
+    int clone   = SvTRUE(attr("clone",  5));
+    SV *result  = newSVpvn("",0);
     STRLEN ulen;
     U8 *s = (U8 *)SvPVbyte(str,ulen);
     U8 *e = (U8 *)SvEND(str);
@@ -118,9 +122,11 @@ CODE:
                      bom);
            }
        }
-#if 0
-       /* Update endian for this sequence */
-       hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
+#if 1
+       /* Update endian for next sequence */
+       if (clone) {
+           hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
+       }
 #endif
     }
     while (s < e && s+size <= e) {
@@ -165,8 +171,11 @@ CODE:
        SvCUR_set(result,d - (U8 *)SvPVX(result));
     }
     if (s < e) {
+       /* unlikely to happen because it's fixed-length -- dankogai */
+       if (check & ENCODE_WARN_ON_ERR){
            Perl_warner(aTHX_ packWARN(WARN_UTF8),"%"SVf":Partial character",
                        *hv_fetch((HV *)SvRV(obj),"Name",4,0));
+       }
     }
     if (check && !(check & ENCODE_LEAVE_SRC)){
        if (s < e) {
@@ -188,10 +197,11 @@ SV *      utf8
 IV     check
 CODE:
 {
-    int size   = SvIV(*hv_fetch((HV *)SvRV(obj),"size",4,0));
-    U8 endian = *((U8 *)SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"endian",6,0)));
-    int ucs2   = SvTRUE(*hv_fetch((HV *)SvRV(obj),"ucs2",4,0));
-    SV *result = newSVpvn("",0);
+    U8 endian   = *((U8 *)SvPV_nolen(attr("endian", 6)));
+    int size    =   SvIV(attr("size",   4));
+    int ucs2    = SvTRUE(attr("ucs2",   4));
+    int clone   = SvTRUE(attr("clone",  5));
+    SV *result  = newSVpvn("",0);
     STRLEN ulen;
     U8 *s = (U8 *)SvPVutf8(utf8,ulen);
     U8 *e = (U8 *)SvEND(utf8);
@@ -199,9 +209,11 @@ CODE:
     if (!endian) {
        endian = (size == 4) ? 'N' : 'n';
        enc_pack(aTHX_ result,size,endian,BOM_BE);
-#if 0
-       /* Update endian for this sequence */
-       hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
+#if 1
+       /* Update endian for next sequence */
+       if (clone){
+           hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
+       }
 #endif
     }
     while (s < e && s+UTF8SKIP(s) <= e) {
@@ -233,8 +245,16 @@ CODE:
        }
     }
     if (s < e) {
-       Perl_warner(aTHX_ packWARN(WARN_UTF8),"%"SVf":Partial character",
-                   *hv_fetch((HV *)SvRV(obj),"Name",4,0));
+       /* UTF-8 partial char happens often on PerlIO.
+          Since this is okay and normal, we do not warn.
+          But this is critical when you choose to LEAVE_SRC
+          in which case we die */
+       if (check & (ENCODE_DIE_ON_ERR|ENCODE_LEAVE_SRC)){
+           Perl_croak(aTHX_ "%"SVf":partial character is not allowed "
+                      "when CHECK = 0x%" UVuf,
+                      *hv_fetch((HV *)SvRV(obj),"Name",4,0), check);
+       }
+       
     }
     if (check && !(check & ENCODE_LEAVE_SRC)){
        if (s < e) {
@@ -245,7 +265,7 @@ CODE:
            SvCUR_set(utf8,0);
        }
        *SvEND(utf8) = '\0';
-    }
+    } 
     XSRETURN(1);
 }