else
result = PerlIO_close(IoIFP(io));
if (result == EOF && fd > PL_maxsysfd)
- PerlIO_printf(PerlIO_stderr(),
+ PerlIO_printf(Perl_error_log,
"Warning: unable to close filehandle %s properly.\n",
GvENAME(gv));
IoOFP(io) = IoIFP(io) = Nullfp;
}
if (as_raw) {
-#if defined(O_LARGEFILE)
+#if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
rawmode |= O_LARGEFILE;
#endif
if (fd == -1)
fp = NULL;
else {
- char *fpmode;
+ const char *fpmode;
if (result == O_RDONLY)
fpmode = "r";
#ifdef O_APPEND
goto say_false;
}
if (IoIFP(thatio)) {
- fd = PerlIO_fileno(IoIFP(thatio));
+ PerlIO *fp = IoIFP(thatio);
+ /* Flush stdio buffer before dup. --mjd
+ * Unfortunately SEEK_CURing 0 seems to
+ * be optimized away on most platforms;
+ * only Solaris and Linux seem to flush
+ * on that. --jhi */
+ PerlIO_seek(fp, 0, SEEK_CUR);
+ /* On the other hand, do all platforms
+ * take gracefully to flushing a read-only
+ * filehandle? Perhaps we should do
+ * fsetpos(src)+fgetpos(dst)? --nik */
+ PerlIO_flush(fp);
+ fd = PerlIO_fileno(fp);
if (IoTYPE(thatio) == 's')
IoTYPE(io) = 's';
}
}
}
if (fd != PerlIO_fileno(fp)) {
- int pid;
+ Pid_t pid;
SV *sv;
PerlLIO_dup2(PerlIO_fileno(fp), fd);
#endif
Uid_t fileuid;
Gid_t filegid;
+ IO *io = GvIOp(gv);
if (!PL_argvoutgv)
PL_argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
+ if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
+ IoFLAGS(io) &= ~IOf_START;
+ if (PL_inplace)
+ av_push(PL_argvout_stack, SvREFCNT_inc(PL_defoutgv));
+ }
if (PL_filemode & (S_ISUID|S_ISGID)) {
PerlIO_flush(IoIFP(GvIOn(PL_argvoutgv))); /* chmod must follow last write */
#ifdef HAS_FCHMOD
}
#endif
#ifdef HAS_RENAME
-#ifndef DOSISH
+#if !defined(DOSISH) && !defined(CYGWIN)
if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) {
if (ckWARN_d(WARN_INPLACE))
Perl_warner(aTHX_ WARN_INPLACE,
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)) {
+ 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)) {
+ O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp))
#endif
+ {
if (ckWARN_d(WARN_INPLACE))
Perl_warner(aTHX_ WARN_INPLACE, "Can't do inplace edit on %s: %s",
PL_oldname, Strerror(errno) );
}
}
}
+ if (io && (IoFLAGS(io) & IOf_ARGV))
+ IoFLAGS(io) |= IOf_START;
if (PL_inplace) {
(void)do_close(PL_argvoutgv,FALSE);
+ if (io && (IoFLAGS(io) & IOf_ARGV) && AvFILLp(PL_argvout_stack) >= 0) {
+ GV *oldout = (GV*)av_pop(PL_argvout_stack);
+ setdefout(oldout);
+ SvREFCNT_dec(oldout);
+ return Nullfp;
+ }
setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
}
return Nullfp;
Perl_warner(aTHX_ WARN_UNOPENED, "sysseek() on unopened file");
}
SETERRNO(EBADF,RMS$_IFI);
- return -1L;
+ return (Off_t)-1;
}
int
if (SvIOK(sv)) {
if (SvGMAGICAL(sv))
mg_get(sv);
-#ifdef IV_IS_QUAD
- if (SvIsUV(sv))
- PerlIO_printf(fp, "%" PERL_PRIu64, (UV)SvUVX(sv));
- else
- PerlIO_printf(fp, "%" PERL_PRId64, (IV)SvIVX(sv));
-#else
if (SvIsUV(sv))
- PerlIO_printf(fp, "%lu", (unsigned long)SvUVX(sv));
+ PerlIO_printf(fp, "%"UVuf, (UV)SvUVX(sv));
else
- PerlIO_printf(fp, "%ld", (long)SvIVX(sv));
-#endif
+ PerlIO_printf(fp, "%"IVdf, (IV)SvIVX(sv));
return !PerlIO_error(fp);
}
/* FALL THROUGH */
tmps = SvPV(sv, len);
break;
}
+ /* To detect whether the process is about to overstep its
+ * filesize limit we would need getrlimit(). We could then
+ * also transparently raise the limit with setrlimit() --
+ * but only until the system hard limit/the filesystem limit,
+ * at which we would get EPERM. Note that when using buffered
+ * io the write failure can be delayed until the flush/close. --jhi */
if (len && (PerlIO_write(fp,tmps,len) == 0 || PerlIO_error(fp)))
return FALSE;
return !PerlIO_error(fp);
if (PL_op->op_flags & OPf_REF) {
EXTEND(SP,1);
- tmpgv = cGVOP->op_gv;
+ tmpgv = (GV*)cSVOP->op_sv;
do_fstat:
io = GvIO(tmpgv);
if (io && IoIFP(io)) {
STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
EXTEND(SP,1);
- if (cGVOP->op_gv == PL_defgv) {
+ if ((GV*)cSVOP->op_sv == PL_defgv) {
if (PL_laststype != OP_LSTAT)
Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat");
return PL_laststatval;
Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
int fd, int do_report)
{
+#ifdef MACOS_TRADITIONAL
+ Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
+#else
register char **a;
char *tmps;
STRLEN n_a;
}
}
do_execfree();
+#endif
return FALSE;
}
}
}
-#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC)
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(MACOS_TRADITIONAL)
bool
Perl_do_exec(pTHX_ char *cmd)
/* Do the permissions allow some operation? Assumes statcache already set. */
#ifndef VMS /* VMS' cando is in vms.c */
-I32
-Perl_cando(pTHX_ I32 bit, I32 effective, register struct stat *statbufp)
+bool
+Perl_cando(pTHX_ Mode_t mode, Uid_t effective, register Stat_t *statbufp)
+/* Note: we use `effective' both for uids and gids.
+ * Here we are betting on Uid_t being equal or wider than Gid_t. */
{
#ifdef DOSISH
/* [Comments and code from Len Reed]
/* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat
* too so it will actually look into the files for magic numbers
*/
- return (bit & statbufp->st_mode) ? TRUE : FALSE;
+ return (mode & statbufp->st_mode) ? TRUE : FALSE;
#else /* ! DOSISH */
if ((effective ? PL_euid : PL_uid) == 0) { /* root is special */
- if (bit == S_IXUSR) {
+ if (mode == S_IXUSR) {
if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
return TRUE;
}
return FALSE;
}
if (statbufp->st_uid == (effective ? PL_euid : PL_uid) ) {
- if (statbufp->st_mode & bit)
+ if (statbufp->st_mode & mode)
return TRUE; /* ok as "user" */
}
- else if (ingroup((I32)statbufp->st_gid,effective)) {
- if (statbufp->st_mode & bit >> 3)
+ else if (ingroup(statbufp->st_gid,effective)) {
+ if (statbufp->st_mode & mode >> 3)
return TRUE; /* ok as "group" */
}
- else if (statbufp->st_mode & bit >> 6)
+ else if (statbufp->st_mode & mode >> 6)
return TRUE; /* ok as "other" */
return FALSE;
#endif /* ! DOSISH */
}
#endif /* ! VMS */
-I32
-Perl_ingroup(pTHX_ I32 testgid, I32 effective)
+bool
+Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective)
{
+#ifdef MACOS_TRADITIONAL
+ /* This is simply not correct for AppleShare, but fix it yerself. */
+ return TRUE;
+#else
if (testgid == (effective ? PL_egid : PL_gid))
return TRUE;
#ifdef HAS_GETGROUPS
}
#endif
return FALSE;
+#endif
}
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
else
{
IV i = SvIV(astr);
- a = (char *)i; /* ouch */
+ a = INT2PTR(char *,i); /* ouch */
}
SETERRNO(0,0);
switch (optype)