ext/Encode/Encode.xs

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