Changes to allow compiler with gcc-2.8.1 in C++ mode,

[p5sagit/p5-mst-13.2.git] / doio.c

diff --git a/doio.c b/doio.c
index b25bb9c..d8ce25d 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -34,18 +34,24 @@
 #endif
 
 #ifdef I_UTIME
-#  ifdef _MSC_VER
+#  if defined(_MSC_VER) || defined(__MINGW32__)
 #    include <sys/utime.h>
 #  else
 #    include <utime.h>
 #  endif
 #endif
+
 #ifdef I_FCNTL
 #include <fcntl.h>
 #endif
 #ifdef I_SYS_FILE
 #include <sys/file.h>
 #endif
+#ifdef O_EXCL
+#  define OPEN_EXCL O_EXCL
+#else
+#  define OPEN_EXCL 0
+#endif
 
 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
 #include <signal.h>
@@ -86,6 +92,7 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
     PerlIO *fp;
     int fd;
     int result;
+    bool was_fdopen = FALSE;
 
     forkprocess = 1;           /* assume true if no fork */
 
@@ -215,6 +222,8 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
                    }
                    if (dodup)
                        fd = PerlLIO_dup(fd);
+                   else
+                       was_fdopen = TRUE;
                    if (!(fp = PerlIO_fdopen(fd,mode))) {
                        if (dodup)
                            PerlLIO_close(fd);
@@ -324,7 +333,8 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
            sv = *av_fetch(fdpid,fd,TRUE);
            (void)SvUPGRADE(sv, SVt_IV);
            SvIVX(sv) = pid;
-           PerlIO_close(fp);
+           if (!was_fdopen)
+               PerlIO_close(fp);
 
        }
        fp = saveifp;
@@ -381,16 +391,16 @@ nextargv(register GV *gv)
     filemode = 0;
     while (av_len(GvAV(gv)) >= 0) {
        dTHR;
-       STRLEN len;
+       STRLEN oldlen;
        sv = av_shift(GvAV(gv));
        SAVEFREESV(sv);
        sv_setsv(GvSV(gv),sv);
        SvSETMAGIC(GvSV(gv));
-       oldname = SvPVx(GvSV(gv), len);
-       if (do_open(gv,oldname,len,FALSE,0,0,Nullfp)) {
+       oldname = SvPVx(GvSV(gv), oldlen);
+       if (do_open(gv,oldname,oldlen,inplace!=0,0,0,Nullfp)) {
            if (inplace) {
                TAINT_PROPER("inplace open");
-               if (strEQ(oldname,"-")) {
+               if (oldlen == 1 && *oldname == '-') {
                    setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
                    return IoIFP(GvIOp(gv));
                }
@@ -439,7 +449,7 @@ nextargv(register GV *gv)
                    do_close(gv,FALSE);
                    (void)PerlLIO_unlink(SvPVX(sv));
                    (void)PerlLIO_rename(oldname,SvPVX(sv));
-                   do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp);
+                   do_open(gv,SvPVX(sv),SvCUR(sv),inplace!=0,0,0,Nullfp);
 #endif /* DOSISH */
 #else
                    (void)UNLINK(SvPVX(sv));
@@ -456,8 +466,8 @@ nextargv(register GV *gv)
 #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",
-                         oldname, SvPVX(sv), Strerror(errno) );
+                       warn("Can't remove %s: %s, skipping file",
+                         oldname, Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -467,10 +477,11 @@ nextargv(register GV *gv)
 #endif
                }
 
-               sv_setpvn(sv,">",1);
-               sv_catpv(sv,oldname);
+               sv_setpvn(sv,">",!inplace);
+               sv_catpvn(sv,oldname,oldlen);
                SETERRNO(0,0);          /* in case sprintf set errno */
-               if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp)) {
+               if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),inplace!=0,
+                            O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp)) {
                    warn("Can't do inplace edit on %s: %s",
                      oldname, Strerror(errno) );
                    do_close(gv,FALSE);
@@ -557,13 +568,7 @@ badexit:
 
 /* explicit renamed to avoid C++ conflict    -- kja */
 bool
-#ifndef CAN_PROTOTYPE
-do_close(gv,not_implicit)
-GV *gv;
-bool not_implicit;
-#else
 do_close(GV *gv, bool not_implicit)
-#endif /* CAN_PROTOTYPE */
 {
     bool retval;
     IO *io;
@@ -811,7 +816,7 @@ my_stat(ARGSproto)
     GV* tmpgv;
 
     if (op->op_flags & OPf_REF) {
-       EXTEND(sp,1);
+       EXTEND(SP,1);
        tmpgv = cGVOP->op_gv;
       do_fstat:
        io = GvIO(tmpgv);
@@ -834,6 +839,7 @@ my_stat(ARGSproto)
     }
     else {
        SV* sv = POPs;
+       char *s;
        PUTBACK;
        if (SvTYPE(sv) == SVt_PVGV) {
            tmpgv = (GV*)sv;
@@ -844,11 +850,12 @@ my_stat(ARGSproto)
            goto do_fstat;
        }
 
+       s = SvPV(sv, na);
        statgv = Nullgv;
-       sv_setpv(statname,SvPV(sv, na));
+       sv_setpv(statname, s);
        laststype = OP_STAT;
-       laststatval = PerlLIO_stat(SvPV(sv, na),&statcache);
-       if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
+       laststatval = PerlLIO_stat(s, &statcache);
+       if (laststatval < 0 && dowarn && strchr(s, '\n'))
            warn(warn_nl, "stat");
        return laststatval;
     }
@@ -860,7 +867,7 @@ my_lstat(ARGSproto)
     djSP;
     SV *sv;
     if (op->op_flags & OPf_REF) {
-       EXTEND(sp,1);
+       EXTEND(SP,1);
        if (cGVOP->op_gv == defgv) {
            if (laststype != OP_LSTAT)
                croak("The stat preceding -l _ wasn't an lstat");