[inseperable differences to perl 5.004_03]

[p5sagit/p5-mst-13.2.git] / ext / IO / IO.xs

diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs
index 9dc09b2..e558d5c 100644 (file)
--- a/ext/IO/IO.xs
+++ b/ext/IO/IO.xs
@@ -1,13 +1,25 @@
 #include "EXTERN.h"
+#define PERLIO_NOT_STDIO 1
 #include "perl.h"
 #include "XSUB.h"
+
 #ifdef I_UNISTD
 #  include <unistd.h>
 #endif
+#ifdef I_FCNTL
+#  include <fcntl.h>
+#endif
 
+#ifdef PerlIO
+typedef int SysRet;
+typedef PerlIO * InputStream;
+typedef PerlIO * OutputStream;
+#else
+#define PERLIO_IS_STDIO 1
 typedef int SysRet;
 typedef FILE * InputStream;
 typedef FILE * OutputStream;
+#endif
 
 static int
 not_here(s)
@@ -62,12 +74,6 @@ IV *pval;
 #else
            return FALSE;
 #endif
-       if (strEQ(name, "SEEK_EOF"))
-#ifdef SEEK_EOF
-           { *pval = SEEK_EOF; return TRUE; }
-#else
-           return FALSE;
-#endif
        break;
     }
 
@@ -81,47 +87,64 @@ SV *
 fgetpos(handle)
        InputStream     handle
     CODE:
-#ifdef HAS_FGETPOS
        if (handle) {
            Fpos_t pos;
+#ifdef PerlIO
+           PerlIO_getpos(handle, &pos);
+#else
            fgetpos(handle, &pos);
+#endif
            ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
        }
        else {
            ST(0) = &sv_undef;
            errno = EINVAL;
        }
-#else
-       ST(0) = (SV *) not_here("IO::Seekable::fgetpos");
-#endif
 
 SysRet
 fsetpos(handle, pos)
        InputStream     handle
        SV *            pos
     CODE:
-#ifdef HAS_FSETPOS
-       if (handle)
-           RETVAL = fsetpos(handle, (Fpos_t*)SvPVX(pos));
+       char *p;
+       if (handle && (p = SvPVx(pos, na)) && na == sizeof(Fpos_t))
+#ifdef PerlIO
+           RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
+#else
+           RETVAL = fsetpos(handle, (Fpos_t*)p);
+#endif
        else {
            RETVAL = -1;
            errno = EINVAL;
        }
-#else
-           RETVAL = (SysRet) not_here("IO::Seekable::fsetpos");
-#endif
     OUTPUT:
        RETVAL
 
 MODULE = IO    PACKAGE = IO::File      PREFIX = f
 
-OutputStream
+SV *
 new_tmpfile(packname = "IO::File")
     char *             packname
+    PREINIT:
+       OutputStream fp;
+       GV *gv;
     CODE:
-       RETVAL = tmpfile();
-    OUTPUT:
-       RETVAL
+#ifdef PerlIO
+       fp = PerlIO_tmpfile();
+#else
+       fp = tmpfile();
+#endif
+       gv = (GV*)SvREFCNT_inc(newGVgen(packname));
+       hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
+       if (do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) {
+           ST(0) = sv_2mortal(newRV((SV*)gv));
+           sv_bless(ST(0), gv_stashpv(packname, TRUE));
+           SvREFCNT_dec(gv);   /* undo increment in newRV() */
+       }
+       else {
+           ST(0) = &sv_undef;
+           SvREFCNT_dec(gv);
+       }
 
 MODULE = IO    PACKAGE = IO::Handle    PREFIX = f
 
@@ -141,7 +164,11 @@ ungetc(handle, c)
        int             c
     CODE:
        if (handle)
+#ifdef PerlIO
+           RETVAL = PerlIO_ungetc(handle, c);
+#else
            RETVAL = ungetc(c, handle);
+#endif
        else {
            RETVAL = -1;
            errno = EINVAL;
@@ -154,7 +181,30 @@ ferror(handle)
        InputStream     handle
     CODE:
        if (handle)
+#ifdef PerlIO
+           RETVAL = PerlIO_error(handle);
+#else
            RETVAL = ferror(handle);
+#endif
+       else {
+           RETVAL = -1;
+           errno = EINVAL;
+       }
+    OUTPUT:
+       RETVAL
+
+int
+clearerr(handle)
+       InputStream     handle
+    CODE:
+       if (handle) {
+#ifdef PerlIO
+           PerlIO_clearerr(handle);
+#else
+           clearerr(handle);
+#endif
+           RETVAL = 0;
+       }
        else {
            RETVAL = -1;
            errno = EINVAL;
@@ -162,12 +212,37 @@ ferror(handle)
     OUTPUT:
        RETVAL
 
+int
+untaint(handle)
+       SV *    handle
+    CODE:
+#ifdef IOf_UNTAINT
+       IO * io;
+       io = sv_2io(handle);
+       if (io) {
+           IoFLAGS(io) |= IOf_UNTAINT;
+           RETVAL = 0;
+       }
+        else {
+#endif
+           RETVAL = -1;
+           errno = EINVAL;
+#ifdef IOf_UNTAINT
+       }
+#endif
+    OUTPUT:
+       RETVAL
+
 SysRet
 fflush(handle)
        OutputStream    handle
     CODE:
        if (handle)
+#ifdef PerlIO
+           RETVAL = PerlIO_flush(handle);
+#else
            RETVAL = Fflush(handle);
+#endif
        else {
            RETVAL = -1;
            errno = EINVAL;
@@ -181,9 +256,11 @@ setbuf(handle, buf)
        char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
     CODE:
        if (handle)
+#ifdef PERLIO_IS_STDIO
            setbuf(handle, buf);
-
-
+#else
+           not_here("IO::Handle::setbuf");
+#endif
 
 SysRet
 setvbuf(handle, buf, type, size)
@@ -192,7 +269,10 @@ setvbuf(handle, buf, type, size)
        int             type
        int             size
     CODE:
-#ifdef _IOFBF   /* Should be HAS_SETVBUF once Configure tests for that */
+/* Should check HAS_SETVBUF once Configure tests for that */
+#if defined(PERLIO_IS_STDIO) && defined(_IOFBF)
+       if (!handle)                    /* Try input stream. */
+           handle = IoIFP(sv_2io(ST(0)));
        if (handle)
            RETVAL = setvbuf(handle, buf, type, size);
        else {
@@ -200,8 +280,8 @@ setvbuf(handle, buf, type, size)
            errno = EINVAL;
        }
 #else
-           RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
-#endif /* _IOFBF */
+       RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
+#endif
     OUTPUT:
        RETVAL