This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ext/ + -Wall
[perl5.git] / ext / Encode / Encode.xs
CommitLineData
c6c619a9 1#define PERL_NO_GET_CONTEXT
2c674647
JH
2#include "EXTERN.h"
3#include "perl.h"
4#include "XSUB.h"
2f2b4ff2
NIS
5#define U8 U8
6#include "encode.h"
7#include "iso8859.h"
8#include "EBCDIC.h"
9#include "Symbols.h"
2c674647 10
67e989fb 11#define UNIMPLEMENTED(x,y) y x (SV *sv, char *encoding) { \
c6c619a9 12 dTHX; \
2f5768b8 13 Perl_croak(aTHX_ "panic_unimplemented"); \
4a83738a 14 return (y)0; /* fool picky compilers */ \
87714904 15 }
67e989fb
JH
16UNIMPLEMENTED(_encoded_utf8_to_bytes, I32)
17UNIMPLEMENTED(_encoded_bytes_to_utf8, I32)
18
9df9a5cd 19#if defined(USE_PERLIO) && !defined(USE_SFIO)
72e44f29
NIS
20/* Define an encoding "layer" in the perliol.h sense.
21 The layer defined here "inherits" in an object-oriented sense from the
22 "perlio" layer with its PerlIOBuf_* "methods".
23 The implementation is particularly efficient as until Encode settles down
24 there is no point in tryint to tune it.
25
26 The layer works by overloading the "fill" and "flush" methods.
27
28 "fill" calls "SUPER::fill" in perl terms, then calls the encode OO perl API
29 to convert the encoded data to UTF-8 form, then copies it back to the
30 buffer. The "base class's" read methods then see the UTF-8 data.
31
32 "flush" transforms the UTF-8 data deposited by the "base class's write
33 method in the buffer back into the encoded form using the encode OO perl API,
34 then copies data back into the buffer and calls "SUPER::flush.
35
36 Note that "flush" is _also_ called for read mode - we still do the (back)-translate
37 so that the the base class's "flush" sees the correct number of encoded chars
38 for positioning the seek pointer. (This double translation is the worst performance
39 issue - particularly with all-perl encode engine.)
40
41*/
42
43
33af2bc7
NIS
44#include "perliol.h"
45
46typedef struct
47{
48 PerlIOBuf base; /* PerlIOBuf stuff */
49 SV * bufsv;
50 SV * enc;
51} PerlIOEncode;
52
e3f3bf95
NIS
53SV *
54PerlIOEncode_getarg(PerlIO *f)
55{
c6c619a9 56 dTHX;
e3f3bf95
NIS
57 PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
58 SV *sv = &PL_sv_undef;
59 if (e->enc)
60 {
61 dSP;
62 ENTER;
63 SAVETMPS;
64 PUSHMARK(sp);
65 XPUSHs(e->enc);
66 PUTBACK;
c6c619a9 67 if (call_method("name",G_SCALAR) == 1)
e3f3bf95
NIS
68 {
69 SPAGAIN;
70 sv = newSVsv(POPs);
71 PUTBACK;
72 }
73 }
74 return sv;
75}
33af2bc7
NIS
76
77IV
e3f3bf95 78PerlIOEncode_pushed(PerlIO *f, const char *mode, SV *arg)
33af2bc7
NIS
79{
80 PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
81 dTHX;
82 dSP;
83 IV code;
e3f3bf95 84 code = PerlIOBuf_pushed(f,mode,Nullsv);
33af2bc7
NIS
85 ENTER;
86 SAVETMPS;
87 PUSHMARK(sp);
e3f3bf95 88 XPUSHs(arg);
33af2bc7 89 PUTBACK;
c6c619a9 90 if (call_pv("Encode::find_encoding",G_SCALAR) != 1)
52744f63
NIS
91 {
92 /* should never happen */
51ef4e11 93 Perl_die(aTHX_ "Encode::find_encoding did not return a value");
52744f63
NIS
94 return -1;
95 }
33af2bc7
NIS
96 SPAGAIN;
97 e->enc = POPs;
98 PUTBACK;
99 if (!SvROK(e->enc))
52744f63
NIS
100 {
101 e->enc = Nullsv;
102 errno = EINVAL;
29b291f7 103 Perl_warner(aTHX_ WARN_IO, "Cannot find encoding \"%"SVf"\"", arg);
52744f63
NIS
104 return -1;
105 }
33af2bc7
NIS
106 SvREFCNT_inc(e->enc);
107 FREETMPS;
108 LEAVE;
109 PerlIOBase(f)->flags |= PERLIO_F_UTF8;
110 return code;
111}
112
113IV
114PerlIOEncode_popped(PerlIO *f)
115{
116 PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
117 dTHX;
118 if (e->enc)
119 {
120 SvREFCNT_dec(e->enc);
121 e->enc = Nullsv;
122 }
123 if (e->bufsv)
124 {
125 SvREFCNT_dec(e->bufsv);
126 e->bufsv = Nullsv;
127 }
128 return 0;
129}
130
131STDCHAR *
132PerlIOEncode_get_base(PerlIO *f)
133{
134 PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
135 dTHX;
136 if (!e->base.bufsiz)
137 e->base.bufsiz = 1024;
138 if (!e->bufsv)
139 {
140 e->bufsv = newSV(e->base.bufsiz);
141 sv_setpvn(e->bufsv,"",0);
142 }
62e8870c 143 e->base.buf = (STDCHAR *)SvPVX(e->bufsv);
33af2bc7
NIS
144 if (!e->base.ptr)
145 e->base.ptr = e->base.buf;
146 if (!e->base.end)
147 e->base.end = e->base.buf;
148 if (e->base.ptr < e->base.buf || e->base.ptr > e->base.buf+SvLEN(e->bufsv))
149 {
150 Perl_warn(aTHX_ " ptr %p(%p)%p",
151 e->base.buf,e->base.ptr,e->base.buf+SvLEN(e->bufsv));
152 abort();
153 }
154 if (SvLEN(e->bufsv) < e->base.bufsiz)
155 {
156 SSize_t poff = e->base.ptr - e->base.buf;
157 SSize_t eoff = e->base.end - e->base.buf;
62e8870c 158 e->base.buf = (STDCHAR *)SvGROW(e->bufsv,e->base.bufsiz);
33af2bc7
NIS
159 e->base.ptr = e->base.buf + poff;
160 e->base.end = e->base.buf + eoff;
161 }
162 if (e->base.ptr < e->base.buf || e->base.ptr > e->base.buf+SvLEN(e->bufsv))
163 {
164 Perl_warn(aTHX_ " ptr %p(%p)%p",
165 e->base.buf,e->base.ptr,e->base.buf+SvLEN(e->bufsv));
166 abort();
167 }
168 return e->base.buf;
169}
170
33af2bc7
NIS
171IV
172PerlIOEncode_fill(PerlIO *f)
173{
174 PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
175 dTHX;
176 dSP;
177 IV code;
33af2bc7
NIS
178 code = PerlIOBuf_fill(f);
179 if (code == 0)
180 {
181 SV *uni;
72e44f29
NIS
182 STRLEN len;
183 char *s;
184 /* Set SV that is the buffer to be buf..ptr */
33af2bc7
NIS
185 SvCUR_set(e->bufsv, e->base.end - e->base.buf);
186 SvUTF8_off(e->bufsv);
187 ENTER;
188 SAVETMPS;
189 PUSHMARK(sp);
190 XPUSHs(e->enc);
191 XPUSHs(e->bufsv);
192 XPUSHs(&PL_sv_yes);
193 PUTBACK;
c6c619a9 194 if (call_method("decode",G_SCALAR) != 1)
33af2bc7
NIS
195 code = -1;
196 SPAGAIN;
197 uni = POPs;
198 PUTBACK;
72e44f29
NIS
199 /* Now get translated string (forced to UTF-8) and copy back to buffer
200 don't use sv_setsv as that may "steal" PV from returned temp
201 and so free() our known-large-enough buffer.
202 sv_setpvn() should do but let us do it long hand.
203 */
204 s = SvPVutf8(uni,len);
205 if (s != SvPVX(e->bufsv))
206 {
62e8870c 207 e->base.buf = (STDCHAR *)SvGROW(e->bufsv,len);
72e44f29
NIS
208 Move(s,e->base.buf,len,char);
209 SvCUR_set(e->bufsv,len);
210 }
211 SvUTF8_on(e->bufsv);
212 e->base.end = e->base.buf+len;
33af2bc7
NIS
213 e->base.ptr = e->base.buf;
214 FREETMPS;
215 LEAVE;
216 }
217 return code;
218}
219
220IV
221PerlIOEncode_flush(PerlIO *f)
222{
223 PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
224 IV code = 0;
8040349a
NIS
225 if (e->bufsv && (PerlIOBase(f)->flags & (PERLIO_F_RDBUF|PERLIO_F_WRBUF))
226 &&(e->base.ptr > e->base.buf)
227 )
33af2bc7 228 {
8040349a 229 dTHX;
33af2bc7
NIS
230 dSP;
231 SV *str;
232 char *s;
233 STRLEN len;
72e44f29
NIS
234 SSize_t left = 0;
235 if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
236 {
237 /* This is really just a flag to see if we took all the data, if
238 we did PerlIOBase_flush avoids a seek to lower layer.
239 Need to revisit if we start getting clever with unreads or seeks-in-buffer
240 */
241 left = e->base.end - e->base.ptr;
242 }
33af2bc7
NIS
243 ENTER;
244 SAVETMPS;
245 PUSHMARK(sp);
246 XPUSHs(e->enc);
72e44f29 247 SvCUR_set(e->bufsv, e->base.ptr - e->base.buf);
33af2bc7
NIS
248 SvUTF8_on(e->bufsv);
249 XPUSHs(e->bufsv);
250 XPUSHs(&PL_sv_yes);
251 PUTBACK;
c6c619a9 252 if (call_method("encode",G_SCALAR) != 1)
33af2bc7
NIS
253 code = -1;
254 SPAGAIN;
255 str = POPs;
256 PUTBACK;
72e44f29
NIS
257 s = SvPV(str,len);
258 if (s != SvPVX(e->bufsv))
259 {
62e8870c 260 e->base.buf = (STDCHAR *)SvGROW(e->bufsv,len);
72e44f29
NIS
261 Move(s,e->base.buf,len,char);
262 SvCUR_set(e->bufsv,len);
263 }
33af2bc7 264 SvUTF8_off(e->bufsv);
72e44f29
NIS
265 e->base.ptr = e->base.buf+len;
266 /* restore end != ptr as inequality is used by PerlIOBuf_flush in read case */
267 e->base.end = e->base.ptr + left;
33af2bc7
NIS
268 FREETMPS;
269 LEAVE;
270 if (PerlIOBuf_flush(f) != 0)
271 code = -1;
272 }
273 return code;
274}
275
276IV
277PerlIOEncode_close(PerlIO *f)
278{
279 PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
280 IV code = PerlIOBase_close(f);
281 dTHX;
282 if (e->bufsv)
283 {
284 SvREFCNT_dec(e->bufsv);
285 e->bufsv = Nullsv;
286 }
287 e->base.buf = NULL;
288 e->base.ptr = NULL;
289 e->base.end = NULL;
290 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
291 return code;
292}
293
72e44f29
NIS
294Off_t
295PerlIOEncode_tell(PerlIO *f)
296{
a999f61b 297 dTHX;
72e44f29
NIS
298 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
299 /* Unfortunately the only way to get a postion is to back-translate,
300 the UTF8-bytes we have buf..ptr and adjust accordingly.
301 But we will try and save any unread data in case stream
302 is un-seekable.
303 */
304 if ((PerlIOBase(f)->flags & PERLIO_F_RDBUF) && b->ptr < b->end)
305 {
306 Size_t count = b->end - b->ptr;
e3f3bf95 307 PerlIO_push(aTHX_ f,&PerlIO_pending,"r",Nullsv);
72e44f29
NIS
308 /* Save what we have left to read */
309 PerlIOSelf(f,PerlIOBuf)->bufsiz = count;
310 PerlIO_unread(f,b->ptr,count);
311 /* There isn't any unread data - we just saved it - so avoid the lower seek */
312 b->end = b->ptr;
313 /* Flush ourselves - now one layer down,
314 this does the back translate and adjusts position
315 */
316 PerlIO_flush(PerlIONext(f));
317 /* Set position of the saved data */
318 PerlIOSelf(f,PerlIOBuf)->posn = b->posn;
319 }
320 else
321 {
322 PerlIO_flush(f);
323 }
324 return b->posn;
325}
326
33af2bc7 327PerlIO_funcs PerlIO_encode = {
72e44f29 328 "encoding",
33af2bc7
NIS
329 sizeof(PerlIOEncode),
330 PERLIO_K_BUFFERED,
33af2bc7
NIS
331 PerlIOEncode_pushed,
332 PerlIOEncode_popped,
e3f3bf95
NIS
333 PerlIOBuf_open,
334 PerlIOEncode_getarg,
335 PerlIOBase_fileno,
33af2bc7
NIS
336 PerlIOBuf_read,
337 PerlIOBuf_unread,
338 PerlIOBuf_write,
339 PerlIOBuf_seek,
72e44f29 340 PerlIOEncode_tell,
33af2bc7
NIS
341 PerlIOEncode_close,
342 PerlIOEncode_flush,
343 PerlIOEncode_fill,
344 PerlIOBase_eof,
345 PerlIOBase_error,
346 PerlIOBase_clearerr,
f6c77cf1 347 PerlIOBase_setlinebuf,
33af2bc7
NIS
348 PerlIOEncode_get_base,
349 PerlIOBuf_bufsiz,
350 PerlIOBuf_get_ptr,
351 PerlIOBuf_get_cnt,
352 PerlIOBuf_set_ptrcnt,
353};
9df9a5cd 354#endif /* encode layer */
33af2bc7 355
2f2b4ff2
NIS
356void
357Encode_Define(pTHX_ encode_t *enc)
358{
51ef4e11 359 dSP;
2f2b4ff2
NIS
360 HV *stash = gv_stashpv("Encode::XS", TRUE);
361 SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(enc))),stash);
dcda1f94 362 int i = 0;
51ef4e11
NIS
363 PUSHMARK(sp);
364 XPUSHs(sv);
dcda1f94
NIS
365 while (enc->name[i])
366 {
367 const char *name = enc->name[i++];
51ef4e11 368 XPUSHs(sv_2mortal(newSVpvn(name,strlen(name))));
dcda1f94 369 }
51ef4e11
NIS
370 PUTBACK;
371 call_pv("Encode::define_encoding",G_DISCARD);
dcda1f94 372 SvREFCNT_dec(sv);
2f2b4ff2
NIS
373}
374
183a2d84 375void call_failure (SV *routine, U8* done, U8* dest, U8* orig) {}
67e989fb 376
2f2b4ff2
NIS
377static SV *
378encode_method(pTHX_ encode_t *enc, encpage_t *dir, SV *src, int check)
379{
380 STRLEN slen;
381 U8 *s = (U8 *) SvPV(src,slen);
382 SV *dst = sv_2mortal(newSV(2*slen+1));
383 if (slen)
384 {
385 U8 *d = (U8 *) SvGROW(dst, 2*slen+1);
386 STRLEN dlen = SvLEN(dst);
387 int code;
9b37254d 388 while ((code = do_encode(dir,s,&slen,d,dlen,&dlen,!check)))
2f2b4ff2
NIS
389 {
390 SvCUR_set(dst,dlen);
391 SvPOK_on(dst);
9b37254d
NIS
392
393 if (code == ENCODE_FALLBACK)
394 break;
395
2f2b4ff2
NIS
396 switch(code)
397 {
398 case ENCODE_NOSPACE:
399 {
400 STRLEN need = (slen) ? (SvLEN(dst)*SvCUR(src)/slen) : (dlen + UTF8_MAXLEN);
401 if (need <= SvLEN(dst))
402 need += UTF8_MAXLEN;
403 d = (U8 *) SvGROW(dst, need);
404 dlen = SvLEN(dst);
405 slen = SvCUR(src);
406 break;
407 }
408
409 case ENCODE_NOREP:
410 if (dir == enc->f_utf8)
411 {
412 if (!check && ckWARN_d(WARN_UTF8))
413 {
414 STRLEN clen;
9041c2e3
NIS
415 UV ch = utf8n_to_uvuni(s+slen,(SvCUR(src)-slen),&clen,0);
416 Perl_warner(aTHX_ WARN_UTF8, "\"\\N{U+%"UVxf"}\" does not map to %s", ch, enc->name[0]);
2f2b4ff2
NIS
417 /* FIXME: Skip over the character, copy in replacement and continue
418 * but that is messy so for now just fail.
419 */
420 return &PL_sv_undef;
421 }
422 else
423 {
424 return &PL_sv_undef;
425 }
426 }
427 else
428 {
429 /* UTF-8 is supposed to be "Universal" so should not happen */
430 Perl_croak(aTHX_ "%s '%.*s' does not map to UTF-8",
dcda1f94 431 enc->name[0], (int)(SvCUR(src)-slen),s+slen);
2f2b4ff2
NIS
432 }
433 break;
434
435 case ENCODE_PARTIAL:
436 if (!check && ckWARN_d(WARN_UTF8))
437 {
438 Perl_warner(aTHX_ WARN_UTF8, "Partial %s character",
dcda1f94 439 (dir == enc->f_utf8) ? "UTF-8" : enc->name[0]);
2f2b4ff2
NIS
440 }
441 return &PL_sv_undef;
442
443 default:
444 Perl_croak(aTHX_ "Unexpected code %d converting %s %s",
dcda1f94 445 code, (dir == enc->f_utf8) ? "to" : "from",enc->name[0]);
2f2b4ff2
NIS
446 return &PL_sv_undef;
447 }
448 }
449 SvCUR_set(dst,dlen);
450 SvPOK_on(dst);
451 if (check)
452 {
453 if (slen < SvCUR(src))
454 {
455 Move(s+slen,s,SvCUR(src)-slen,U8);
456 }
457 SvCUR_set(src,SvCUR(src)-slen);
458 }
459 }
8040349a
NIS
460 else
461 {
462 SvCUR_set(dst,slen);
463 SvPOK_on(dst);
464 }
2f2b4ff2
NIS
465 return dst;
466}
467
50d26985 468MODULE = Encode PACKAGE = Encode::XS PREFIX = Method_
2f2b4ff2
NIS
469
470PROTOTYPES: ENABLE
471
472void
691638dd 473Method_decode(obj,src,check = FALSE)
2f2b4ff2
NIS
474SV * obj
475SV * src
691638dd 476bool check
2f2b4ff2
NIS
477CODE:
478 {
479 encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
480 ST(0) = encode_method(aTHX_ enc, enc->t_utf8, src, check);
481 SvUTF8_on(ST(0));
482 XSRETURN(1);
483 }
484
485void
691638dd 486Method_encode(obj,src,check = FALSE)
2f2b4ff2
NIS
487SV * obj
488SV * src
691638dd 489bool check
2f2b4ff2
NIS
490CODE:
491 {
492 encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
493 sv_utf8_upgrade(src);
494 ST(0) = encode_method(aTHX_ enc, enc->f_utf8, src, check);
495 XSRETURN(1);
496 }
497
67e989fb 498MODULE = Encode PACKAGE = Encode
2c674647
JH
499
500PROTOTYPES: ENABLE
501
67e989fb 502I32
2c674647 503_bytes_to_utf8(sv, ...)
67e989fb 504 SV * sv
2c674647 505 CODE:
67e989fb
JH
506 {
507 SV * encoding = items == 2 ? ST(1) : Nullsv;
508
509 if (encoding)
510 RETVAL = _encoded_bytes_to_utf8(sv, SvPV_nolen(encoding));
511 else {
512 STRLEN len;
183a2d84 513 U8* s = (U8*)SvPV(sv, len);
67e989fb
JH
514 U8* converted;
515
516 converted = bytes_to_utf8(s, &len); /* This allocs */
183a2d84 517 sv_setpvn(sv, (char *)converted, len);
67e989fb
JH
518 SvUTF8_on(sv); /* XXX Should we? */
519 Safefree(converted); /* ... so free it */
520 RETVAL = len;
521 }
522 }
2c674647 523 OUTPUT:
67e989fb 524 RETVAL
2c674647 525
67e989fb 526I32
2c674647 527_utf8_to_bytes(sv, ...)
67e989fb 528 SV * sv
2c674647 529 CODE:
67e989fb
JH
530 {
531 SV * to = items > 1 ? ST(1) : Nullsv;
532 SV * check = items > 2 ? ST(2) : Nullsv;
87714904 533
67e989fb
JH
534 if (to)
535 RETVAL = _encoded_utf8_to_bytes(sv, SvPV_nolen(to));
536 else {
67e989fb 537 STRLEN len;
b113ac0e 538 U8 *s = (U8*)SvPV(sv, len);
67e989fb 539
9c5ffd7c 540 RETVAL = 0;
67e989fb
JH
541 if (SvTRUE(check)) {
542 /* Must do things the slow way */
543 U8 *dest;
87714904 544 U8 *src = (U8*)savepv((char *)s); /* We need a copy to pass to check() */
67e989fb
JH
545 U8 *send = s + len;
546
547 New(83, dest, len, U8); /* I think */
548
549 while (s < send) {
550 if (*s < 0x80)
551 *dest++ = *s++;
552 else {
b113ac0e
JH
553 STRLEN ulen;
554 UV uv = *s++;
87714904 555
67e989fb
JH
556 /* Have to do it all ourselves because of error routine,
557 aargh. */
558 if (!(uv & 0x40))
559 goto failure;
560 if (!(uv & 0x20)) { ulen = 2; uv &= 0x1f; }
561 else if (!(uv & 0x10)) { ulen = 3; uv &= 0x0f; }
562 else if (!(uv & 0x08)) { ulen = 4; uv &= 0x07; }
563 else if (!(uv & 0x04)) { ulen = 5; uv &= 0x03; }
564 else if (!(uv & 0x02)) { ulen = 6; uv &= 0x01; }
565 else if (!(uv & 0x01)) { ulen = 7; uv = 0; }
566 else { ulen = 13; uv = 0; }
87714904 567
67e989fb
JH
568 /* Note change to utf8.c variable naming, for variety */
569 while (ulen--) {
570 if ((*s & 0xc0) != 0x80)
571 goto failure;
87714904 572
67e989fb
JH
573 else
574 uv = (uv << 6) | (*s++ & 0x3f);
87714904 575 }
67e989fb
JH
576 if (uv > 256) {
577 failure:
578 call_failure(check, s, dest, src);
579 /* Now what happens? */
580 }
581 *dest++ = (U8)uv;
582 }
583 }
584 } else
585 RETVAL = (utf8_to_bytes(s, &len) ? len : 0);
586 }
2c674647
JH
587 }
588 OUTPUT:
589 RETVAL
590
2c674647 591bool
4411f3b6
NIS
592is_utf8(sv, check = FALSE)
593SV * sv
594bool check
2c674647
JH
595 CODE:
596 {
2c674647 597 if (SvPOK(sv)) {
4411f3b6 598 RETVAL = SvUTF8(sv) ? TRUE : FALSE;
2c674647 599 if (RETVAL &&
4411f3b6 600 check &&
2c674647
JH
601 !is_utf8_string((U8*)SvPVX(sv), SvCUR(sv)))
602 RETVAL = FALSE;
603 } else {
604 RETVAL = FALSE;
605 }
606 }
607 OUTPUT:
608 RETVAL
609
610SV *
4411f3b6 611_utf8_on(sv)
2c674647
JH
612 SV * sv
613 CODE:
614 {
615 if (SvPOK(sv)) {
87714904 616 SV *rsv = newSViv(SvUTF8(sv));
2c674647
JH
617 RETVAL = rsv;
618 SvUTF8_on(sv);
619 } else {
620 RETVAL = &PL_sv_undef;
621 }
622 }
623 OUTPUT:
624 RETVAL
625
626SV *
4411f3b6 627_utf8_off(sv)
2c674647
JH
628 SV * sv
629 CODE:
630 {
631 if (SvPOK(sv)) {
87714904 632 SV *rsv = newSViv(SvUTF8(sv));
2c674647
JH
633 RETVAL = rsv;
634 SvUTF8_off(sv);
635 } else {
636 RETVAL = &PL_sv_undef;
637 }
638 }
639 OUTPUT:
640 RETVAL
641
33af2bc7
NIS
642BOOT:
643{
6a59c517 644#if defined(USE_PERLIO) && !defined(USE_SFIO)
a999f61b 645 PerlIO_define_layer(aTHX_ &PerlIO_encode);
33af2bc7 646#endif
2f2b4ff2
NIS
647#include "iso8859.def"
648#include "EBCDIC.def"
649#include "Symbols.def"
33af2bc7 650}