Various tweaks to Encode
[p5sagit/p5-mst-13.2.git] / ext / Encode / Unicode / Unicode.xs
index 4e21de9..9924ae2 100644 (file)
@@ -6,6 +6,8 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+#define U8 U8
+#include "../Encode/encode.h"
 
 #define FBCHAR                 0xFFFd
 #define BOM_BE                 0xFeFF
@@ -80,11 +82,13 @@ enc_pack(pTHX_ SV *result,STRLEN size,U8 endian,UV value)
 
 MODULE = Encode::Unicode PACKAGE = Encode::Unicode
 
+PROTOTYPES: DISABLE
+
 void
-decode_xs(obj, str, chk = &PL_sv_undef)
+decode_xs(obj, str, check = 0)
 SV *   obj
 SV *   str
-SV *   chk
+IV     check
 CODE:
 {
     int size    = SvIV(*hv_fetch((HV *)SvRV(obj),"size",4,0));
@@ -124,14 +128,14 @@ CODE:
        U8 *d;
        if (size != 4 && invalid_ucs2(ord)) {
            if (ucs2) {
-               if (SvTRUE(chk)) {
+               if (check) {
                    croak("%s:no surrogates allowed %"UVxf,
                          SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)),
                          ord);
                }
                if (s+size <= e) {
                     /* skip the next one as well */
-                   enc_unpack(aTHX_ &s,e,size,endian); 
+                   enc_unpack(aTHX_ &s,e,size,endian);
                }
                ord = FBCHAR;
            }
@@ -160,10 +164,12 @@ CODE:
        d = uvuni_to_utf8_flags(d+SvCUR(result), ord, 0);
        SvCUR_set(result,d - (U8 *)SvPVX(result));
     }
-    if (SvTRUE(chk)) {
-       if (s < e) {
+    if (s < e) {
            Perl_warner(aTHX_ packWARN(WARN_UTF8),"%s:Partial character",
                        SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)));
+    }
+    if (check && !(check & ENCODE_LEAVE_SRC)){
+       if (s < e) {
            Move(s,SvPVX(str),e-s,U8);
            SvCUR_set(str,(e-s));
        }
@@ -176,10 +182,10 @@ CODE:
 }
 
 void
-encode_xs(obj, utf8, chk = &PL_sv_undef)
-    SV *       obj
+encode_xs(obj, utf8, check = 0)
+SV *   obj
 SV *   utf8
-SV *   chk
+IV     check
 CODE:
 {
     int size   = SvIV(*hv_fetch((HV *)SvRV(obj),"size",4,0));
@@ -205,7 +211,7 @@ CODE:
        if (size != 4 && invalid_ucs2(ord)) {
            if (!issurrogate(ord)){
                if (ucs2) {
-                   if (SvTRUE(chk)) {
+                   if (check) {
                        croak("%s:code point \"\\x{"UVxf"}\" too high",
                              SvPV_nolen(
                                  *hv_fetch((HV *)SvRV(obj),"Name",4,0))
@@ -228,10 +234,12 @@ CODE:
            enc_pack(aTHX_ result,size,endian,ord);
        }
     }
-    if (SvTRUE(chk)) {
+    if (s < e) {
+       Perl_warner(aTHX_ packWARN(WARN_UTF8),"%s:Partial character",
+                   SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)));
+    }
+    if (check && !(check & ENCODE_LEAVE_SRC)){
        if (s < e) {
-           Perl_warner(aTHX_ packWARN(WARN_UTF8),"%s:Partial character",
-                       SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)));
            Move(s,SvPVX(utf8),e-s,U8);
            SvCUR_set(utf8,(e-s));
        }