Add at least the "important" PerlIO_xxxx functions to embed.pl

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

diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs
index be84f73..9cefe08 100644 (file)
--- a/ext/IO/IO.xs
+++ b/ext/IO/IO.xs
@@ -4,6 +4,8 @@
  * modify it under the same terms as Perl itself.
  */
 
+#define PERL_EXT_IO
+
 #define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #define PERLIO_NOT_STDIO 1
@@ -17,6 +19,12 @@
 #  include <fcntl.h>
 #endif
 
+#ifndef SIOCATMARK
+#   ifdef I_SYS_SOCKIO
+#       include <sys/sockio.h>
+#   endif
+#endif
+
 #ifdef PerlIO
 typedef int SysRet;
 typedef PerlIO * InputStream;
@@ -47,7 +55,7 @@ not_here(char *s)
 #endif
 
 static int
-io_blocking(InputStream f, int block)
+io_blocking(pTHX_ InputStream f, int block)
 {
     int RETVAL;
     if(!f) {
@@ -59,9 +67,9 @@ io_blocking(InputStream f, int block)
     if (RETVAL >= 0) {
        int mode = RETVAL;
 #ifdef O_NONBLOCK
-       /* POSIX style */ 
+       /* POSIX style */
 #if defined(O_NDELAY) && O_NDELAY != O_NONBLOCK
-       /* Ooops has O_NDELAY too - make sure we don't 
+       /* Ooops has O_NDELAY too - make sure we don't
         * get SysV behaviour by mistake. */
 
        /* E.g. In UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY
@@ -86,7 +94,7 @@ io_blocking(InputStream f, int block)
               }
        }
 #else
-       /* Standard POSIX */ 
+       /* Standard POSIX */
        RETVAL = RETVAL & O_NONBLOCK ? 0 : 1;
 
        if ((block == 0) && !(mode & O_NONBLOCK)) {
@@ -103,11 +111,11 @@ io_blocking(InputStream f, int block)
            if(ret < 0)
                RETVAL = ret;
         }
-#endif 
+#endif
 #else
        /* Not POSIX - better have O_NDELAY or we can't cope.
         * for BSD-ish machines this is an acceptable alternative
-        * for SysV we can't tell "would block" from EOF but that is 
+        * for SysV we can't tell "would block" from EOF but that is
         * the way SysV is...
         */
        RETVAL = RETVAL & O_NDELAY ? 0 : 1;
@@ -136,18 +144,23 @@ io_blocking(InputStream f, int block)
 
 MODULE = IO    PACKAGE = IO::Seekable  PREFIX = f
 
-SV *
+void
 fgetpos(handle)
        InputStream     handle
     CODE:
        if (handle) {
-           Fpos_t pos;
 #ifdef PerlIO
-           PerlIO_getpos(handle, &pos);
+           ST(0) = sv_2mortal(newSV(0));
+           if (PerlIO_getpos(handle, ST(0)) != 0) {
+               ST(0) = &PL_sv_undef;
+           }
 #else
-           fgetpos(handle, &pos);
+           if (fgetpos(handle, &pos)) {
+               ST(0) = &PL_sv_undef;
+           } else {
+               ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
+           }
 #endif
-           ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
        }
        else {
            ST(0) = &PL_sv_undef;
@@ -159,14 +172,21 @@ fsetpos(handle, pos)
        InputStream     handle
        SV *            pos
     CODE:
-        char *p;
-       STRLEN len;
-       if (handle && (p = SvPV(pos,len)) && len == sizeof(Fpos_t))
+       if (handle) {
 #ifdef PerlIO
-           RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
+           RETVAL = PerlIO_setpos(handle, pos);
 #else
-           RETVAL = fsetpos(handle, (Fpos_t*)p);
+           char *p;
+           STRLEN len;
+           if ((p = SvPV(pos,len)) && len == sizeof(Fpos_t)) {
+               RETVAL = fsetpos(handle, (Fpos_t*)p);
+           }
+           else {
+               RETVAL = -1;
+               errno = EINVAL;
+           }
 #endif
+       }
        else {
            RETVAL = -1;
            errno = EINVAL;
@@ -176,7 +196,7 @@ fsetpos(handle, pos)
 
 MODULE = IO    PACKAGE = IO::File      PREFIX = f
 
-SV *
+void
 new_tmpfile(packname = "IO::File")
     char *             packname
     PREINIT:
@@ -202,7 +222,7 @@ new_tmpfile(packname = "IO::File")
 
 MODULE = IO    PACKAGE = IO::Poll
 
-void   
+void
 _poll(timeout,...)
        int timeout;
 PPCODE:
@@ -241,7 +261,7 @@ io_blocking(handle,blk=-1)
 PROTOTYPE: $;$
 CODE:
 {
-    int ret = io_blocking(handle, items == 1 ? -1 : blk ? 1 : 0);
+    int ret = io_blocking(aTHX_ handle, items == 1 ? -1 : blk ? 1 : 0);
     if(ret >= 0)
        XSRETURN_IV(ret);
     else
@@ -250,7 +270,6 @@ CODE:
 
 MODULE = IO    PACKAGE = IO::Handle    PREFIX = f
 
-
 int
 ungetc(handle, c)
        InputStream     handle
@@ -344,33 +363,47 @@ fflush(handle)
        RETVAL
 
 void
-setbuf(handle, buf)
+setbuf(handle, ...)
        OutputStream    handle
-       char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
     CODE:
        if (handle)
 #ifdef PERLIO_IS_STDIO
+        {
+           char *buf = items == 2 && SvPOK(ST(1)) ?
+             sv_grow(ST(1), BUFSIZ) : 0;
            setbuf(handle, buf);
+       }
 #else
            not_here("IO::Handle::setbuf");
 #endif
 
 SysRet
-setvbuf(handle, buf, type, size)
-       OutputStream    handle
-       char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
-       int             type
-       int             size
+setvbuf(...)
     CODE:
+       if (items != 4)
+            Perl_croak(aTHX_ "Usage: IO::Handle::setvbuf(handle, buf, type, size)");
 #if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF)
+    {
+        OutputStream   handle = 0;
+       char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
+       int             type;
+       int             size;
+
+       if (items == 4) {
+           handle = IoOFP(sv_2io(ST(0)));
+           buf    = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
+           type   = (int)SvIV(ST(2));
+           size   = (int)SvIV(ST(3));
+       }
        if (!handle)                    /* Try input stream. */
            handle = IoIFP(sv_2io(ST(0)));
-       if (handle)
+       if (items == 4 && handle)
            RETVAL = setvbuf(handle, buf, type, size);
        else {
            RETVAL = -1;
            errno = EINVAL;
        }
+    }
 #else
        RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
 #endif
@@ -396,6 +429,39 @@ fsync(handle)
        RETVAL
 
 
+MODULE = IO    PACKAGE = IO::Socket
+
+SysRet
+sockatmark (sock)
+   InputStream sock
+   PROTOTYPE: $
+   PREINIT:
+     int fd;
+   CODE:
+   {
+     fd = PerlIO_fileno(sock);
+#ifdef HAS_SOCKATMARK
+     RETVAL = sockatmark(fd);
+#else
+     {
+       int flag = 0;
+#   ifdef SIOCATMARK
+#     if defined(NETWARE) || defined(WIN32)
+       if (ioctl(fd, SIOCATMARK, (void*)&flag) != 0)
+#     else
+       if (ioctl(fd, SIOCATMARK, &flag) != 0)
+#     endif
+        XSRETURN_UNDEF;
+#   else
+       not_here("IO::Socket::atmark");
+#   endif
+       RETVAL = flag;
+     }
+#endif
+   }
+   OUTPUT:
+     RETVAL
+
 BOOT:
 {
     HV *stash;
@@ -458,11 +524,5 @@ BOOT:
 #ifdef SEEK_END
         newCONSTSUB(stash,"SEEK_END", newSViv(SEEK_END));
 #endif
-    /*
-     * constant subs for IO
-     */
-    stash = gv_stashpvn("IO", 2, TRUE);
-#ifdef EINPROGRESS
-        newCONSTSUB(stash,"EINPROGRESS", newSViv(EINPROGRESS));
-#endif
 }
+