dist/IO/IO.xs

   1 /*
   2  * Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
   3  * This program is free software; you can redistribute it and/or
   4  * modify it under the same terms as Perl itself.
   5  */
   6
   7 #define PERL_EXT_IO
   8
   9 #define PERL_NO_GET_CONTEXT
  10 #include "EXTERN.h"
  11 #define PERLIO_NOT_STDIO 1
  12 #include "perl.h"
  13 #include "XSUB.h"
  14 #define NEED_eval_pv
  15 #define NEED_newCONSTSUB
  16 #define NEED_newSVpvn_flags
  17 #include "ppport.h"
  18 #include "poll.h"
  19 #ifdef I_UNISTD
  20 #  include <unistd.h>
  21 #endif
  22 #if defined(I_FCNTL) || defined(HAS_FCNTL)
  23 #  include <fcntl.h>
  24 #endif
  25
  26 #ifndef SIOCATMARK
  27 #   ifdef I_SYS_SOCKIO
  28 #       include <sys/sockio.h>
  29 #   endif
  30 #endif
  31
  32 #ifdef PerlIO
  33 #if defined(MACOS_TRADITIONAL) && defined(USE_SFIO)
  34 #define PERLIO_IS_STDIO 1
  35 #undef setbuf
  36 #undef setvbuf
  37 #define setvbuf         _stdsetvbuf
  38 #define setbuf(f,b)     ( __sf_setbuf(f,b) )
  39 #endif
  40 typedef int SysRet;
  41 typedef PerlIO * InputStream;
  42 typedef PerlIO * OutputStream;
  43 #else
  44 #define PERLIO_IS_STDIO 1
  45 typedef int SysRet;
  46 typedef FILE * InputStream;
  47 typedef FILE * OutputStream;
  48 #endif
  49
  50 #define MY_start_subparse(fmt,flags) start_subparse(fmt,flags)
  51
  52 #ifndef gv_stashpvn
  53 #define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
  54 #endif
  55
  56 #ifndef __attribute__noreturn__
  57 #  define __attribute__noreturn__
  58 #endif
  59
  60 #ifndef NORETURN_FUNCTION_END
  61 # define NORETURN_FUNCTION_END /* NOT REACHED */ return 0
  62 #endif
  63
  64 #ifndef dVAR
  65 #  define dVAR dNOOP
  66 #endif
  67
  68 #ifndef OpSIBLING
  69 #  define OpSIBLING(o) (o)->op_sibling
  70 #endif
  71
  72 static int not_here(const char *s) __attribute__noreturn__;
  73 static int
  74 not_here(const char *s)
  75 {
  76     croak("%s not implemented on this architecture", s);
  77     NORETURN_FUNCTION_END;
  78 }
  79
  80 #ifndef UVCHR_IS_INVARIANT   /* For use with Perls without this macro */
  81 #   if ('A' == 65)
  82 #       define UVCHR_IS_INVARIANT(cp) ((cp) < 128)
  83 #   elif (defined(NATIVE_IS_INVARIANT)) /* EBCDIC on old Perl */
  84 #       define UVCHR_IS_INVARIANT(cp) ((cp) < 256 && NATIVE_IS_INVARIANT(cp))
  85 #   elif defined(isASCII)    /* EBCDIC on very old Perl */
  86         /* In EBCDIC, the invariants are the code points corresponding to ASCII,
  87          * plus all the controls.  All but one EBCDIC control is below SPACE; it
  88          * varies depending on the code page, determined by the ord of '^' */
  89 #       define UVCHR_IS_INVARIANT(cp) (isASCII(cp)                            \
  90                                        || (cp) < ' '                          \
  91                                        || (('^' == 106)    /* POSIX-BC */     \
  92                                           ? (cp) == 95                        \
  93                                           : (cp) == 0xFF)) /* 1047 or 037 */
  94 #   else    /* EBCDIC on very very old Perl */
  95         /* This assumes isascii() is available, but that could be fixed by
  96          * having the macro test for each printable ASCII char */
  97 #       define UVCHR_IS_INVARIANT(cp) (isascii(cp)                            \
  98                                        || (cp) < ' '                          \
  99                                        || (('^' == 106)    /* POSIX-BC */     \
 100                                           ? (cp) == 95                        \
 101                                           : (cp) == 0xFF)) /* 1047 or 037 */
 102 #   endif
 103 #endif
 104
 105
 106 #ifndef PerlIO
 107 #define PerlIO_fileno(f) fileno(f)
 108 #endif
 109
 110 static int
 111 io_blocking(pTHX_ InputStream f, int block)
 112 {
 113     int fd = -1;
 114 #if defined(HAS_FCNTL)
 115     int RETVAL;
 116     if (!f) {
 117         errno = EBADF;
 118         return -1;
 119     }
 120     fd = PerlIO_fileno(f);
 121     if (fd < 0) {
 122       errno = EBADF;
 123       return -1;
 124     }
 125     RETVAL = fcntl(fd, F_GETFL, 0);
 126     if (RETVAL >= 0) {
 127         int mode = RETVAL;
 128         int newmode = mode;
 129 #ifdef O_NONBLOCK
 130         /* POSIX style */
 131
 132 # ifndef O_NDELAY
 133 #  define O_NDELAY O_NONBLOCK
 134 # endif
 135         /* Note: UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY
 136          * after a successful F_SETFL of an O_NONBLOCK. */
 137         RETVAL = RETVAL & (O_NONBLOCK | O_NDELAY) ? 0 : 1;
 138
 139         if (block == 0) {
 140             newmode &= ~O_NDELAY;
 141             newmode |= O_NONBLOCK;
 142         } else if (block > 0) {
 143             newmode &= ~(O_NDELAY|O_NONBLOCK);
 144         }
 145 #else
 146         /* Not POSIX - better have O_NDELAY or we can't cope.
 147          * for BSD-ish machines this is an acceptable alternative
 148          * for SysV we can't tell "would block" from EOF but that is
 149          * the way SysV is...
 150          */
 151         RETVAL = RETVAL & O_NDELAY ? 0 : 1;
 152
 153         if (block == 0) {
 154             newmode |= O_NDELAY;
 155         } else if (block > 0) {
 156             newmode &= ~O_NDELAY;
 157         }
 158 #endif
 159         if (newmode != mode) {
 160             const int ret = fcntl(fd, F_SETFL, newmode);
 161             if (ret < 0)
 162                 RETVAL = ret;
 163         }
 164     }
 165     return RETVAL;
 166 #else
 167 #   ifdef WIN32
 168     if (block >= 0) {
 169         unsigned long flags = !block;
 170         /* ioctl claims to take char* but really needs a u_long sized buffer */
 171         const int ret = ioctl(fd, FIONBIO, (char*)&flags);
 172         if (ret != 0)
 173             return -1;
 174         /* Win32 has no way to get the current blocking status of a socket.
 175          * However, we don't want to just return undef, because there's no way
 176          * to tell that the ioctl succeeded.
 177          */
 178         return flags;
 179     }
 180     /* TODO: Perhaps set $! to ENOTSUP? */
 181     return -1;
 182 #   else
 183     return -1;
 184 #   endif
 185 #endif
 186 }
 187
 188
 189 MODULE = IO     PACKAGE = IO::Seekable  PREFIX = f
 190
 191 void
 192 fgetpos(handle)
 193         InputStream     handle
 194     CODE:
 195         if (handle) {
 196 #ifdef PerlIO
 197 #if PERL_VERSION < 8
 198             Fpos_t pos;
 199             ST(0) = sv_newmortal();
 200             if (PerlIO_getpos(handle, &pos) != 0) {
 201                 ST(0) = &PL_sv_undef;
 202             }
 203             else {
 204                 sv_setpvn(ST(0), (char *)&pos, sizeof(Fpos_t));
 205             }
 206 #else
 207             ST(0) = sv_newmortal();
 208             if (PerlIO_getpos(handle, ST(0)) != 0) {
 209                 ST(0) = &PL_sv_undef;
 210             }
 211 #endif
 212 #else
 213             Fpos_t pos;
 214             if (fgetpos(handle, &pos)) {
 215                 ST(0) = &PL_sv_undef;
 216             } else {
 217 #  if PERL_VERSION >= 11
 218                 ST(0) = newSVpvn_flags((char*)&pos, sizeof(Fpos_t), SVs_TEMP);
 219 #  else
 220                 ST(0) = sv_2mortal(newSVpvn((char*)&pos, sizeof(Fpos_t)));
 221 #  endif
 222             }
 223 #endif
 224         }
 225         else {
 226             errno = EINVAL;
 227             ST(0) = &PL_sv_undef;
 228         }
 229
 230 SysRet
 231 fsetpos(handle, pos)
 232         InputStream     handle
 233         SV *            pos
 234     CODE:
 235         if (handle) {
 236 #ifdef PerlIO
 237 #if PERL_VERSION < 8
 238             char *p;
 239             STRLEN len;
 240             if (SvOK(pos) && (p = SvPV(pos,len)) && len == sizeof(Fpos_t)) {
 241                 RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
 242             }
 243             else {
 244                 RETVAL = -1;
 245                 errno = EINVAL;
 246             }
 247 #else
 248             RETVAL = PerlIO_setpos(handle, pos);
 249 #endif
 250 #else
 251             char *p;
 252             STRLEN len;
 253             if ((p = SvPV(pos,len)) && len == sizeof(Fpos_t)) {
 254                 RETVAL = fsetpos(handle, (Fpos_t*)p);
 255             }
 256             else {
 257                 RETVAL = -1;
 258                 errno = EINVAL;
 259             }
 260 #endif
 261         }
 262         else {
 263             RETVAL = -1;
 264             errno = EINVAL;
 265         }
 266     OUTPUT:
 267         RETVAL
 268
 269 MODULE = IO     PACKAGE = IO::File      PREFIX = f
 270
 271 void
 272 new_tmpfile(packname = "IO::File")
 273     const char * packname
 274     PREINIT:
 275         OutputStream fp;
 276         GV *gv;
 277     CODE:
 278 #ifdef PerlIO
 279         fp = PerlIO_tmpfile();
 280 #else
 281         fp = tmpfile();
 282 #endif
 283         gv = (GV*)SvREFCNT_inc(newGVgen(packname));
 284         if (gv)
 285             (void) hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
 286         if (gv && do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) {
 287             ST(0) = sv_2mortal(newRV((SV*)gv));
 288             sv_bless(ST(0), gv_stashpv(packname, TRUE));
 289             SvREFCNT_dec(gv);   /* undo increment in newRV() */
 290         }
 291         else {
 292             ST(0) = &PL_sv_undef;
 293             SvREFCNT_dec(gv);
 294         }
 295
 296 MODULE = IO     PACKAGE = IO::Poll
 297
 298 void
 299 _poll(timeout,...)
 300         int timeout;
 301 PPCODE:
 302 {
 303 #ifdef HAS_POLL
 304     const int nfd = (items - 1) / 2;
 305     SV *tmpsv = sv_2mortal(NEWSV(999,nfd * sizeof(struct pollfd)));
 306     /* We should pass _some_ valid pointer even if nfd is zero, but it
 307      * doesn't matter what it is, since we're telling it to not check any fds.
 308      */
 309     struct pollfd *fds = nfd ? (struct pollfd *)SvPVX(tmpsv) : (struct pollfd *)tmpsv;
 310     int i,j,ret;
 311     for(i=1, j=0  ; j < nfd ; j++) {
 312         fds[j].fd = SvIV(ST(i));
 313         i++;
 314         fds[j].events = (short)SvIV(ST(i));
 315         i++;
 316         fds[j].revents = 0;
 317     }
 318     if((ret = poll(fds,nfd,timeout)) >= 0) {
 319         for(i=1, j=0 ; j < nfd ; j++) {
 320             sv_setiv(ST(i), fds[j].fd); i++;
 321             sv_setiv(ST(i), fds[j].revents); i++;
 322         }
 323     }
 324     XSRETURN_IV(ret);
 325 #else
 326         not_here("IO::Poll::poll");
 327 #endif
 328 }
 329
 330 MODULE = IO     PACKAGE = IO::Handle    PREFIX = io_
 331
 332 void
 333 io_blocking(handle,blk=-1)
 334         InputStream     handle
 335         int             blk
 336 PROTOTYPE: $;$
 337 CODE:
 338 {
 339     const int ret = io_blocking(aTHX_ handle, items == 1 ? -1 : blk ? 1 : 0);
 340     if(ret >= 0)
 341         XSRETURN_IV(ret);
 342     else
 343         XSRETURN_UNDEF;
 344 }
 345
 346 MODULE = IO     PACKAGE = IO::Handle    PREFIX = f
 347
 348 int
 349 ungetc(handle, c)
 350         InputStream     handle
 351         SV *            c
 352     CODE:
 353         if (handle) {
 354 #ifdef PerlIO
 355             UV v;
 356
 357             if ((SvIOK_notUV(c) && SvIV(c) < 0) || (SvNOK(c) && SvNV(c) < 0.0))
 358                 croak("Negative character number in ungetc()");
 359
 360             v = SvUV(c);
 361             if (UVCHR_IS_INVARIANT(v) || (v <= 0xFF && !PerlIO_isutf8(handle)))
 362                 RETVAL = PerlIO_ungetc(handle, (int)v);
 363             else {
 364                 U8 buf[UTF8_MAXBYTES + 1], *end;
 365                 Size_t len;
 366
 367                 if (!PerlIO_isutf8(handle))
 368                     croak("Wide character number in ungetc()");
 369
 370                 /* This doesn't warn for non-chars, surrogate, and
 371                  * above-Unicodes */
 372                 end = uvchr_to_utf8_flags(buf, v, 0);
 373                 len = end - buf;
 374                 if ((Size_t)PerlIO_unread(handle, &buf, len) == len)
 375                     XSRETURN_UV(v);
 376                 else
 377                     RETVAL = EOF;
 378             }
 379 #else
 380             RETVAL = ungetc((int)SvIV(c), handle);
 381 #endif
 382         }
 383         else {
 384             RETVAL = -1;
 385             errno = EINVAL;
 386         }
 387     OUTPUT:
 388         RETVAL
 389
 390 int
 391 ferror(handle)
 392         InputStream     handle
 393     CODE:
 394         if (handle)
 395 #ifdef PerlIO
 396             RETVAL = PerlIO_error(handle);
 397 #else
 398             RETVAL = ferror(handle);
 399 #endif
 400         else {
 401             RETVAL = -1;
 402             errno = EINVAL;
 403         }
 404     OUTPUT:
 405         RETVAL
 406
 407 int
 408 clearerr(handle)
 409         InputStream     handle
 410     CODE:
 411         if (handle) {
 412 #ifdef PerlIO
 413             PerlIO_clearerr(handle);
 414 #else
 415             clearerr(handle);
 416 #endif
 417             RETVAL = 0;
 418         }
 419         else {
 420             RETVAL = -1;
 421             errno = EINVAL;
 422         }
 423     OUTPUT:
 424         RETVAL
 425
 426 int
 427 untaint(handle)
 428        SV *     handle
 429     CODE:
 430 #ifdef IOf_UNTAINT
 431         IO * io;
 432         io = sv_2io(handle);
 433         if (io) {
 434             IoFLAGS(io) |= IOf_UNTAINT;
 435             RETVAL = 0;
 436         }
 437         else {
 438 #endif
 439             RETVAL = -1;
 440             errno = EINVAL;
 441 #ifdef IOf_UNTAINT
 442         }
 443 #endif
 444     OUTPUT:
 445         RETVAL
 446
 447 SysRet
 448 fflush(handle)
 449         OutputStream    handle
 450     CODE:
 451         if (handle)
 452 #ifdef PerlIO
 453             RETVAL = PerlIO_flush(handle);
 454 #else
 455             RETVAL = Fflush(handle);
 456 #endif
 457         else {
 458             RETVAL = -1;
 459             errno = EINVAL;
 460         }
 461     OUTPUT:
 462         RETVAL
 463
 464 void
 465 setbuf(handle, ...)
 466         OutputStream    handle
 467     CODE:
 468         if (handle)
 469 #ifdef PERLIO_IS_STDIO
 470         {
 471             char *buf = items == 2 && SvPOK(ST(1)) ?
 472               sv_grow(ST(1), BUFSIZ) : 0;
 473             setbuf(handle, buf);
 474         }
 475 #else
 476             not_here("IO::Handle::setbuf");
 477 #endif
 478
 479 SysRet
 480 setvbuf(...)
 481     CODE:
 482         if (items != 4)
 483             Perl_croak(aTHX_ "Usage: IO::Handle::setvbuf(handle, buf, type, size)");
 484 #if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF)
 485     {
 486         OutputStream    handle = 0;
 487         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
 488         int             type;
 489         int             size;
 490
 491         if (items == 4) {
 492             handle = IoOFP(sv_2io(ST(0)));
 493             buf    = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
 494             type   = (int)SvIV(ST(2));
 495             size   = (int)SvIV(ST(3));
 496         }
 497         if (!handle)                    /* Try input stream. */
 498             handle = IoIFP(sv_2io(ST(0)));
 499         if (items == 4 && handle)
 500             RETVAL = setvbuf(handle, buf, type, size);
 501         else {
 502             RETVAL = -1;
 503             errno = EINVAL;
 504         }
 505     }
 506 #else
 507         RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
 508 #endif
 509     OUTPUT:
 510         RETVAL
 511
 512
 513 SysRet
 514 fsync(arg)
 515         SV * arg
 516     PREINIT:
 517         OutputStream handle = NULL;
 518     CODE:
 519 #ifdef HAS_FSYNC
 520         handle = IoOFP(sv_2io(arg));
 521         if (!handle)
 522             handle = IoIFP(sv_2io(arg));
 523         if (handle) {
 524             int fd = PerlIO_fileno(handle);
 525             if (fd >= 0) {
 526                 RETVAL = fsync(fd);
 527             } else {
 528                 RETVAL = -1;
 529                 errno = EBADF;
 530             }
 531         } else {
 532             RETVAL = -1;
 533             errno = EINVAL;
 534         }
 535 #else
 536         RETVAL = (SysRet) not_here("IO::Handle::sync");
 537 #endif
 538     OUTPUT:
 539         RETVAL
 540
 541 # To make these two work correctly with the open pragma, the readline op
 542 # needs to pick up the lexical hints at the method's callsite. This doesn't
 543 # work in pure Perl, because the hints are read from the most recent nextstate,
 544 # and the nextstate of the Perl subroutines show *here* hold the lexical state
 545 # for the IO package.
 546 #
 547 # There's no clean way to implement this - this approach, while complex, seems
 548 # to be the most robust, and avoids manipulating external state (ie op checkers)
 549 #
 550 # sub getline {
 551 #     @_ == 1 or croak 'usage: $io->getline()';
 552 #     my $this = shift;
 553 #     return scalar <$this>;
 554 # }
 555 #
 556 # sub getlines {
 557 #     @_ == 1 or croak 'usage: $io->getlines()';
 558 #     wantarray or
 559 #       croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
 560 #     my $this = shift;
 561 #     return <$this>;
 562 # }
 563
 564 # If this is deprecated, should it warn, and should it be removed at some point?
 565 # *gets = \&getline;  # deprecated
 566
 567 void
 568 getlines(...)
 569 ALIAS:
 570     IO::Handle::getline       =  1
 571     IO::Handle::gets          =  2
 572 INIT:
 573     UNOP myop;
 574     SV *io;
 575     OP *was = PL_op;
 576 PPCODE:
 577     if (items != 1)
 578         Perl_croak(aTHX_ "usage: $io->%s()", ix ? "getline" : "getlines");
 579     if (!ix && GIMME_V != G_ARRAY)
 580         Perl_croak(aTHX_ "Can't call $io->getlines in a scalar context, use $io->getline");
 581     Zero(&myop, 1, UNOP);
 582     myop.op_flags = (ix ? OPf_WANT_SCALAR : OPf_WANT_LIST ) | OPf_STACKED;
 583     myop.op_ppaddr = PL_ppaddr[OP_READLINE];
 584     myop.op_type = OP_READLINE;
 585     /* I don't know if we need this, but it's correct as far as the control flow
 586        goes. However, if we *do* need it, do we need to set anything else up? */
 587     myop.op_next = PL_op->op_next;
 588     /* Sigh, because pp_readline calls pp_rv2gv, and *it* has this wonderful
 589        state check for PL_op->op_type == OP_READLINE */
 590     PL_op = (OP *) &myop;
 591     io = ST(0);
 592     /* Our target (which we need to provide, as we don't have a pad entry.
 593        I think that this is only needed for G_SCALAR - maybe we can get away
 594        with NULL for list context? */
 595     PUSHs(sv_newmortal());
 596     XPUSHs(io);
 597     PUTBACK;
 598     /* And effectively we get away with tail calling pp_readline, as it stacks
 599        exactly the return value(s) we need to return. */
 600     PL_ppaddr[OP_READLINE](aTHX);
 601     PL_op = was;
 602     /* And we don't want to reach the line
 603        PL_stack_sp = sp;
 604        that xsubpp adds after our body becase PL_stack_sp is correct, not sp */
 605     return;
 606
 607 MODULE = IO     PACKAGE = IO::Socket
 608
 609 SysRet
 610 sockatmark (sock)
 611    InputStream sock
 612    PROTOTYPE: $
 613    PREINIT:
 614      int fd;
 615    CODE:
 616      fd = PerlIO_fileno(sock);
 617      if (fd < 0) {
 618        errno = EBADF;
 619        RETVAL = -1;
 620      }
 621 #ifdef HAS_SOCKATMARK
 622      else {
 623        RETVAL = sockatmark(fd);
 624      }
 625 #else
 626      else {
 627        int flag = 0;
 628 #   ifdef SIOCATMARK
 629 #     if defined(NETWARE) || defined(WIN32)
 630        if (ioctl(fd, SIOCATMARK, (char*)&flag) != 0)
 631 #     else
 632        if (ioctl(fd, SIOCATMARK, &flag) != 0)
 633 #     endif
 634          XSRETURN_UNDEF;
 635 #   else
 636        not_here("IO::Socket::atmark");
 637 #   endif
 638        RETVAL = flag;
 639      }
 640 #endif
 641    OUTPUT:
 642      RETVAL
 643
 644 BOOT:
 645 {
 646     HV *stash;
 647     /*
 648      * constant subs for IO::Poll
 649      */
 650     stash = gv_stashpvn("IO::Poll", 8, TRUE);
 651 #ifdef  POLLIN
 652         newCONSTSUB(stash,"POLLIN",newSViv(POLLIN));
 653 #endif
 654 #ifdef  POLLPRI
 655         newCONSTSUB(stash,"POLLPRI", newSViv(POLLPRI));
 656 #endif
 657 #ifdef  POLLOUT
 658         newCONSTSUB(stash,"POLLOUT", newSViv(POLLOUT));
 659 #endif
 660 #ifdef  POLLRDNORM
 661         newCONSTSUB(stash,"POLLRDNORM", newSViv(POLLRDNORM));
 662 #endif
 663 #ifdef  POLLWRNORM
 664         newCONSTSUB(stash,"POLLWRNORM", newSViv(POLLWRNORM));
 665 #endif
 666 #ifdef  POLLRDBAND
 667         newCONSTSUB(stash,"POLLRDBAND", newSViv(POLLRDBAND));
 668 #endif
 669 #ifdef  POLLWRBAND
 670         newCONSTSUB(stash,"POLLWRBAND", newSViv(POLLWRBAND));
 671 #endif
 672 #ifdef  POLLNORM
 673         newCONSTSUB(stash,"POLLNORM", newSViv(POLLNORM));
 674 #endif
 675 #ifdef  POLLERR
 676         newCONSTSUB(stash,"POLLERR", newSViv(POLLERR));
 677 #endif
 678 #ifdef  POLLHUP
 679         newCONSTSUB(stash,"POLLHUP", newSViv(POLLHUP));
 680 #endif
 681 #ifdef  POLLNVAL
 682         newCONSTSUB(stash,"POLLNVAL", newSViv(POLLNVAL));
 683 #endif
 684     /*
 685      * constant subs for IO::Handle
 686      */
 687     stash = gv_stashpvn("IO::Handle", 10, TRUE);
 688 #ifdef _IOFBF
 689         newCONSTSUB(stash,"_IOFBF", newSViv(_IOFBF));
 690 #endif
 691 #ifdef _IOLBF
 692         newCONSTSUB(stash,"_IOLBF", newSViv(_IOLBF));
 693 #endif
 694 #ifdef _IONBF
 695         newCONSTSUB(stash,"_IONBF", newSViv(_IONBF));
 696 #endif
 697 #ifdef SEEK_SET
 698         newCONSTSUB(stash,"SEEK_SET", newSViv(SEEK_SET));
 699 #endif
 700 #ifdef SEEK_CUR
 701         newCONSTSUB(stash,"SEEK_CUR", newSViv(SEEK_CUR));
 702 #endif
 703 #ifdef SEEK_END
 704         newCONSTSUB(stash,"SEEK_END", newSViv(SEEK_END));
 705 #endif
 706 }
 707