This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Encode: synch with CPAN version 3.01
[perl5.git] / cpan / Encode / Encode.xs
CommitLineData
85982a32 1/*
e06f52f0 2 $Id: Encode.xs,v 2.47 2019/03/13 00:26:18 dankogai Exp dankogai $
85982a32
JH
3 */
4
fcf2db38 5#define PERL_NO_GET_CONTEXT
20797ee1 6#define IN_ENCODE_XS
2c674647
JH
7#include "EXTERN.h"
8#include "perl.h"
9#include "XSUB.h"
2f2b4ff2 10#include "encode.h"
127a7155 11#include "def_t.h"
10c5ecbb
JH
12
13# define PERLIO_MODNAME "PerlIO::encoding"
0ab8f81e 14# define PERLIO_FILENAME "PerlIO/encoding.pm"
aae85ceb 15
85982a32
JH
16/* set 1 or more to profile. t/encoding.t dumps core because of
17 Perl_warner and PerlIO don't work well */
c6a7db43 18#define ENCODE_XS_PROFILE 0
39cf9a5e 19
85982a32
JH
20/* set 0 to disable floating point to calculate buffer size for
21 encode_method(). 1 is recommended. 2 restores NI-S original */
c6a7db43 22#define ENCODE_XS_USEFP 1
39cf9a5e 23
15f5e486
SH
24#ifndef SvIV_nomg
25#define SvIV_nomg SvIV
26#endif
27
20797ee1
DK
28#ifndef SvTRUE_nomg
29#define SvTRUE_nomg SvTRUE
30#endif
31
32#ifndef SVfARG
33#define SVfARG(p) ((void*)(p))
c31ca201
SH
34#endif
35
13cf5167 36static void
aa0053b7 37Encode_XSEncoding(pTHX_ encode_t * enc)
2f2b4ff2 38{
aa0053b7
NIS
39 dSP;
40 HV *stash = gv_stashpv("Encode::XS", TRUE);
c7981a06
SH
41 SV *iv = newSViv(PTR2IV(enc));
42 SV *sv = sv_bless(newRV_noinc(iv),stash);
aa0053b7 43 int i = 0;
89c2544c
DM
44 /* with the SvLEN() == 0 hack, PVX won't be freed. We cast away name's
45 constness, in the hope that perl won't mess with it. */
46 assert(SvTYPE(iv) >= SVt_PV); assert(SvLEN(iv) == 0);
c7981a06 47 SvFLAGS(iv) |= SVp_POK;
89c2544c 48 SvPVX(iv) = (char*) enc->name[0];
aa0053b7
NIS
49 PUSHMARK(sp);
50 XPUSHs(sv);
51 while (enc->name[i]) {
d1256cb1
RGS
52 const char *name = enc->name[i++];
53 XPUSHs(sv_2mortal(newSVpvn(name, strlen(name))));
aa0053b7
NIS
54 }
55 PUTBACK;
56 call_pv("Encode::define_encoding", G_DISCARD);
57 SvREFCNT_dec(sv);
2f2b4ff2
NIS
58}
59
13cf5167 60static void
15f5e486
SH
61utf8_safe_downgrade(pTHX_ SV ** src, U8 ** s, STRLEN * slen, bool modify)
62{
63 if (!modify) {
64 SV *tmp = sv_2mortal(newSVpvn((char *)*s, *slen));
65 SvUTF8_on(tmp);
66 if (SvTAINTED(*src))
67 SvTAINTED_on(tmp);
68 *src = tmp;
69 *s = (U8 *)SvPVX(*src);
70 }
71 if (*slen) {
72 if (!utf8_to_bytes(*s, slen))
73 croak("Wide character");
74 SvCUR_set(*src, *slen);
75 }
76 SvUTF8_off(*src);
77}
78
79static void
80utf8_safe_upgrade(pTHX_ SV ** src, U8 ** s, STRLEN * slen, bool modify)
81{
82 if (!modify) {
83 SV *tmp = sv_2mortal(newSVpvn((char *)*s, *slen));
84 if (SvTAINTED(*src))
85 SvTAINTED_on(tmp);
86 *src = tmp;
87 }
88 sv_utf8_upgrade_nomg(*src);
89 *s = (U8 *)SvPV_nomg(*src, *slen);
90}
85982a32 91
2fc614e0
JH
92#define ERR_ENCODE_NOMAP "\"\\x{%04" UVxf "}\" does not map to %s"
93#define ERR_DECODE_NOMAP "%s \"\\x%02" UVXf "\" does not map to Unicode"
3f60a930 94#define ERR_DECODE_STR_NOMAP "%s \"%s\" does not map to Unicode"
2fc614e0 95
2f2b4ff2 96static SV *
370462a2 97do_fallback_cb(pTHX_ UV ch, SV *fallback_cb)
8e180e82
SP
98{
99 dSP;
100 int argc;
3f60a930 101 SV *retval;
8e180e82
SP
102 ENTER;
103 SAVETMPS;
104 PUSHMARK(sp);
3f60a930 105 XPUSHs(sv_2mortal(newSVuv(ch)));
8e180e82
SP
106 PUTBACK;
107 argc = call_sv(fallback_cb, G_SCALAR);
108 SPAGAIN;
109 if (argc != 1){
370462a2 110 croak("fallback sub must return scalar!");
8e180e82 111 }
3f60a930
AC
112 retval = POPs;
113 SvREFCNT_inc(retval);
114 PUTBACK;
115 FREETMPS;
116 LEAVE;
117 return retval;
118}
119
120static SV *
121do_bytes_fallback_cb(pTHX_ U8 *s, STRLEN slen, SV *fallback_cb)
122{
123 dSP;
124 int argc;
125 STRLEN i;
126 SV *retval;
127 ENTER;
128 SAVETMPS;
129 PUSHMARK(sp);
130 for (i=0; i<slen; ++i)
131 XPUSHs(sv_2mortal(newSVuv(s[i])));
132 PUTBACK;
133 argc = call_sv(fallback_cb, G_SCALAR);
134 SPAGAIN;
135 if (argc != 1){
136 croak("fallback sub must return scalar!");
137 }
138 retval = POPs;
139 SvREFCNT_inc(retval);
8e180e82
SP
140 PUTBACK;
141 FREETMPS;
142 LEAVE;
143 return retval;
144}
145
146static SV *
15f5e486 147encode_method(pTHX_ const encode_t * enc, const encpage_t * dir, SV * src, U8 * s, STRLEN slen,
20797ee1 148 IV check, STRLEN * offset, SV * term, int * retcode,
370462a2 149 SV *fallback_cb)
2f2b4ff2 150{
bbe6f202 151 U8 *sorig = s;
3aececda
NIS
152 STRLEN tlen = slen;
153 STRLEN ddone = 0;
154 STRLEN sdone = 0;
3c49ab08 155 /* We allocate slen+1.
85982a32 156 PerlIO dumps core if this value is smaller than this. */
15f5e486 157 SV *dst = newSV(slen+1);
85982a32
JH
158 U8 *d = (U8 *)SvPVX(dst);
159 STRLEN dlen = SvLEN(dst)-1;
220e2d4e
IH
160 int code = 0;
161 STRLEN trmlen = 0;
cc7dbc11 162 U8 *trm = term ? (U8*) SvPV(term, trmlen) : NULL;
220e2d4e 163
bbf2f5be
CBW
164 if (SvTAINTED(src)) SvTAINTED_on(dst); /* propagate taintedness */
165
220e2d4e
IH
166 if (offset) {
167 s += *offset;
6be7c101 168 if (slen > *offset){ /* safeguard against slen overflow */
c31ca201 169 slen -= *offset;
6be7c101 170 }else{
c31ca201 171 slen = 0;
6be7c101 172 }
220e2d4e
IH
173 tlen = slen;
174 }
85982a32 175
6be7c101 176 if (slen == 0){
c31ca201
SH
177 SvCUR_set(dst, 0);
178 SvPOK_only(dst);
179 goto ENCODE_END;
85982a32
JH
180 }
181
220e2d4e 182 while( (code = do_encode(dir, s, &slen, d, dlen, &dlen, !check,
c31ca201 183 trm, trmlen)) )
85982a32 184 {
c31ca201
SH
185 SvCUR_set(dst, dlen+ddone);
186 SvPOK_only(dst);
187
188 if (code == ENCODE_FALLBACK || code == ENCODE_PARTIAL ||
189 code == ENCODE_FOUND_TERM) {
190 break;
191 }
192 switch (code) {
193 case ENCODE_NOSPACE:
194 {
195 STRLEN more = 0; /* make sure you initialize! */
196 STRLEN sleft;
197 sdone += slen;
198 ddone += dlen;
199 sleft = tlen - sdone;
fcb875d4 200#if ENCODE_XS_PROFILE >= 2
c31ca201
SH
201 Perl_warn(aTHX_
202 "more=%d, sdone=%d, sleft=%d, SvLEN(dst)=%d\n",
203 more, sdone, sleft, SvLEN(dst));
fcb875d4 204#endif
c31ca201 205 if (sdone != 0) { /* has src ever been processed ? */
39cf9a5e 206#if ENCODE_XS_USEFP == 2
c31ca201
SH
207 more = (1.0*tlen*SvLEN(dst)+sdone-1)/sdone
208 - SvLEN(dst);
39cf9a5e 209#elif ENCODE_XS_USEFP
c31ca201 210 more = (STRLEN)((1.0*SvLEN(dst)+1)/sdone * sleft);
39cf9a5e 211#else
c31ca201
SH
212 /* safe until SvLEN(dst) == MAX_INT/16 */
213 more = (16*SvLEN(dst)+1)/sdone/16 * sleft;
39cf9a5e 214#endif
c31ca201
SH
215 }
216 more += UTF8_MAXLEN; /* insurance policy */
217 d = (U8 *) SvGROW(dst, SvLEN(dst) + more);
218 /* dst need to grow need MORE bytes! */
219 if (ddone >= SvLEN(dst)) {
220 Perl_croak(aTHX_ "Destination couldn't be grown.");
221 }
222 dlen = SvLEN(dst)-ddone-1;
223 d += ddone;
224 s += slen;
225 slen = tlen-sdone;
226 continue;
d1256cb1 227 }
c31ca201 228
d1256cb1
RGS
229 case ENCODE_NOREP:
230 /* encoding */
231 if (dir == enc->f_utf8) {
232 STRLEN clen;
233 UV ch =
15f5e486 234 utf8n_to_uvuni(s+slen, (tlen-sdone-slen),
d1256cb1
RGS
235 &clen, UTF8_ALLOW_ANY|UTF8_CHECK_ONLY);
236 /* if non-representable multibyte prefix at end of current buffer - break*/
15f5e486 237 if (clen > tlen - sdone - slen) break;
d1256cb1
RGS
238 if (check & ENCODE_DIE_ON_ERR) {
239 Perl_croak(aTHX_ ERR_ENCODE_NOMAP,
240 (UV)ch, enc->name[0]);
241 return &PL_sv_undef; /* never reaches but be safe */
242 }
20797ee1 243 if (encode_ckWARN(check, WARN_UTF8)) {
d1256cb1
RGS
244 Perl_warner(aTHX_ packWARN(WARN_UTF8),
245 ERR_ENCODE_NOMAP, (UV)ch, enc->name[0]);
246 }
247 if (check & ENCODE_RETURN_ON_ERR){
248 goto ENCODE_SET_SRC;
249 }
250 if (check & (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
3f60a930
AC
251 STRLEN sublen;
252 char *substr;
d1256cb1 253 SV* subchar =
370462a2
RGS
254 (fallback_cb != &PL_sv_undef)
255 ? do_fallback_cb(aTHX_ ch, fallback_cb)
15f5e486 256 : newSVpvf(check & ENCODE_PERLQQ ? "\\x{%04" UVxf "}" :
d1256cb1
RGS
257 check & ENCODE_HTMLCREF ? "&#%" UVuf ";" :
258 "&#x%" UVxf ";", (UV)ch);
3f60a930
AC
259 substr = SvPV(subchar, sublen);
260 if (SvUTF8(subchar) && sublen && !utf8_to_bytes((U8 *)substr, &sublen)) { /* make sure no decoded string gets in */
261 SvREFCNT_dec(subchar);
262 croak("Wide character");
263 }
d1256cb1 264 sdone += slen + clen;
3f60a930
AC
265 ddone += dlen + sublen;
266 sv_catpvn(dst, substr, sublen);
d1256cb1
RGS
267 SvREFCNT_dec(subchar);
268 } else {
269 /* fallback char */
270 sdone += slen + clen;
271 ddone += dlen + enc->replen;
272 sv_catpvn(dst, (char*)enc->rep, enc->replen);
273 }
274 }
275 /* decoding */
276 else {
277 if (check & ENCODE_DIE_ON_ERR){
278 Perl_croak(aTHX_ ERR_DECODE_NOMAP,
436c6dd3 279 enc->name[0], (UV)s[slen]);
d1256cb1
RGS
280 return &PL_sv_undef; /* never reaches but be safe */
281 }
20797ee1 282 if (encode_ckWARN(check, WARN_UTF8)) {
d1256cb1
RGS
283 Perl_warner(
284 aTHX_ packWARN(WARN_UTF8),
285 ERR_DECODE_NOMAP,
436c6dd3 286 enc->name[0], (UV)s[slen]);
d1256cb1
RGS
287 }
288 if (check & ENCODE_RETURN_ON_ERR){
289 goto ENCODE_SET_SRC;
290 }
291 if (check &
292 (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
3f60a930
AC
293 STRLEN sublen;
294 char *substr;
d1256cb1 295 SV* subchar =
370462a2
RGS
296 (fallback_cb != &PL_sv_undef)
297 ? do_fallback_cb(aTHX_ (UV)s[slen], fallback_cb)
298 : newSVpvf("\\x%02" UVXf, (UV)s[slen]);
3f60a930 299 substr = SvPVutf8(subchar, sublen);
d1256cb1 300 sdone += slen + 1;
3f60a930
AC
301 ddone += dlen + sublen;
302 sv_catpvn(dst, substr, sublen);
d1256cb1
RGS
303 SvREFCNT_dec(subchar);
304 } else {
305 sdone += slen + 1;
306 ddone += dlen + strlen(FBCHAR_UTF8);
3f60a930 307 sv_catpvn(dst, FBCHAR_UTF8, strlen(FBCHAR_UTF8));
d1256cb1
RGS
308 }
309 }
310 /* settle variables when fallback */
311 d = (U8 *)SvEND(dst);
c31ca201 312 dlen = SvLEN(dst) - ddone - 1;
bbe6f202 313 s = sorig + sdone;
d1256cb1
RGS
314 slen = tlen - sdone;
315 break;
316
c31ca201
SH
317 default:
318 Perl_croak(aTHX_ "Unexpected code %d converting %s %s",
319 code, (dir == enc->f_utf8) ? "to" : "from",
320 enc->name[0]);
321 return &PL_sv_undef;
322 }
323 } /* End of looping through the string */
85982a32 324 ENCODE_SET_SRC:
ca777f1c 325 if (check && !(check & ENCODE_LEAVE_SRC)){
bbe6f202 326 sdone = tlen - (slen+sdone);
d1256cb1 327 sv_setpvn(src, (char*)s+slen, sdone);
bbe6f202 328 SvSETMAGIC(src);
2f2b4ff2 329 }
85982a32 330 /* warn("check = 0x%X, code = 0x%d\n", check, code); */
c6a7db43 331
85982a32
JH
332 SvCUR_set(dst, dlen+ddone);
333 SvPOK_only(dst);
c6a7db43 334
39cf9a5e 335#if ENCODE_XS_PROFILE
bbe6f202 336 if (SvCUR(dst) > tlen){
d1256cb1
RGS
337 Perl_warn(aTHX_
338 "SvLEN(dst)=%d, SvCUR(dst)=%d. %d bytes unused(%f %%)\n",
339 SvLEN(dst), SvCUR(dst), SvLEN(dst) - SvCUR(dst),
340 (SvLEN(dst) - SvCUR(dst))*1.0/SvLEN(dst)*100.0);
39cf9a5e 341 }
3c49ab08 342#endif
c6a7db43 343
c31ca201 344 if (offset)
220e2d4e
IH
345 *offset += sdone + slen;
346
85982a32 347 ENCODE_END:
0b3236bb 348 *SvEND(dst) = '\0';
220e2d4e 349 if (retcode) *retcode = code;
aa0053b7 350 return dst;
2f2b4ff2
NIS
351}
352
7f0d54d7
RGS
353static bool
354strict_utf8(pTHX_ SV* sv)
355{
356 HV* hv;
357 SV** svp;
358 sv = SvRV(sv);
359 if (!sv || SvTYPE(sv) != SVt_PVHV)
360 return 0;
361 hv = (HV*)sv;
362 svp = hv_fetch(hv, "strict_utf8", 11, 0);
363 if (!svp)
364 return 0;
365 return SvTRUE(*svp);
366}
367
368static U8*
b9627ca0 369process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv,
7f0d54d7
RGS
370 bool encode, bool strict, bool stop_at_partial)
371{
c31ca201
SH
372 /* Copies the purportedly UTF-8 encoded string starting at 's' and ending
373 * at 'e' - 1 to 'dst', checking as it goes along that the string actually
374 * is valid UTF-8. There are two levels of strictness checking. If
375 * 'strict' is FALSE, the string is checked for being well-formed UTF-8, as
376 * extended by Perl. Additionally, if 'strict' is TRUE, above-Unicode code
377 * points, surrogates, and non-character code points are checked for. When
378 * invalid input is encountered, some action is taken, exactly what depends
379 * on the flags in 'check_sv'. 'encode' gives if this is from an encode
380 * operation (if TRUE), or a decode one. This function returns the
381 * position in 's' of the start of the next character beyond where it got
382 * to. If there were no problems, that will be 'e'. If 'stop_at_partial'
383 * is TRUE, if the final character before 'e' is incomplete, but valid as
384 * far as is available, no action will be taken on that partial character,
385 * and the return value will point to its first byte */
386
7f0d54d7
RGS
387 UV uv;
388 STRLEN ulen;
b9627ca0 389 SV *fallback_cb;
20797ee1 390 IV check;
313d8687
SH
391 U8 *d;
392 STRLEN dlen;
3f60a930
AC
393 char esc[UTF8_MAXLEN * 6 + 1];
394 STRLEN i;
c31ca201
SH
395 const U32 flags = (strict)
396 ? UTF8_DISALLOW_ILLEGAL_INTERCHANGE
20797ee1 397 : 0;
b9627ca0 398
20797ee1
DK
399 if (!SvOK(check_sv)) {
400 fallback_cb = &PL_sv_undef;
401 check = 0;
402 }
403 else if (SvROK(check_sv)) {
b9627ca0
RGS
404 /* croak("UTF-8 decoder doesn't support callback CHECK"); */
405 fallback_cb = check_sv;
406 check = ENCODE_PERLQQ|ENCODE_LEAVE_SRC; /* same as perlqq */
407 }
408 else {
409 fallback_cb = &PL_sv_undef;
15f5e486 410 check = SvIV_nomg(check_sv);
b9627ca0 411 }
7f0d54d7
RGS
412
413 SvPOK_only(dst);
414 SvCUR_set(dst,0);
415
313d8687
SH
416 dlen = (s && e && s < e) ? e-s+1 : 1;
417 d = (U8 *) SvGROW(dst, dlen);
418
c31ca201
SH
419 stop_at_partial = stop_at_partial || (check & ENCODE_STOP_AT_PARTIAL);
420
7f0d54d7 421 while (s < e) {
c31ca201 422
c31ca201
SH
423 /* If there were no errors, this will be 'e'; otherwise it will point
424 * to the first byte of the erroneous input */
425 const U8* e_or_where_failed;
426 bool valid = is_utf8_string_loc_flags(s, e - s, &e_or_where_failed, flags);
427 STRLEN len = e_or_where_failed - s;
428
429 /* Copy as far as was successful */
430 Move(s, d, len, U8);
431 d += len;
432 s = (U8 *) e_or_where_failed;
433
434 /* Are done if it was valid, or we are accepting partial characters and
435 * the only error is that the final bytes form a partial character */
436 if ( LIKELY(valid)
437 || ( stop_at_partial
438 && is_utf8_valid_partial_char_flags(s, e, flags)))
439 {
440 break;
441 }
442
443 /* Here, was not valid. If is 'strict', and is legal extended UTF-8,
444 * we know it is a code point whose value we can calculate, just not
445 * one accepted under strict. Otherwise, it is malformed in some way.
446 * In either case, the system function can calculate either the code
447 * point, or the best substitution for it */
448 uv = utf8n_to_uvchr(s, e - s, &ulen, UTF8_ALLOW_ANY);
449
20797ee1 450 /*
c31ca201
SH
451 * Here, we are looping through the input and found an error.
452 * 'uv' is the code point in error if calculable, or the REPLACEMENT
453 * CHARACTER if not.
454 * 'ulen' is how many bytes of input this iteration of the loop
455 * consumes */
456
3f60a930
AC
457 if (!encode && (check & (ENCODE_DIE_ON_ERR|ENCODE_WARN_ON_ERR|ENCODE_PERLQQ)))
458 for (i=0; i<ulen; ++i) sprintf(esc+4*i, "\\x%02X", s[i]);
7f0d54d7
RGS
459 if (check & ENCODE_DIE_ON_ERR){
460 if (encode)
3f60a930 461 Perl_croak(aTHX_ ERR_ENCODE_NOMAP, uv, (strict ? "UTF-8" : "utf8"));
7f0d54d7 462 else
3f60a930 463 Perl_croak(aTHX_ ERR_DECODE_STR_NOMAP, (strict ? "UTF-8" : "utf8"), esc);
7f0d54d7 464 }
20797ee1 465 if (encode_ckWARN(check, WARN_UTF8)) {
7f0d54d7
RGS
466 if (encode)
467 Perl_warner(aTHX_ packWARN(WARN_UTF8),
3f60a930 468 ERR_ENCODE_NOMAP, uv, (strict ? "UTF-8" : "utf8"));
7f0d54d7
RGS
469 else
470 Perl_warner(aTHX_ packWARN(WARN_UTF8),
3f60a930 471 ERR_DECODE_STR_NOMAP, (strict ? "UTF-8" : "utf8"), esc);
7f0d54d7
RGS
472 }
473 if (check & ENCODE_RETURN_ON_ERR) {
474 break;
475 }
476 if (check & (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
3f60a930
AC
477 STRLEN sublen;
478 char *substr;
479 SV* subchar;
480 if (encode) {
481 subchar =
482 (fallback_cb != &PL_sv_undef)
483 ? do_fallback_cb(aTHX_ uv, fallback_cb)
484 : newSVpvf(check & ENCODE_PERLQQ
485 ? (ulen == 1 ? "\\x%02" UVXf : "\\x{%04" UVXf "}")
486 : check & ENCODE_HTMLCREF ? "&#%" UVuf ";"
487 : "&#x%" UVxf ";", uv);
488 substr = SvPV(subchar, sublen);
489 if (SvUTF8(subchar) && sublen && !utf8_to_bytes((U8 *)substr, &sublen)) { /* make sure no decoded string gets in */
490 SvREFCNT_dec(subchar);
491 croak("Wide character");
492 }
493 } else {
494 if (fallback_cb != &PL_sv_undef) {
495 /* in decode mode we have sequence of wrong bytes */
496 subchar = do_bytes_fallback_cb(aTHX_ s, ulen, fallback_cb);
497 } else {
498 char *ptr = esc;
499 /* ENCODE_PERLQQ is already stored in esc */
500 if (check & (ENCODE_HTMLCREF|ENCODE_XMLCREF))
501 for (i=0; i<ulen; ++i) ptr += sprintf(ptr, ((check & ENCODE_HTMLCREF) ? "&#%u;" : "&#x%02X;"), s[i]);
502 subchar = newSVpvn(esc, strlen(esc));
503 }
504 substr = SvPVutf8(subchar, sublen);
505 }
506 dlen += sublen - ulen;
313d8687
SH
507 SvCUR_set(dst, d-(U8 *)SvPVX(dst));
508 *SvEND(dst) = '\0';
3f60a930 509 sv_catpvn(dst, substr, sublen);
7f0d54d7 510 SvREFCNT_dec(subchar);
313d8687 511 d = (U8 *) SvGROW(dst, dlen) + SvCUR(dst);
7f0d54d7 512 } else {
313d8687
SH
513 STRLEN fbcharlen = strlen(FBCHAR_UTF8);
514 dlen += fbcharlen - ulen;
515 if (SvLEN(dst) < dlen) {
516 SvCUR_set(dst, d-(U8 *)SvPVX(dst));
517 d = (U8 *) sv_grow(dst, dlen) + SvCUR(dst);
518 }
519 memcpy(d, FBCHAR_UTF8, fbcharlen);
520 d += fbcharlen;
7f0d54d7
RGS
521 }
522 s += ulen;
523 }
313d8687 524 SvCUR_set(dst, d-(U8 *)SvPVX(dst));
7f0d54d7
RGS
525 *SvEND(dst) = '\0';
526
527 return s;
528}
529
20797ee1
DK
530static SV *
531find_encoding(pTHX_ SV *enc)
532{
533 dSP;
534 I32 count;
535 SV *m_enc;
536 SV *obj = &PL_sv_undef;
537#ifndef SV_NOSTEAL
538 U32 tmp;
539#endif
540
541 ENTER;
542 SAVETMPS;
543 PUSHMARK(sp);
544
545 m_enc = sv_newmortal();
546#ifndef SV_NOSTEAL
547 tmp = SvFLAGS(enc) & SVs_TEMP;
548 SvTEMP_off(enc);
549 sv_setsv_flags(m_enc, enc, 0);
550 SvFLAGS(enc) |= tmp;
551#else
552#if SV_NOSTEAL == 0
553 #error You have broken SV_NOSTEAL which cause memory corruption in sv_setsv_flags()
554 #error Most probably broken SV_NOSTEAL was defined by buggy version of ppport.h
555#else
556 sv_setsv_flags(m_enc, enc, SV_NOSTEAL);
557#endif
558#endif
559 XPUSHs(m_enc);
560
561 PUTBACK;
562
563 count = call_pv("Encode::find_encoding", G_SCALAR);
564
565 SPAGAIN;
566
567 if (count > 0) {
568 obj = POPs;
569 SvREFCNT_inc(obj);
570 }
571
572 PUTBACK;
573 FREETMPS;
574 LEAVE;
575 return sv_2mortal(obj);
576}
577
578static SV *
579call_encoding(pTHX_ const char *method, SV *obj, SV *src, SV *check)
580{
581 dSP;
582 I32 count;
583 SV *dst = &PL_sv_undef;
584
585 PUSHMARK(sp);
586
587 if (check)
588 check = sv_2mortal(newSVsv(check));
589
590 if (!check || SvROK(check) || !SvTRUE_nomg(check) || (SvIV_nomg(check) & ENCODE_LEAVE_SRC))
591 src = sv_2mortal(newSVsv(src));
592
593 XPUSHs(obj);
594 XPUSHs(src);
595 XPUSHs(check ? check : &PL_sv_no);
596
597 PUTBACK;
598
599 count = call_method(method, G_SCALAR);
600
601 SPAGAIN;
602
603 if (count > 0) {
604 dst = POPs;
605 SvREFCNT_inc(dst);
606 }
607
608 PUTBACK;
609 return dst;
610}
611
7f0d54d7 612
ab3374e4
DK
613MODULE = Encode PACKAGE = Encode::utf8 PREFIX = Method_
614
a0d8a30e
DK
615PROTOTYPES: DISABLE
616
617void
3f60a930 618Method_decode(obj,src,check_sv = &PL_sv_no)
ab3374e4
DK
619SV * obj
620SV * src
b2deda17 621SV * check_sv
e83d9f5f
RGS
622PREINIT:
623 STRLEN slen;
624 U8 *s;
625 U8 *e;
626 SV *dst;
627 bool renewed = 0;
20797ee1 628 IV check;
15f5e486 629 bool modify;
3f60a930 630 dSP;
15f5e486
SH
631INIT:
632 SvGETMAGIC(src);
633 SvGETMAGIC(check_sv);
e06f52f0 634 check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvOK(check_sv) ? SvIV_nomg(check_sv) : 0;
15f5e486 635 modify = (check && !(check & ENCODE_LEAVE_SRC));
3f60a930 636PPCODE:
15f5e486
SH
637 if (!SvOK(src))
638 XSRETURN_UNDEF;
639 s = modify ? (U8 *)SvPV_force_nomg(src, slen) : (U8 *)SvPV_nomg(src, slen);
640 if (SvUTF8(src))
641 utf8_safe_downgrade(aTHX_ &src, &s, &slen, modify);
642 e = s+slen;
643
c31ca201 644 /*
7f0d54d7 645 * PerlIO check -- we assume the object is of PerlIO if renewed
cc836e95 646 */
15f5e486 647 ENTER; SAVETMPS;
cc836e95
RGS
648 PUSHMARK(sp);
649 XPUSHs(obj);
650 PUTBACK;
651 if (call_method("renewed",G_SCALAR) == 1) {
d1256cb1
RGS
652 SPAGAIN;
653 renewed = (bool)POPi;
c31ca201 654 PUTBACK;
cc836e95 655#if 0
d1256cb1 656 fprintf(stderr, "renewed == %d\n", renewed);
cc836e95 657#endif
cc836e95
RGS
658 }
659 FREETMPS; LEAVE;
660 /* end PerlIO check */
661
1e1ac268 662 dst = sv_2mortal(newSV(slen>0?slen:1)); /* newSV() abhors 0 -- inaba */
b9627ca0 663 s = process_utf8(aTHX_ dst, s, e, check_sv, 0, strict_utf8(aTHX_ obj), renewed);
ab3374e4
DK
664
665 /* Clear out translated part of source unless asked not to */
15f5e486 666 if (modify) {
bbe6f202 667 slen = e-s;
d1256cb1 668 sv_setpvn(src, (char*)s, slen);
bbe6f202 669 SvSETMAGIC(src);
ab3374e4
DK
670 }
671 SvUTF8_on(dst);
bbf2f5be 672 if (SvTAINTED(src)) SvTAINTED_on(dst); /* propagate taintedness */
1e1ac268 673 ST(0) = dst;
ab3374e4 674 XSRETURN(1);
ab3374e4
DK
675
676void
3f60a930 677Method_encode(obj,src,check_sv = &PL_sv_no)
ab3374e4
DK
678SV * obj
679SV * src
b2deda17 680SV * check_sv
e83d9f5f
RGS
681PREINIT:
682 STRLEN slen;
683 U8 *s;
684 U8 *e;
685 SV *dst;
20797ee1 686 IV check;
15f5e486
SH
687 bool modify;
688INIT:
689 SvGETMAGIC(src);
690 SvGETMAGIC(check_sv);
e06f52f0 691 check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvOK(check_sv) ? SvIV_nomg(check_sv) : 0;
15f5e486 692 modify = (check && !(check & ENCODE_LEAVE_SRC));
3f60a930 693PPCODE:
15f5e486
SH
694 if (!SvOK(src))
695 XSRETURN_UNDEF;
696 s = modify ? (U8 *)SvPV_force_nomg(src, slen) : (U8 *)SvPV_nomg(src, slen);
697 e = s+slen;
1e1ac268 698 dst = sv_2mortal(newSV(slen>0?slen:1)); /* newSV() abhors 0 -- inaba */
ab3374e4 699 if (SvUTF8(src)) {
d1256cb1
RGS
700 /* Already encoded */
701 if (strict_utf8(aTHX_ obj)) {
b9627ca0 702 s = process_utf8(aTHX_ dst, s, e, check_sv, 1, 1, 0);
d1256cb1 703 }
7f0d54d7
RGS
704 else {
705 /* trust it and just copy the octets */
706 sv_setpvn(dst,(char *)s,(e-s));
d1256cb1 707 s = e;
7f0d54d7 708 }
ab3374e4
DK
709 }
710 else {
6916a94c
RS
711 /* Native bytes - can always encode */
712 U8 *d = (U8 *) SvGROW(dst, 2*slen+1); /* +1 or assertion will botch */
713 while (s < e) {
714#ifdef append_utf8_from_native_byte
715 append_utf8_from_native_byte(*s, &d);
716 s++;
717#else
718 UV uv = NATIVE_TO_UNI((UV) *s);
719 s++; /* Above expansion of NATIVE_TO_UNI() is safer this way. */
ab3374e4 720 if (UNI_IS_INVARIANT(uv))
6916a94c 721 *d++ = (U8)UTF_TO_NATIVE(uv);
ab3374e4 722 else {
6916a94c 723 *d++ = (U8)UTF8_EIGHT_BIT_HI(uv);
ab3374e4
DK
724 *d++ = (U8)UTF8_EIGHT_BIT_LO(uv);
725 }
6916a94c
RS
726#endif
727 }
ab3374e4 728 SvCUR_set(dst, d- (U8 *)SvPVX(dst));
6916a94c 729 *SvEND(dst) = '\0';
ab3374e4
DK
730 }
731
732 /* Clear out translated part of source unless asked not to */
15f5e486 733 if (modify) {
bbe6f202 734 slen = e-s;
d1256cb1 735 sv_setpvn(src, (char*)s, slen);
bbe6f202 736 SvSETMAGIC(src);
ab3374e4
DK
737 }
738 SvPOK_only(dst);
739 SvUTF8_off(dst);
bbf2f5be 740 if (SvTAINTED(src)) SvTAINTED_on(dst); /* propagate taintedness */
1e1ac268 741 ST(0) = dst;
ab3374e4 742 XSRETURN(1);
ab3374e4 743
50d26985 744MODULE = Encode PACKAGE = Encode::XS PREFIX = Method_
2f2b4ff2 745
3f60a930 746PROTOTYPES: DISABLE
2f2b4ff2 747
3f60a930 748SV *
a0d8a30e
DK
749Method_renew(obj)
750SV * obj
751CODE:
2e0c0813 752 PERL_UNUSED_VAR(obj);
3f60a930
AC
753 RETVAL = newSVsv(obj);
754OUTPUT:
755 RETVAL
a0d8a30e 756
cc836e95
RGS
757int
758Method_renewed(obj)
759SV * obj
760CODE:
761 RETVAL = 0;
2e0c0813 762 PERL_UNUSED_VAR(obj);
cc836e95
RGS
763OUTPUT:
764 RETVAL
765
3f60a930 766SV *
0a95303c
NIS
767Method_name(obj)
768SV * obj
3f60a930
AC
769PREINIT:
770 encode_t *enc;
771INIT:
772 enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
0a95303c 773CODE:
3f60a930
AC
774 RETVAL = newSVpvn(enc->name[0], strlen(enc->name[0]));
775OUTPUT:
776 RETVAL
0a95303c 777
3f60a930 778bool
370462a2 779Method_cat_decode(obj, dst, src, off, term, check_sv = &PL_sv_no)
220e2d4e
IH
780SV * obj
781SV * dst
782SV * src
783SV * off
784SV * term
370462a2 785SV * check_sv
15f5e486 786PREINIT:
20797ee1 787 IV check;
15f5e486
SH
788 SV *fallback_cb;
789 bool modify;
790 encode_t *enc;
791 STRLEN offset;
220e2d4e 792 int code = 0;
15f5e486
SH
793 U8 *s;
794 STRLEN slen;
795 SV *tmp;
796INIT:
797 SvGETMAGIC(src);
798 SvGETMAGIC(check_sv);
e06f52f0 799 check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvOK(check_sv) ? SvIV_nomg(check_sv) : 0;
15f5e486
SH
800 fallback_cb = SvROK(check_sv) ? check_sv : &PL_sv_undef;
801 modify = (check && !(check & ENCODE_LEAVE_SRC));
802 enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
803 offset = (STRLEN)SvIV(off);
804CODE:
15f5e486
SH
805 if (!SvOK(src))
806 XSRETURN_NO;
807 s = modify ? (U8 *)SvPV_force_nomg(src, slen) : (U8 *)SvPV_nomg(src, slen);
808 if (SvUTF8(src))
809 utf8_safe_downgrade(aTHX_ &src, &s, &slen, modify);
810 tmp = encode_method(aTHX_ enc, enc->t_utf8, src, s, slen, check,
811 &offset, term, &code, fallback_cb);
812 sv_catsv(dst, tmp);
813 SvREFCNT_dec(tmp);
b162af07 814 SvIV_set(off, (IV)offset);
3f60a930
AC
815 RETVAL = (code == ENCODE_FOUND_TERM);
816OUTPUT:
817 RETVAL
220e2d4e 818
15f5e486 819SV *
8e180e82 820Method_decode(obj,src,check_sv = &PL_sv_no)
2f2b4ff2
NIS
821SV * obj
822SV * src
8e180e82 823SV * check_sv
15f5e486 824PREINIT:
20797ee1 825 IV check;
15f5e486
SH
826 SV *fallback_cb;
827 bool modify;
828 encode_t *enc;
829 U8 *s;
830 STRLEN slen;
831INIT:
832 SvGETMAGIC(src);
833 SvGETMAGIC(check_sv);
e06f52f0 834 check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvOK(check_sv) ? SvIV_nomg(check_sv) : 0;
15f5e486
SH
835 fallback_cb = SvROK(check_sv) ? check_sv : &PL_sv_undef;
836 modify = (check && !(check & ENCODE_LEAVE_SRC));
837 enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
2f2b4ff2 838CODE:
15f5e486
SH
839 if (!SvOK(src))
840 XSRETURN_UNDEF;
841 s = modify ? (U8 *)SvPV_force_nomg(src, slen) : (U8 *)SvPV_nomg(src, slen);
842 if (SvUTF8(src))
843 utf8_safe_downgrade(aTHX_ &src, &s, &slen, modify);
844 RETVAL = encode_method(aTHX_ enc, enc->t_utf8, src, s, slen, check,
370462a2 845 NULL, Nullsv, NULL, fallback_cb);
15f5e486 846 SvUTF8_on(RETVAL);
15f5e486
SH
847OUTPUT:
848 RETVAL
aae85ceb 849
15f5e486 850SV *
8e180e82 851Method_encode(obj,src,check_sv = &PL_sv_no)
aae85ceb 852SV * obj
85982a32 853SV * src
8e180e82 854SV * check_sv
15f5e486 855PREINIT:
20797ee1 856 IV check;
15f5e486
SH
857 SV *fallback_cb;
858 bool modify;
859 encode_t *enc;
860 U8 *s;
861 STRLEN slen;
862INIT:
863 SvGETMAGIC(src);
864 SvGETMAGIC(check_sv);
e06f52f0 865 check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvOK(check_sv) ? SvIV_nomg(check_sv) : 0;
15f5e486
SH
866 fallback_cb = SvROK(check_sv) ? check_sv : &PL_sv_undef;
867 modify = (check && !(check & ENCODE_LEAVE_SRC));
868 enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
aae85ceb 869CODE:
15f5e486
SH
870 if (!SvOK(src))
871 XSRETURN_UNDEF;
872 s = modify ? (U8 *)SvPV_force_nomg(src, slen) : (U8 *)SvPV_nomg(src, slen);
873 if (!SvUTF8(src))
874 utf8_safe_upgrade(aTHX_ &src, &s, &slen, modify);
875 RETVAL = encode_method(aTHX_ enc, enc->f_utf8, src, s, slen, check,
370462a2 876 NULL, Nullsv, NULL, fallback_cb);
15f5e486
SH
877OUTPUT:
878 RETVAL
aae85ceb 879
3f60a930 880bool
0ab8f81e
JH
881Method_needs_lines(obj)
882SV * obj
883CODE:
2e0c0813 884 PERL_UNUSED_VAR(obj);
3f60a930
AC
885 RETVAL = FALSE;
886OUTPUT:
887 RETVAL
0ab8f81e 888
3f60a930 889bool
0ab8f81e
JH
890Method_perlio_ok(obj)
891SV * obj
15f5e486
SH
892PREINIT:
893 SV *sv;
0ab8f81e 894CODE:
2e0c0813 895 PERL_UNUSED_VAR(obj);
3f60a930
AC
896 sv = eval_pv("require PerlIO::encoding", 0);
897 RETVAL = SvTRUE(sv);
898OUTPUT:
899 RETVAL
0ab8f81e 900
3f60a930 901SV *
742555bd
SP
902Method_mime_name(obj)
903SV * obj
15f5e486 904PREINIT:
3f60a930
AC
905 encode_t *enc;
906INIT:
907 enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
742555bd 908CODE:
3f60a930
AC
909 ENTER;
910 SAVETMPS;
911 PUSHMARK(sp);
912 XPUSHs(sv_2mortal(newSVpvn(enc->name[0], strlen(enc->name[0]))));
913 PUTBACK;
914 call_pv("Encode::MIME::Name::get_mime_name", G_SCALAR);
c9955564 915 SPAGAIN;
3f60a930
AC
916 RETVAL = newSVsv(POPs);
917 PUTBACK;
918 FREETMPS;
919 LEAVE;
920OUTPUT:
921 RETVAL
742555bd 922
67e989fb 923MODULE = Encode PACKAGE = Encode
2c674647
JH
924
925PROTOTYPES: ENABLE
926
2c674647 927bool
b2704119 928is_utf8(sv, check = 0)
4411f3b6 929SV * sv
b2704119 930int check
15f5e486
SH
931PREINIT:
932 char *str;
933 STRLEN len;
85982a32 934CODE:
15f5e486
SH
935 SvGETMAGIC(sv); /* SvGETMAGIC() can modify SvOK flag */
936 str = SvOK(sv) ? SvPV_nomg(sv, len) : NULL; /* SvPV() can modify SvUTF8 flag */
d1256cb1 937 RETVAL = SvUTF8(sv) ? TRUE : FALSE;
15f5e486 938 if (RETVAL && check && (!str || !is_utf8_string((U8 *)str, len)))
d1256cb1 939 RETVAL = FALSE;
85982a32
JH
940OUTPUT:
941 RETVAL
2c674647
JH
942
943SV *
4411f3b6 944_utf8_on(sv)
85982a32
JH
945SV * sv
946CODE:
15f5e486
SH
947 SvGETMAGIC(sv);
948 if (!SvTAINTED(sv) && SvPOKp(sv)) {
949 if (SvTHINKFIRST(sv)) sv_force_normal(sv);
3f60a930 950 RETVAL = boolSV(SvUTF8(sv));
15f5e486
SH
951 SvUTF8_on(sv);
952 SvSETMAGIC(sv);
85982a32 953 } else {
15f5e486 954 RETVAL = &PL_sv_undef;
85982a32 955 }
85982a32
JH
956OUTPUT:
957 RETVAL
2c674647
JH
958
959SV *
4411f3b6 960_utf8_off(sv)
85982a32
JH
961SV * sv
962CODE:
15f5e486
SH
963 SvGETMAGIC(sv);
964 if (!SvTAINTED(sv) && SvPOKp(sv)) {
965 if (SvTHINKFIRST(sv)) sv_force_normal(sv);
3f60a930 966 RETVAL = boolSV(SvUTF8(sv));
15f5e486
SH
967 SvUTF8_off(sv);
968 SvSETMAGIC(sv);
85982a32 969 } else {
15f5e486 970 RETVAL = &PL_sv_undef;
85982a32 971 }
85982a32
JH
972OUTPUT:
973 RETVAL
974
20797ee1
DK
975SV *
976decode(encoding, octets, check = NULL)
977SV * encoding
978SV * octets
979SV * check
980ALIAS:
981 bytes2str = 0
982PREINIT:
983 SV *obj;
984INIT:
985 SvGETMAGIC(encoding);
986CODE:
987 if (!SvOK(encoding))
988 croak("Encoding name should not be undef");
989 obj = find_encoding(aTHX_ encoding);
990 if (!SvOK(obj))
991 croak("Unknown encoding '%" SVf "'", SVfARG(encoding));
992 RETVAL = call_encoding(aTHX_ "decode", obj, octets, check);
993OUTPUT:
994 RETVAL
995
996SV *
997encode(encoding, string, check = NULL)
998SV * encoding
999SV * string
1000SV * check
1001ALIAS:
1002 str2bytes = 0
1003PREINIT:
1004 SV *obj;
1005INIT:
1006 SvGETMAGIC(encoding);
1007CODE:
1008 if (!SvOK(encoding))
1009 croak("Encoding name should not be undef");
1010 obj = find_encoding(aTHX_ encoding);
1011 if (!SvOK(obj))
1012 croak("Unknown encoding '%" SVf "'", SVfARG(encoding));
1013 RETVAL = call_encoding(aTHX_ "encode", obj, string, check);
1014OUTPUT:
1015 RETVAL
1016
1017SV *
1018decode_utf8(octets, check = NULL)
1019SV * octets
1020SV * check
1021PREINIT:
1022 HV *hv;
1023 SV **sv;
1024CODE:
1025 hv = get_hv("Encode::Encoding", 0);
1026 if (!hv)
1027 croak("utf8 encoding was not found");
1028 sv = hv_fetch(hv, "utf8", 4, 0);
1029 if (!sv || !*sv || !SvOK(*sv))
1030 croak("utf8 encoding was not found");
1031 RETVAL = call_encoding(aTHX_ "decode", *sv, octets, check);
1032OUTPUT:
1033 RETVAL
1034
1035SV *
1036encode_utf8(string)
1037SV * string
1038CODE:
1039 RETVAL = newSVsv(string);
1040 if (SvOK(RETVAL))
1041 sv_utf8_encode(RETVAL);
1042OUTPUT:
1043 RETVAL
1044
1045SV *
1046from_to(octets, from, to, check = NULL)
1047SV * octets
1048SV * from
1049SV * to
1050SV * check
1051PREINIT:
1052 SV *from_obj;
1053 SV *to_obj;
1054 SV *string;
1055 SV *new_octets;
1056 U8 *ptr;
1057 STRLEN len;
1058INIT:
1059 SvGETMAGIC(from);
1060 SvGETMAGIC(to);
1061CODE:
1062 if (!SvOK(from) || !SvOK(to))
1063 croak("Encoding name should not be undef");
1064 from_obj = find_encoding(aTHX_ from);
1065 if (!SvOK(from_obj))
1066 croak("Unknown encoding '%" SVf "'", SVfARG(from));
1067 to_obj = find_encoding(aTHX_ to);
1068 if (!SvOK(to_obj))
1069 croak("Unknown encoding '%" SVf "'", SVfARG(to));
1070 string = sv_2mortal(call_encoding(aTHX_ "decode", from_obj, octets, NULL));
1071 new_octets = sv_2mortal(call_encoding(aTHX_ "encode", to_obj, string, check));
1072 SvGETMAGIC(new_octets);
1073 if (SvOK(new_octets) && (!check || SvROK(check) || !SvTRUE_nomg(check) || sv_len(string) == 0)) {
1074 ptr = (U8 *)SvPV_nomg(new_octets, len);
1075 if (SvUTF8(new_octets))
1076 len = utf8_length(ptr, ptr+len);
1077 RETVAL = newSVuv(len);
1078 } else {
1079 RETVAL = &PL_sv_undef;
1080 }
1081 sv_setsv_nomg(octets, new_octets);
1082 SvSETMAGIC(octets);
1083OUTPUT:
1084 RETVAL
1085
3f60a930
AC
1086void
1087onBOOT()
1088CODE:
1089{
1090#include "def_t.exh"
1091}
1092
33af2bc7
NIS
1093BOOT:
1094{
20797ee1 1095 HV *stash = gv_stashpvn("Encode", (U32)strlen("Encode"), GV_ADD);
15f5e486
SH
1096 newCONSTSUB(stash, "DIE_ON_ERR", newSViv(ENCODE_DIE_ON_ERR));
1097 newCONSTSUB(stash, "WARN_ON_ERR", newSViv(ENCODE_WARN_ON_ERR));
1098 newCONSTSUB(stash, "RETURN_ON_ERR", newSViv(ENCODE_RETURN_ON_ERR));
1099 newCONSTSUB(stash, "LEAVE_SRC", newSViv(ENCODE_LEAVE_SRC));
20797ee1 1100 newCONSTSUB(stash, "ONLY_PRAGMA_WARNINGS", newSViv(ENCODE_ONLY_PRAGMA_WARNINGS));
15f5e486
SH
1101 newCONSTSUB(stash, "PERLQQ", newSViv(ENCODE_PERLQQ));
1102 newCONSTSUB(stash, "HTMLCREF", newSViv(ENCODE_HTMLCREF));
1103 newCONSTSUB(stash, "XMLCREF", newSViv(ENCODE_XMLCREF));
1104 newCONSTSUB(stash, "STOP_AT_PARTIAL", newSViv(ENCODE_STOP_AT_PARTIAL));
1105 newCONSTSUB(stash, "FB_DEFAULT", newSViv(ENCODE_FB_DEFAULT));
1106 newCONSTSUB(stash, "FB_CROAK", newSViv(ENCODE_FB_CROAK));
1107 newCONSTSUB(stash, "FB_QUIET", newSViv(ENCODE_FB_QUIET));
1108 newCONSTSUB(stash, "FB_WARN", newSViv(ENCODE_FB_WARN));
1109 newCONSTSUB(stash, "FB_PERLQQ", newSViv(ENCODE_FB_PERLQQ));
1110 newCONSTSUB(stash, "FB_HTMLCREF", newSViv(ENCODE_FB_HTMLCREF));
1111 newCONSTSUB(stash, "FB_XMLCREF", newSViv(ENCODE_FB_XMLCREF));
1112}