X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FIO%2FIO.xs;h=8bdc13312623b65da44a52c9961b424948508579;hb=f4db54055cd36d83622f77949fd6ab7c67198101;hp=4a93c0319234cd026e97d80b969030969d226f79;hpb=af66385903edd5f9eaeeae68399b75c770de2f43;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs
index 4a93c03..8bdc133 100644
--- a/ext/IO/IO.xs
+++ b/ext/IO/IO.xs
@@ -17,6 +17,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;
@@ -59,9 +65,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 +92,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 +109,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 +142,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 +170,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 +194,7 @@ fsetpos(handle, pos)
 
 MODULE = IO	PACKAGE = IO::File	PREFIX = f
 
-SV *
+void
 new_tmpfile(packname = "IO::File")
     char *		packname
     PREINIT:
@@ -202,7 +220,7 @@ new_tmpfile(packname = "IO::File")
 
 MODULE = IO	PACKAGE = IO::Poll
 
-void   
+void
 _poll(timeout,...)
 	int timeout;
 PPCODE:
@@ -250,7 +268,6 @@ CODE:
 
 MODULE = IO	PACKAGE = IO::Handle	PREFIX = f
 
-
 int
 ungetc(handle, c)
 	InputStream	handle
@@ -396,6 +413,35 @@ 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 (ioctl(fd, SIOCATMARK, &flag) != 0)
+	 XSRETURN_UNDEF;
+#   else
+       not_here("IO::Socket::atmark");
+#   endif
+       RETVAL = flag;
+     }
+#endif
+   }
+   OUTPUT:
+     RETVAL
+
 BOOT:
 {
     HV *stash;
@@ -458,8 +504,5 @@ BOOT:
 #ifdef SEEK_END
         newCONSTSUB(stash,"SEEK_END", newSViv(SEEK_END));
 #endif
-    /*
-     * constant subs for IO
-     */
-    stash = gv_stashpvn("IO", 2, TRUE);
 }
+