X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=85d604bc0385ffb8a701ce43780860f3722d7cca;hb=4a9ae47ac2dbde43455079cf404946a27c7b4906;hp=e13b99a65cf20ced880edb653f8e2e0ed83f1ddb;hpb=533c011aecf9bca2c9ad025efccd7b74ad222cda;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doio.c b/doio.c
index e13b99a..85d604b 100644
--- a/doio.c
+++ b/doio.c
@@ -125,22 +125,37 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
     }
 
     if (as_raw) {
-	result = rawmode & 3;
-	IoTYPE(io) = "<>++"[result];
+#ifndef O_ACCMODE
+#define O_ACCMODE 3		/* Assume traditional implementation */
+#endif
+	switch (result = rawmode & O_ACCMODE) {
+	case O_RDONLY:
+	     IoTYPE(io) = '<';
+	     break;
+	case O_WRONLY:
+	     IoTYPE(io) = '>';
+	     break;
+	case O_RDWR:
+	default:
+	     IoTYPE(io) = '+';
+	     break;
+	}
+
 	writing = (result > 0);
 	fd = PerlLIO_open3(name, rawmode, rawperm);
+
 	if (fd == -1)
 	    fp = NULL;
 	else {
 	    char *fpmode;
-	    if (result == 0)
+	    if (result == O_RDONLY)
 		fpmode = "r";
 #ifdef O_APPEND
 	    else if (rawmode & O_APPEND)
-		fpmode = (result == 1) ? "a" : "a+";
+		fpmode = (result == O_WRONLY) ? "a" : "a+";
 #endif
 	    else
-		fpmode = (result == 1) ? "w" : "r+";
+		fpmode = (result == O_WRONLY) ? "w" : "r+";
 	    fp = PerlIO_fdopen(fd, fpmode);
 	    if (!fp)
 		PerlLIO_close(fd);
@@ -301,7 +316,7 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
 #ifdef S_IFMT
 	    !(PL_statbuf.st_mode & S_IFMT)
 #else
-	    !statbuf.st_mode
+	    !PL_statbuf.st_mode
 #endif
 	) {
 	    char tmpbuf[256];
@@ -388,7 +403,7 @@ nextargv(register GV *gv)
 #ifdef HAS_FCHMOD
 	(void)fchmod(PL_lastfd,PL_filemode);
 #else
-	(void)PerlLIO_chmod(oldname,filemode);
+	(void)PerlLIO_chmod(PL_oldname,PL_filemode);
 #endif
     }
     PL_filemode = 0;
@@ -400,7 +415,7 @@ nextargv(register GV *gv)
 	sv_setsv(GvSV(gv),sv);
 	SvSETMAGIC(GvSV(gv));
 	PL_oldname = SvPVx(GvSV(gv), oldlen);
-	if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,0,0,Nullfp)) {
+	if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,O_RDONLY,0,Nullfp)) {
 	    if (PL_inplace) {
 		TAINT_PROPER("inplace open");
 		if (oldlen == 1 && *PL_oldname == '-') {
@@ -408,8 +423,8 @@ nextargv(register GV *gv)
 		    return IoIFP(GvIOp(gv));
 		}
 #ifndef FLEXFILENAMES
-		filedev = statbuf.st_dev;
-		fileino = statbuf.st_ino;
+		filedev = PL_statbuf.st_dev;
+		fileino = PL_statbuf.st_ino;
 #endif
 		PL_filemode = PL_statbuf.st_mode;
 		fileuid = PL_statbuf.st_uid;
@@ -437,9 +452,9 @@ nextargv(register GV *gv)
 			sv_catpv(sv,PL_inplace);
 		    }
 #ifndef FLEXFILENAMES
-		    if (PerlLIO_stat(SvPVX(sv),&statbuf) >= 0
-		      && statbuf.st_dev == filedev
-		      && statbuf.st_ino == fileino
+		    if (PerlLIO_stat(SvPVX(sv),&PL_statbuf) >= 0
+		      && PL_statbuf.st_dev == filedev
+		      && PL_statbuf.st_ino == fileino
 #ifdef DJGPP
                       || (_djstat_fail_bits & _STFAIL_TRUENAME)!=0
 #endif
@@ -461,18 +476,18 @@ nextargv(register GV *gv)
 #else
 		    do_close(gv,FALSE);
 		    (void)PerlLIO_unlink(SvPVX(sv));
-		    (void)PerlLIO_rename(oldname,SvPVX(sv));
-		    do_open(gv,SvPVX(sv),SvCUR(sv),inplace!=0,0,0,Nullfp);
+		    (void)PerlLIO_rename(PL_oldname,SvPVX(sv));
+		    do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,O_RDONLY,0,Nullfp);
 #endif /* DOSISH */
 #else
 		    (void)UNLINK(SvPVX(sv));
-		    if (link(oldname,SvPVX(sv)) < 0) {
+		    if (link(PL_oldname,SvPVX(sv)) < 0) {
 			warn("Can't rename %s to %s: %s, skipping file",
-			  oldname, SvPVX(sv), Strerror(errno) );
+			  PL_oldname, SvPVX(sv), Strerror(errno) );
 			do_close(gv,FALSE);
 			continue;
 		    }
-		    (void)UNLINK(oldname);
+		    (void)UNLINK(PL_oldname);
 #endif
 		}
 		else {
@@ -493,8 +508,13 @@ nextargv(register GV *gv)
 		sv_setpvn(sv,">",!PL_inplace);
 		sv_catpvn(sv,PL_oldname,oldlen);
 		SETERRNO(0,0);		/* in case sprintf set errno */
+#ifdef VMS
+		if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
+                 O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp)) { 
+#else
 		if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
 			     O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp)) {
+#endif
 		    warn("Can't do inplace edit on %s: %s",
 		      PL_oldname, Strerror(errno) );
 		    do_close(gv,FALSE);
@@ -508,7 +528,7 @@ nextargv(register GV *gv)
 #else
 #  if !(defined(WIN32) && defined(__BORLANDC__))
 		/* Borland runtime creates a readonly file! */
-		(void)PerlLIO_chmod(oldname,filemode);
+		(void)PerlLIO_chmod(PL_oldname,PL_filemode);
 #  endif
 #endif
 		if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
@@ -516,7 +536,7 @@ nextargv(register GV *gv)
 		    (void)fchown(PL_lastfd,fileuid,filegid);
 #else
 #ifdef HAS_CHOWN
-		    (void)PerlLIO_chown(oldname,fileuid,filegid);
+		    (void)PerlLIO_chown(PL_oldname,fileuid,filegid);
 #endif
 #endif
 		}
@@ -944,7 +964,7 @@ my_lstat(ARGSproto)
 #ifdef HAS_LSTAT
     PL_laststatval = PerlLIO_lstat(SvPV(sv, PL_na),&PL_statcache);
 #else
-    laststatval = PerlLIO_stat(SvPV(sv, na),&statcache);
+    PL_laststatval = PerlLIO_stat(SvPV(sv, PL_na),&PL_statcache);
 #endif
     if (PL_laststatval < 0 && PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
 	warn(warn_nl, "lstat");
@@ -1238,7 +1258,7 @@ nothing in the core.
 #ifdef HAS_LSTAT
 		if (PerlLIO_lstat(s,&PL_statbuf) < 0 || S_ISDIR(PL_statbuf.st_mode))
 #else
-		if (PerlLIO_stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
+		if (PerlLIO_stat(s,&PL_statbuf) < 0 || S_ISDIR(PL_statbuf.st_mode))
 #endif
 		    tot--;
 		else {