X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=0d5742526957a08e40992bd3674db6237343baf8;hb=a9581ec21a2686ca09657757555fcd66435bb205;hp=69cc891fb8b73c024ff1057ea7661b73cf975ed3;hpb=36477c247f3c188fb8cc7e276c87b739d3e6ab7c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doio.c b/doio.c
index 69cc891..0d57425 100644
--- a/doio.c
+++ b/doio.c
@@ -1,6 +1,6 @@
 /*    doio.c
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -34,7 +34,11 @@
 #endif
 
 #ifdef I_UTIME
-#include <utime.h>
+#  ifdef WIN32
+#    include <sys/utime.h>
+#  else
+#    include <utime.h>
+#  endif
 #endif
 #ifdef I_FCNTL
 #include <fcntl.h>
@@ -62,6 +66,15 @@
 # endif
 #endif
 
+/* Put this after #includes because <unistd.h> defines _XOPEN_*. */
+#ifndef Sock_size_t
+#  if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__)
+#    define Sock_size_t Size_t
+#  else
+#    define Sock_size_t int
+#  endif
+#endif
+
 bool
 do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
 GV *gv;
@@ -118,9 +131,16 @@ PerlIO *supplied_fp;
 	if (fd == -1)
 	    fp = NULL;
 	else {
-	    fp = PerlIO_fdopen(fd, ((result == 0) ? "r"
-			     : (result == 1) ? "w"
-			     : "r+"));
+	    char *fpmode;
+	    if (result == 0)
+		fpmode = "r";
+#ifdef O_APPEND
+	    else if (rawmode & O_APPEND)
+		fpmode = (result == 1) ? "a" : "a+";
+#endif
+	    else
+		fpmode = (result == 1) ? "w" : "r+";
+	    fp = PerlIO_fdopen(fd, fpmode);
 	    if (!fp)
 		close(fd);
 	}
@@ -277,9 +297,10 @@ PerlIO *supplied_fp;
 	    !statbuf.st_mode
 #endif
 	) {
-	    int buflen = sizeof tokenbuf;
-	    if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
-		|| errno != ENOTSOCK)
+	    Sock_size_t buflen = sizeof tokenbuf;
+	    if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf,
+			    &buflen) >= 0
+		  || errno != ENOTSOCK)
 		IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
 				/* but some return 0 for streams too, sigh */
 	}
@@ -431,7 +452,7 @@ register GV *gv;
 #endif
 		}
 		else {
-#ifndef DOSISH
+#if !defined(DOSISH) && !defined(AMIGAOS)
 #  ifndef VMS  /* Don't delete; use automatic file versioning */
 		    if (UNLINK(oldname) < 0) {
 			warn("Can't rename %s to %s: %s, skipping file",
@@ -577,8 +598,8 @@ IO* io;
     if (IoIFP(io)) {
 	if (IoTYPE(io) == '|') {
 	    status = my_pclose(IoIFP(io));
-	    retval = (status == 0);
-	    statusvalue = FIXSTATUS(status);
+	    STATUS_NATIVE_SET(status);
+	    retval = (STATUS_POSIX == 0);
 	}
 	else if (IoTYPE(io) == '-')
 	    retval = TRUE;
@@ -639,22 +660,15 @@ do_tell(gv)
 GV *gv;
 {
     register IO *io;
+    register PerlIO *fp;
 
-    if (!gv)
-	goto phooey;
-
-    io = GvIO(gv);
-    if (!io || !IoIFP(io))
-	goto phooey;
-
+    if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
 #ifdef ULTRIX_STDIO_BOTCH
-    if (PerlIO_eof(IoIFP(io)))
-	(void)PerlIO_seek (IoIFP(io), 0L, 2);		/* ultrix 1.2 workaround */
+	if (PerlIO_eof(fp))
+	    (void)PerlIO_seek(fp, 0L, 2);	/* ultrix 1.2 workaround */
 #endif
-
-    return PerlIO_tell(IoIFP(io));
-
-phooey:
+	return PerlIO_tell(fp);
+    }
     if (dowarn)
 	warn("tell() on unopened file");
     SETERRNO(EBADF,RMS$_IFI);
@@ -668,28 +682,38 @@ long pos;
 int whence;
 {
     register IO *io;
+    register PerlIO *fp;
 
-    if (!gv)
-	goto nuts;
-
-    io = GvIO(gv);
-    if (!io || !IoIFP(io))
-	goto nuts;
-
+    if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
 #ifdef ULTRIX_STDIO_BOTCH
-    if (PerlIO_eof(IoIFP(io)))
-	(void)PerlIO_seek (IoIFP(io), 0L, 2);		/* ultrix 1.2 workaround */
+	if (PerlIO_eof(fp))
+	    (void)PerlIO_seek(fp, 0L, 2);	/* ultrix 1.2 workaround */
 #endif
-
-    return PerlIO_seek(IoIFP(io), pos, whence) >= 0;
-
-nuts:
+	return PerlIO_seek(fp, pos, whence) >= 0;
+    }
     if (dowarn)
 	warn("seek() on unopened file");
     SETERRNO(EBADF,RMS$_IFI);
     return FALSE;
 }
 
+long
+do_sysseek(gv, pos, whence)
+GV *gv;
+long pos;
+int whence;
+{
+    register IO *io;
+    register PerlIO *fp;
+
+    if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
+	return lseek(PerlIO_fileno(fp), pos, whence);
+    if (dowarn)
+	warn("sysseek() on unopened file");
+    SETERRNO(EBADF,RMS$_IFI);
+    return -1L;
+}
+
 #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
 	/* code courtesy of William Kucharski */
 #define HAS_CHSIZE
@@ -1363,13 +1387,13 @@ SV **sp;
 	{
 	    a = SvPV(astr, len);
 	    if (len != infosize)
-		croak("Bad arg length for %s, is %d, should be %d",
-			op_desc[optype], len, infosize);
+		croak("Bad arg length for %s, is %lu, should be %ld",
+			op_desc[optype], (unsigned long)len, (long)infosize);
 	}
     }
     else
     {
-	I32 i = SvIV(astr);
+	IV i = SvIV(astr);
 	a = (char *)i;		/* ouch */
     }
     SETERRNO(0,0);