#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>
PerlIO *fp;
int fd;
int result;
+ bool was_fdopen = FALSE;
forkprocess = 1; /* assume true if no fork */
}
if (dodup)
fd = PerlLIO_dup(fd);
+ else
+ was_fdopen = TRUE;
if (!(fp = PerlIO_fdopen(fd,mode))) {
if (dodup)
PerlLIO_close(fd);
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;
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));
}
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));
#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;
}
#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);
/* 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;
}
else {
SV* sv = POPs;
+ char *s;
PUTBACK;
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv;
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;
}