ext/Encode/Encode.xs

   1 /*
   2  $Id: Encode.xs,v 1.53 2003/02/06 01:52:11 dankogai Exp dankogai $
   3  */
   4
   5 #define PERL_NO_GET_CONTEXT
   6 #include "EXTERN.h"
   7 #include "perl.h"
   8 #include "XSUB.h"
   9 #define U8 U8
  10 #include "encode.h"
  11
  12 # define PERLIO_MODNAME  "PerlIO::encoding"
  13 # define PERLIO_FILENAME "PerlIO/encoding.pm"
  14
  15 /* set 1 or more to profile.  t/encoding.t dumps core because of
  16    Perl_warner and PerlIO don't work well */
  17 #define ENCODE_XS_PROFILE 0
  18
  19 /* set 0 to disable floating point to calculate buffer size for
  20    encode_method().  1 is recommended. 2 restores NI-S original */
  21 #define ENCODE_XS_USEFP   1
  22
  23 #define UNIMPLEMENTED(x,y) y x (SV *sv, char *encoding) {dTHX;   \
  24                          Perl_croak(aTHX_ "panic_unimplemented"); \
  25                          return (y)0; /* fool picky compilers */ \
  26                          }
  27 /**/
  28
  29 UNIMPLEMENTED(_encoded_utf8_to_bytes, I32)
  30 UNIMPLEMENTED(_encoded_bytes_to_utf8, I32)
  31
  32 void
  33 Encode_XSEncoding(pTHX_ encode_t * enc)
  34 {
  35     dSP;
  36     HV *stash = gv_stashpv("Encode::XS", TRUE);
  37     SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(enc))), stash);
  38     int i = 0;
  39     PUSHMARK(sp);
  40     XPUSHs(sv);
  41     while (enc->name[i]) {
  42         const char *name = enc->name[i++];
  43         XPUSHs(sv_2mortal(newSVpvn(name, strlen(name))));
  44     }
  45     PUTBACK;
  46     call_pv("Encode::define_encoding", G_DISCARD);
  47     SvREFCNT_dec(sv);
  48 }
  49
  50 void
  51 call_failure(SV * routine, U8 * done, U8 * dest, U8 * orig)
  52 {
  53     /* Exists for breakpointing */
  54 }
  55
  56
  57 #define ERR_ENCODE_NOMAP "\"\\x{%04" UVxf "}\" does not map to %s"
  58 #define ERR_DECODE_NOMAP "%s \"\\x%02" UVXf "\" does not map to Unicode"
  59
  60 static SV *
  61 encode_method(pTHX_ encode_t * enc, encpage_t * dir, SV * src,
  62               int check, STRLEN * offset, SV * term, int * retcode)
  63 {
  64     STRLEN slen;
  65     U8 *s = (U8 *) SvPV(src, slen);
  66     STRLEN tlen  = slen;
  67     STRLEN ddone = 0;
  68     STRLEN sdone = 0;
  69
  70     /* We allocate slen+1.
  71        PerlIO dumps core if this value is smaller than this. */
  72     SV *dst = sv_2mortal(newSV(slen+1));
  73     U8 *d = (U8 *)SvPVX(dst);
  74     STRLEN dlen = SvLEN(dst)-1;
  75     int code = 0;
  76     STRLEN trmlen = 0;
  77     U8 *trm = term ? SvPV(term, trmlen) : NULL;
  78
  79     if (offset) {
  80       s += *offset;
  81       slen -= *offset;
  82       tlen = slen;
  83     }
  84
  85     if (slen <= 0){
  86         SvCUR_set(dst, 0);
  87         SvPOK_only(dst);
  88         goto ENCODE_END;
  89     }
  90
  91     while( (code = do_encode(dir, s, &slen, d, dlen, &dlen, !check,
  92                              trm, trmlen)) )
  93     {
  94         SvCUR_set(dst, dlen+ddone);
  95         SvPOK_only(dst);
  96
  97         if (code == ENCODE_FALLBACK || code == ENCODE_PARTIAL ||
  98             code == ENCODE_FOUND_TERM) {
  99             break;
 100         }
 101         switch (code) {
 102         case ENCODE_NOSPACE:
 103         {
 104             STRLEN more = 0; /* make sure you initialize! */
 105             STRLEN sleft;
 106             sdone += slen;
 107             ddone += dlen;
 108             sleft = tlen - sdone;
 109 #if ENCODE_XS_PROFILE >= 2
 110             Perl_warn(aTHX_
 111                       "more=%d, sdone=%d, sleft=%d, SvLEN(dst)=%d\n",
 112                       more, sdone, sleft, SvLEN(dst));
 113 #endif
 114             if (sdone != 0) { /* has src ever been processed ? */
 115 #if   ENCODE_XS_USEFP == 2
 116                 more = (1.0*tlen*SvLEN(dst)+sdone-1)/sdone
 117                     - SvLEN(dst);
 118 #elif ENCODE_XS_USEFP
 119                 more = (STRLEN)((1.0*SvLEN(dst)+1)/sdone * sleft);
 120 #else
 121                 /* safe until SvLEN(dst) == MAX_INT/16 */
 122                 more = (16*SvLEN(dst)+1)/sdone/16 * sleft;
 123 #endif
 124             }
 125             more += UTF8_MAXLEN; /* insurance policy */
 126             d = (U8 *) SvGROW(dst, SvLEN(dst) + more);
 127             /* dst need to grow need MORE bytes! */
 128             if (ddone >= SvLEN(dst)) {
 129                 Perl_croak(aTHX_ "Destination couldn't be grown.");
 130             }
 131             dlen = SvLEN(dst)-ddone-1;
 132             d   += ddone;
 133             s   += slen;
 134             slen = tlen-sdone;
 135             continue;
 136         }
 137         case ENCODE_NOREP:
 138             /* encoding */
 139             if (dir == enc->f_utf8) {
 140                 STRLEN clen;
 141                 UV ch =
 142                     utf8n_to_uvuni(s+slen, (SvCUR(src)-slen),
 143                                    &clen, UTF8_ALLOW_ANY|UTF8_CHECK_ONLY);
 144                 if (check & ENCODE_DIE_ON_ERR) {
 145                     Perl_croak(aTHX_ ERR_ENCODE_NOMAP,
 146                                (UV)ch, enc->name[0]);
 147                     return &PL_sv_undef; /* never reaches but be safe */
 148                 }
 149                 if (check & ENCODE_WARN_ON_ERR){
 150                     Perl_warner(aTHX_ packWARN(WARN_UTF8),
 151                                 ERR_ENCODE_NOMAP, (UV)ch, enc->name[0]);
 152                 }
 153                 if (check & ENCODE_RETURN_ON_ERR){
 154                     goto ENCODE_SET_SRC;
 155                 }
 156                 if (check & ENCODE_PERLQQ){
 157                     SV* perlqq =
 158                         sv_2mortal(newSVpvf("\\x{%04"UVxf"}", (UV)ch));
 159                     sdone += slen + clen;
 160                     ddone += dlen + SvCUR(perlqq);
 161                     sv_catsv(dst, perlqq);
 162                 }else if (check & ENCODE_HTMLCREF){
 163                     SV* htmlcref =
 164                         sv_2mortal(newSVpvf("&#%" UVuf ";", (UV)ch));
 165                     sdone += slen + clen;
 166                     ddone += dlen + SvCUR(htmlcref);
 167                     sv_catsv(dst, htmlcref);
 168                 }else if (check & ENCODE_XMLCREF){
 169                     SV* xmlcref =
 170                         sv_2mortal(newSVpvf("&#x%" UVxf ";", (UV)ch));
 171                     sdone += slen + clen;
 172                     ddone += dlen + SvCUR(xmlcref);
 173                     sv_catsv(dst, xmlcref);
 174                 } else {
 175                     /* fallback char */
 176                     sdone += slen + clen;
 177                     ddone += dlen + enc->replen;
 178                     sv_catpvn(dst, (char*)enc->rep, enc->replen);
 179                 }
 180             }
 181             /* decoding */
 182             else {
 183                 if (check & ENCODE_DIE_ON_ERR){
 184                     Perl_croak(aTHX_ ERR_DECODE_NOMAP,
 185                               enc->name[0], (UV)s[slen]);
 186                     return &PL_sv_undef; /* never reaches but be safe */
 187                 }
 188                 if (check & ENCODE_WARN_ON_ERR){
 189                     Perl_warner(
 190                         aTHX_ packWARN(WARN_UTF8),
 191                         ERR_DECODE_NOMAP,
 192                         enc->name[0], (UV)s[slen]);
 193                 }
 194                 if (check & ENCODE_RETURN_ON_ERR){
 195                     goto ENCODE_SET_SRC;
 196                 }
 197                 if (check &
 198                     (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
 199                     SV* perlqq =
 200                         sv_2mortal(newSVpvf("\\x%02" UVXf, (UV)s[slen]));
 201                     sdone += slen + 1;
 202                     ddone += dlen + SvCUR(perlqq);
 203                     sv_catsv(dst, perlqq);
 204                 } else {
 205                     sdone += slen + 1;
 206                     ddone += dlen + strlen(FBCHAR_UTF8);
 207                     sv_catpv(dst, FBCHAR_UTF8);
 208                 }
 209             }
 210             /* settle variables when fallback */
 211             d    = (U8 *)SvEND(dst);
 212             dlen = SvLEN(dst) - ddone - 1;
 213             s    = (U8*)SvPVX(src) + sdone;
 214             slen = tlen - sdone;
 215             break;
 216
 217         default:
 218             Perl_croak(aTHX_ "Unexpected code %d converting %s %s",
 219                        code, (dir == enc->f_utf8) ? "to" : "from",
 220                        enc->name[0]);
 221             return &PL_sv_undef;
 222         }
 223     }
 224  ENCODE_SET_SRC:
 225     if (check && !(check & ENCODE_LEAVE_SRC)){
 226         sdone = SvCUR(src) - (slen+sdone);
 227         if (sdone) {
 228             sv_setpvn(src, (char*)s+slen, sdone);
 229         }
 230         SvCUR_set(src, sdone);
 231     }
 232     /* warn("check = 0x%X, code = 0x%d\n", check, code); */
 233
 234     SvCUR_set(dst, dlen+ddone);
 235     SvPOK_only(dst);
 236
 237 #if ENCODE_XS_PROFILE
 238     if (SvCUR(dst) > SvCUR(src)){
 239         Perl_warn(aTHX_
 240                   "SvLEN(dst)=%d, SvCUR(dst)=%d. %d bytes unused(%f %%)\n",
 241                   SvLEN(dst), SvCUR(dst), SvLEN(dst) - SvCUR(dst),
 242                   (SvLEN(dst) - SvCUR(dst))*1.0/SvLEN(dst)*100.0);
 243     }
 244 #endif
 245
 246     if (offset)
 247       *offset += sdone + slen;
 248
 249  ENCODE_END:
 250     *SvEND(dst) = '\0';
 251     if (retcode) *retcode = code;
 252     return dst;
 253 }
 254
 255 MODULE = Encode         PACKAGE = Encode::utf8  PREFIX = Method_
 256
 257 void
 258 Method_decode_xs(obj,src,check = 0)
 259 SV *    obj
 260 SV *    src
 261 int     check
 262 CODE:
 263 {
 264     STRLEN slen;
 265     U8 *s = (U8 *) SvPV(src, slen);
 266     U8 *e = (U8 *) SvEND(src);
 267     SV *dst = newSV(slen>0?slen:1); /* newSV() abhors 0 -- inaba */
 268     SvPOK_only(dst);
 269     SvCUR_set(dst,0);
 270     if (SvUTF8(src)) {
 271         s = utf8_to_bytes(s,&slen);
 272         if (s) {
 273             SvCUR_set(src,slen);
 274             SvUTF8_off(src);
 275             e = s+slen;
 276         }
 277         else {
 278             croak("Cannot decode string with wide characters");
 279         }
 280     }
 281     while (s < e) {
 282         if (UTF8_IS_INVARIANT(*s) || UTF8_IS_START(*s)) {
 283             U8 skip = UTF8SKIP(s);
 284             if ((s + skip) > e) {
 285                 /* Partial character - done */
 286                 break;
 287             }
 288             else if (is_utf8_char(s)) {
 289                 /* Whole char is good */
 290                 sv_catpvn(dst,(char *)s,skip);
 291                 s += skip;
 292                 continue;
 293             }
 294             else {
 295                 /* starts ok but isn't "good" */
 296             }
 297         }
 298         else {
 299             /* Invalid start byte */
 300         }
 301         /* If we get here there is something wrong with alleged UTF-8 */
 302         if (check & ENCODE_DIE_ON_ERR){
 303             Perl_croak(aTHX_ ERR_DECODE_NOMAP, "utf8", (UV)*s);
 304             XSRETURN(0);
 305         }
 306         if (check & ENCODE_WARN_ON_ERR){
 307             Perl_warner(aTHX_ packWARN(WARN_UTF8),
 308                         ERR_DECODE_NOMAP, "utf8", (UV)*s);
 309         }
 310         if (check & ENCODE_RETURN_ON_ERR) {
 311                 break;
 312         }
 313         if (check & (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
 314             SV* perlqq = newSVpvf("\\x%02" UVXf, (UV)*s);
 315             sv_catsv(dst, perlqq);
 316             SvREFCNT_dec(perlqq);
 317         } else {
 318             sv_catpv(dst, FBCHAR_UTF8);
 319         }
 320         s++;
 321     }
 322     *SvEND(dst) = '\0';
 323
 324     /* Clear out translated part of source unless asked not to */
 325     if (check && !(check & ENCODE_LEAVE_SRC)){
 326         slen = e-s;
 327         if (slen) {
 328             sv_setpvn(src, (char*)s, slen);
 329         }
 330         SvCUR_set(src, slen);
 331     }
 332     SvUTF8_on(dst);
 333     ST(0) = sv_2mortal(dst);
 334     XSRETURN(1);
 335 }
 336
 337 void
 338 Method_encode_xs(obj,src,check = 0)
 339 SV *    obj
 340 SV *    src
 341 int     check
 342 CODE:
 343 {
 344     STRLEN slen;
 345     U8 *s = (U8 *) SvPV(src, slen);
 346     U8 *e = (U8 *) SvEND(src);
 347     SV *dst = newSV(slen>0?slen:1); /* newSV() abhors 0 -- inaba */
 348     if (SvUTF8(src)) {
 349         /* Already encoded - trust it and just copy the octets */
 350         sv_setpvn(dst,(char *)s,(e-s));
 351         s = e;
 352     }
 353     else {
 354         /* Native bytes - can always encode */
 355         U8 *d = (U8 *) SvGROW(dst, 2*slen+1); /* +1 or assertion will botch */
 356         while (s < e) {
 357             UV uv = NATIVE_TO_UNI((UV) *s++);
 358             if (UNI_IS_INVARIANT(uv))
 359                 *d++ = (U8)UTF_TO_NATIVE(uv);
 360             else {
 361                 *d++ = (U8)UTF8_EIGHT_BIT_HI(uv);
 362                 *d++ = (U8)UTF8_EIGHT_BIT_LO(uv);
 363             }
 364         }
 365         SvCUR_set(dst, d- (U8 *)SvPVX(dst));
 366         *SvEND(dst) = '\0';
 367     }
 368
 369     /* Clear out translated part of source unless asked not to */
 370     if (check && !(check & ENCODE_LEAVE_SRC)){
 371         slen = e-s;
 372         if (slen) {
 373             sv_setpvn(src, (char*)s, slen);
 374         }
 375         SvCUR_set(src, slen);
 376     }
 377     SvPOK_only(dst);
 378     SvUTF8_off(dst);
 379     ST(0) = sv_2mortal(dst);
 380     XSRETURN(1);
 381 }
 382
 383 MODULE = Encode         PACKAGE = Encode::XS    PREFIX = Method_
 384
 385 PROTOTYPES: ENABLE
 386
 387 void
 388 Method_name(obj)
 389 SV *    obj
 390 CODE:
 391 {
 392     encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
 393     ST(0) = sv_2mortal(newSVpvn(enc->name[0],strlen(enc->name[0])));
 394     XSRETURN(1);
 395 }
 396
 397 void
 398 Method_cat_decode(obj, dst, src, off, term, check = 0)
 399 SV *    obj
 400 SV *    dst
 401 SV *    src
 402 SV *    off
 403 SV *    term
 404 int     check
 405 CODE:
 406 {
 407     encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
 408     STRLEN offset = (STRLEN)SvIV(off);
 409     int code = 0;
 410     if (SvUTF8(src)) {
 411         sv_utf8_downgrade(src, FALSE);
 412     }
 413     sv_catsv(dst, encode_method(aTHX_ enc, enc->t_utf8, src, check,
 414                                 &offset, term, &code));
 415     SvIVX(off) = (IV)offset;
 416     if (code == ENCODE_FOUND_TERM) {
 417         ST(0) = &PL_sv_yes;
 418     }else{
 419         ST(0) = &PL_sv_no;
 420     }
 421     XSRETURN(1);
 422 }
 423
 424 void
 425 Method_decode(obj,src,check = 0)
 426 SV *    obj
 427 SV *    src
 428 int     check
 429 CODE:
 430 {
 431     encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
 432     if (SvUTF8(src)) {
 433         sv_utf8_downgrade(src, FALSE);
 434     }
 435     ST(0) = encode_method(aTHX_ enc, enc->t_utf8, src, check,
 436                           NULL, Nullsv, NULL);
 437     SvUTF8_on(ST(0));
 438     XSRETURN(1);
 439 }
 440
 441 void
 442 Method_encode(obj,src,check = 0)
 443 SV *    obj
 444 SV *    src
 445 int     check
 446 CODE:
 447 {
 448     encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
 449     sv_utf8_upgrade(src);
 450     ST(0) = encode_method(aTHX_ enc, enc->f_utf8, src, check,
 451                           NULL, Nullsv, NULL);
 452     XSRETURN(1);
 453 }
 454
 455 void
 456 Method_needs_lines(obj)
 457 SV *    obj
 458 CODE:
 459 {
 460     /* encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj))); */
 461     ST(0) = &PL_sv_no;
 462     XSRETURN(1);
 463 }
 464
 465 void
 466 Method_perlio_ok(obj)
 467 SV *    obj
 468 CODE:
 469 {
 470     /* encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj))); */
 471     /* require_pv(PERLIO_FILENAME); */
 472
 473     eval_pv("require PerlIO::encoding", 0);
 474
 475     if (SvTRUE(get_sv("@", 0))) {
 476         ST(0) = &PL_sv_no;
 477     }else{
 478         ST(0) = &PL_sv_yes;
 479     }
 480     XSRETURN(1);
 481 }
 482
 483 MODULE = Encode         PACKAGE = Encode
 484
 485 PROTOTYPES: ENABLE
 486
 487 I32
 488 _bytes_to_utf8(sv, ...)
 489 SV *    sv
 490 CODE:
 491 {
 492     SV * encoding = items == 2 ? ST(1) : Nullsv;
 493
 494     if (encoding)
 495     RETVAL = _encoded_bytes_to_utf8(sv, SvPV_nolen(encoding));
 496     else {
 497         STRLEN len;
 498         U8*    s = (U8*)SvPV(sv, len);
 499         U8*    converted;
 500
 501         converted = bytes_to_utf8(s, &len); /* This allocs */
 502         sv_setpvn(sv, (char *)converted, len);
 503         SvUTF8_on(sv); /* XXX Should we? */
 504         Safefree(converted);                /* ... so free it */
 505         RETVAL = len;
 506     }
 507 }
 508 OUTPUT:
 509     RETVAL
 510
 511 I32
 512 _utf8_to_bytes(sv, ...)
 513 SV *    sv
 514 CODE:
 515 {
 516     SV * to    = items > 1 ? ST(1) : Nullsv;
 517     SV * check = items > 2 ? ST(2) : Nullsv;
 518
 519     if (to) {
 520         RETVAL = _encoded_utf8_to_bytes(sv, SvPV_nolen(to));
 521     } else {
 522         STRLEN len;
 523         U8 *s = (U8*)SvPV(sv, len);
 524
 525         RETVAL = 0;
 526         if (SvTRUE(check)) {
 527             /* Must do things the slow way */
 528             U8 *dest;
 529             /* We need a copy to pass to check() */
 530             U8 *src  = (U8*)savepv((char *)s);
 531             U8 *send = s + len;
 532
 533             New(83, dest, len, U8); /* I think */
 534
 535             while (s < send) {
 536                 if (*s < 0x80){
 537                     *dest++ = *s++;
 538                 } else {
 539                     STRLEN ulen;
 540                     UV uv = *s++;
 541
 542                     /* Have to do it all ourselves because of error routine,
 543                        aargh. */
 544                     if (!(uv & 0x40)){ goto failure; }
 545                     if      (!(uv & 0x20)) { ulen = 2;  uv &= 0x1f; }
 546                     else if (!(uv & 0x10)) { ulen = 3;  uv &= 0x0f; }
 547                     else if (!(uv & 0x08)) { ulen = 4;  uv &= 0x07; }
 548                     else if (!(uv & 0x04)) { ulen = 5;  uv &= 0x03; }
 549                     else if (!(uv & 0x02)) { ulen = 6;  uv &= 0x01; }
 550                     else if (!(uv & 0x01)) { ulen = 7;  uv = 0; }
 551                     else                   { ulen = 13; uv = 0; }
 552
 553                     /* Note change to utf8.c variable naming, for variety */
 554                     while (ulen--) {
 555                         if ((*s & 0xc0) != 0x80){
 556                             goto failure;
 557                         } else {
 558                             uv = (uv << 6) | (*s++ & 0x3f);
 559                         }
 560                   }
 561                   if (uv > 256) {
 562                   failure:
 563                       call_failure(check, s, dest, src);
 564                       /* Now what happens? */
 565                   }
 566                   *dest++ = (U8)uv;
 567                 }
 568             }
 569         } else {
 570             RETVAL = (utf8_to_bytes(s, &len) ? len : 0);
 571         }
 572     }
 573 }
 574 OUTPUT:
 575     RETVAL
 576
 577 bool
 578 is_utf8(sv, check = 0)
 579 SV *    sv
 580 int     check
 581 CODE:
 582 {
 583     if (SvGMAGICAL(sv)) /* it could be $1, for example */
 584         sv = newSVsv(sv); /* GMAGIG will be done */
 585     if (SvPOK(sv)) {
 586         RETVAL = SvUTF8(sv) ? TRUE : FALSE;
 587         if (RETVAL &&
 588             check  &&
 589             !is_utf8_string((U8*)SvPVX(sv), SvCUR(sv)))
 590             RETVAL = FALSE;
 591     } else {
 592         RETVAL = FALSE;
 593     }
 594     if (sv != ST(0))
 595         SvREFCNT_dec(sv); /* it was a temp copy */
 596 }
 597 OUTPUT:
 598     RETVAL
 599
 600 SV *
 601 _utf8_on(sv)
 602 SV *    sv
 603 CODE:
 604 {
 605     if (SvPOK(sv)) {
 606         SV *rsv = newSViv(SvUTF8(sv));
 607         RETVAL = rsv;
 608         SvUTF8_on(sv);
 609     } else {
 610         RETVAL = &PL_sv_undef;
 611     }
 612 }
 613 OUTPUT:
 614     RETVAL
 615
 616 SV *
 617 _utf8_off(sv)
 618 SV *    sv
 619 CODE:
 620 {
 621     if (SvPOK(sv)) {
 622         SV *rsv = newSViv(SvUTF8(sv));
 623         RETVAL = rsv;
 624         SvUTF8_off(sv);
 625     } else {
 626         RETVAL = &PL_sv_undef;
 627     }
 628 }
 629 OUTPUT:
 630     RETVAL
 631
 632 int
 633 DIE_ON_ERR()
 634 CODE:
 635     RETVAL = ENCODE_DIE_ON_ERR;
 636 OUTPUT:
 637     RETVAL
 638
 639 int
 640 WARN_ON_ERR()
 641 CODE:
 642     RETVAL = ENCODE_WARN_ON_ERR;
 643 OUTPUT:
 644     RETVAL
 645
 646 int
 647 LEAVE_SRC()
 648 CODE:
 649     RETVAL = ENCODE_LEAVE_SRC;
 650 OUTPUT:
 651     RETVAL
 652
 653 int
 654 RETURN_ON_ERR()
 655 CODE:
 656     RETVAL = ENCODE_RETURN_ON_ERR;
 657 OUTPUT:
 658     RETVAL
 659
 660 int
 661 PERLQQ()
 662 CODE:
 663     RETVAL = ENCODE_PERLQQ;
 664 OUTPUT:
 665     RETVAL
 666
 667 int
 668 HTMLCREF()
 669 CODE:
 670     RETVAL = ENCODE_HTMLCREF;
 671 OUTPUT:
 672     RETVAL
 673
 674 int
 675 XMLCREF()
 676 CODE:
 677     RETVAL = ENCODE_XMLCREF;
 678 OUTPUT:
 679     RETVAL
 680
 681 int
 682 FB_DEFAULT()
 683 CODE:
 684     RETVAL = ENCODE_FB_DEFAULT;
 685 OUTPUT:
 686     RETVAL
 687
 688 int
 689 FB_CROAK()
 690 CODE:
 691     RETVAL = ENCODE_FB_CROAK;
 692 OUTPUT:
 693     RETVAL
 694
 695 int
 696 FB_QUIET()
 697 CODE:
 698     RETVAL = ENCODE_FB_QUIET;
 699 OUTPUT:
 700     RETVAL
 701
 702 int
 703 FB_WARN()
 704 CODE:
 705     RETVAL = ENCODE_FB_WARN;
 706 OUTPUT:
 707     RETVAL
 708
 709 int
 710 FB_PERLQQ()
 711 CODE:
 712     RETVAL = ENCODE_FB_PERLQQ;
 713 OUTPUT:
 714     RETVAL
 715
 716 int
 717 FB_HTMLCREF()
 718 CODE:
 719     RETVAL = ENCODE_FB_HTMLCREF;
 720 OUTPUT:
 721     RETVAL
 722
 723 int
 724 FB_XMLCREF()
 725 CODE:
 726     RETVAL = ENCODE_FB_XMLCREF;
 727 OUTPUT:
 728     RETVAL
 729
 730 BOOT:
 731 {
 732 #include "def_t.h"
 733 #include "def_t.exh"
 734 }
 735