move DProf things around to where they are supposed to be

[perl5.git] / doio.c

diff --git a/doio.c b/doio.c
index f6eb798..d55acb1 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -460,8 +460,10 @@ Perl_nextargv(pTHX_ register GV *gv)
                fileuid = PL_statbuf.st_uid;
                filegid = PL_statbuf.st_gid;
                if (!S_ISREG(PL_filemode)) {
-                   Perl_warn(aTHX_ "Can't do inplace edit: %s is not a regular file",
-                     PL_oldname );
+                   if (ckWARN_d(WARN_INPLACE)) 
+                       Perl_warner(aTHX_ WARN_INPLACE,
+                           "Can't do inplace edit: %s is not a regular file",
+                           PL_oldname );
                    do_close(gv,FALSE);
                    continue;
                }
@@ -488,9 +490,12 @@ Perl_nextargv(pTHX_ register GV *gv)
 #ifdef DJGPP
                       || (_djstat_fail_bits & _STFAIL_TRUENAME)!=0
 #endif
-                      ) {
-                       Perl_warn(aTHX_ "Can't do inplace edit: %s would not be unique",
-                         SvPVX(sv) );
+                      )
+                   {
+                       if (ckWARN_d(WARN_INPLACE))     
+                           Perl_warner(aTHX_ WARN_INPLACE,
+                             "Can't do inplace edit: %s would not be unique",
+                             SvPVX(sv));
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -498,8 +503,10 @@ Perl_nextargv(pTHX_ register GV *gv)
 #ifdef HAS_RENAME
 #ifndef DOSISH
                    if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) {
-                       Perl_warn(aTHX_ "Can't rename %s to %s: %s, skipping file",
-                         PL_oldname, SvPVX(sv), Strerror(errno) );
+                       if (ckWARN_d(WARN_INPLACE))     
+                           Perl_warner(aTHX_ WARN_INPLACE, 
+                             "Can't rename %s to %s: %s, skipping file",
+                             PL_oldname, SvPVX(sv), Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -512,8 +519,10 @@ Perl_nextargv(pTHX_ register GV *gv)
 #else
                    (void)UNLINK(SvPVX(sv));
                    if (link(PL_oldname,SvPVX(sv)) < 0) {
-                       Perl_warn(aTHX_ "Can't rename %s to %s: %s, skipping file",
-                         PL_oldname, SvPVX(sv), Strerror(errno) );
+                       if (ckWARN_d(WARN_INPLACE))     
+                           Perl_warner(aTHX_ WARN_INPLACE,
+                             "Can't rename %s to %s: %s, skipping file",
+                             PL_oldname, SvPVX(sv), Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -524,8 +533,10 @@ Perl_nextargv(pTHX_ register GV *gv)
 #if !defined(DOSISH) && !defined(AMIGAOS)
 #  ifndef VMS  /* Don't delete; use automatic file versioning */
                    if (UNLINK(PL_oldname) < 0) {
-                       Perl_warn(aTHX_ "Can't remove %s: %s, skipping file",
-                         PL_oldname, Strerror(errno) );
+                       if (ckWARN_d(WARN_INPLACE))     
+                           Perl_warner(aTHX_ WARN_INPLACE,
+                             "Can't remove %s: %s, skipping file",
+                             PL_oldname, Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -545,8 +556,9 @@ Perl_nextargv(pTHX_ register GV *gv)
                if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
                             O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp)) {
 #endif
-                   Perl_warn(aTHX_ "Can't do inplace edit on %s: %s",
-                     PL_oldname, Strerror(errno) );
+                   if (ckWARN_d(WARN_INPLACE)) 
+                       Perl_warner(aTHX_ WARN_INPLACE, "Can't do inplace edit on %s: %s",
+                         PL_oldname, Strerror(errno) );
                    do_close(gv,FALSE);
                    continue;
                }
@@ -573,9 +585,18 @@ Perl_nextargv(pTHX_ register GV *gv)
            }
            return IoIFP(GvIOp(gv));
        }
-       else
-           PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",
-             SvPV(sv, oldlen), Strerror(errno));
+       else {
+           dTHR;
+           if (ckWARN_d(WARN_INPLACE)) {
+               if (!S_ISREG(PL_statbuf.st_mode))       
+                   Perl_warner(aTHX_ WARN_INPLACE,
+                               "Can't do inplace edit: %s is not a regular file",
+                               PL_oldname );
+               else
+                   Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s\n",
+                               PL_oldname, Strerror(errno));
+           }
+       }
     }
     if (PL_inplace) {
        (void)do_close(PL_argvoutgv,FALSE);
@@ -1028,6 +1049,13 @@ Perl_my_lstat(pTHX)
 bool
 Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
 {
+    return do_aexec5(really, mark, sp, 0, 0);
+}
+
+bool
+Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
+              int fd, int do_report)
+{
     register char **a;
     char *tmps;
     STRLEN n_a;
@@ -1052,6 +1080,12 @@ Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
        if (ckWARN(WARN_EXEC))
            Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s", 
                PL_Argv[0], Strerror(errno));
+       if (do_report) {
+           int e = errno;
+
+           PerlLIO_write(fd, (void*)&e, sizeof(int));
+           PerlLIO_close(fd);
+       }
     }
     do_execfree();
     return FALSE;