/* doio.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
namesv = sv_2mortal(newSVpv(oname,0));
num_svs = 1;
svp = &namesv;
- type = Nullch;
+ type = NULL;
fp = PerlIO_openn(aTHX_ type, mode, -1, rawmode, rawperm, NULL, num_svs, svp);
}
else {
}
else {
GV *thatgv;
- thatgv = gv_fetchpv(type,FALSE,SVt_PVIO);
+ thatgv = gv_fetchpvn_flags(type, tend - type,
+ 0, SVt_PVIO);
thatio = GvIO(thatgv);
}
if (!thatio) {
fd = -1;
}
if (!num_svs)
- type = Nullch;
+ type = NULL;
if (that_fp) {
fp = PerlIO_fdupopen(aTHX_ that_fp, NULL, dodup);
}
namesv = sv_2mortal(newSVpvn(type,tend - type));
num_svs = 1;
svp = &namesv;
- type = Nullch;
+ type = NULL;
}
fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
}
namesv = sv_2mortal(newSVpvn(type,tend - type));
num_svs = 1;
svp = &namesv;
- type = Nullch;
+ type = NULL;
}
fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
}
namesv = sv_2mortal(newSVpvn(type,tend - type));
num_svs = 1;
svp = &namesv;
- type = Nullch;
+ type = NULL;
}
fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
}
PerlIO *
Perl_nextargv(pTHX_ register GV *gv)
{
+ dVAR;
register SV *sv;
#ifndef FLEXFILENAMES
int filedev;
IO * const io = GvIOp(gv);
if (!PL_argvoutgv)
- PL_argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
+ PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
IoFLAGS(io) &= ~IOf_START;
if (PL_inplace) {
if (PL_inplace) {
TAINT_PROPER("inplace open");
if (oldlen == 1 && *PL_oldname == '-') {
- setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
+ setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL,
+ SVt_PVIO));
return IoIFP(GvIOp(gv));
}
#ifndef FLEXFILENAMES
SvREFCNT_dec(oldout);
return Nullfp;
}
- setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
+ setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO));
}
return Nullfp;
}
bool
Perl_do_close(pTHX_ GV *gv, bool not_implicit)
{
+ dVAR;
bool retval;
IO *io;
bool
Perl_io_close(pTHX_ IO *io, bool not_implicit)
{
+ dVAR;
bool retval = FALSE;
if (IoIFP(io)) {
bool
Perl_do_eof(pTHX_ GV *gv)
{
+ dVAR;
register IO * const io = GvIO(gv);
if (!io)
report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY);
while (IoIFP(io)) {
- int saverrno;
- int ch;
-
if (PerlIO_has_cntptr(IoIFP(io))) { /* (the code works without this) */
if (PerlIO_get_cnt(IoIFP(io)) > 0) /* cheat a little, since */
return FALSE; /* this is the most usual case */
}
- saverrno = errno; /* getc and ungetc can stomp on errno */
- ch = PerlIO_getc(IoIFP(io));
- if (ch != EOF) {
- (void)PerlIO_ungetc(IoIFP(io),ch);
+ {
+ /* getc and ungetc can stomp on errno */
+ const int saverrno = errno;
+ const int ch = PerlIO_getc(IoIFP(io));
+ if (ch != EOF) {
+ (void)PerlIO_ungetc(IoIFP(io),ch);
+ errno = saverrno;
+ return FALSE;
+ }
errno = saverrno;
- return FALSE;
}
- errno = saverrno;
if (PerlIO_has_cntptr(IoIFP(io)) && PerlIO_canset_cnt(IoIFP(io))) {
if (PerlIO_get_cnt(IoIFP(io)) < -1)
Off_t
Perl_do_tell(pTHX_ GV *gv)
{
- register IO *io = 0;
+ dVAR;
+ register IO *io = NULL;
register PerlIO *fp;
if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
bool
Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
{
- register IO *io = 0;
+ dVAR;
+ register IO *io = NULL;
register PerlIO *fp;
if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
Off_t
Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
{
- register IO *io = 0;
+ dVAR;
+ register IO *io = NULL;
register PerlIO *fp;
if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
bool
Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
{
+ dVAR;
register const char *tmps;
STRLEN len;
I32
Perl_my_stat(pTHX)
{
+ dVAR;
dSP;
IO *io;
GV* gv;
return PL_laststatval;
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- PL_statgv = Nullgv;
+ PL_statgv = NULL;
sv_setpvn(PL_statname,"", 0);
return (PL_laststatval = -1);
}
}
s = SvPV_const(sv, len);
- PL_statgv = Nullgv;
+ PL_statgv = NULL;
sv_setpvn(PL_statname, s, len);
s = SvPVX_const(PL_statname); /* s now NUL-terminated */
PL_laststype = OP_STAT;
I32
Perl_my_lstat(pTHX)
{
+ dVAR;
static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
dSP;
SV *sv;
Perl_croak(aTHX_ no_prev_lstat);
PL_laststype = OP_LSTAT;
- PL_statgv = Nullgv;
+ PL_statgv = NULL;
sv = POPs;
PUTBACK;
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV && ckWARN(WARN_IO)) {
#else
if (sp > mark) {
char **a;
- const char *tmps = Nullch;
+ const char *tmps = NULL;
Newx(PL_Argv, sp - mark + 1, char*);
a = PL_Argv;
else
*a++ = "";
}
- *a = Nullch;
+ *a = NULL;
if (really)
tmps = SvPV_nolen_const(really);
if ((!really && *PL_Argv[0] != '/') ||
Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
(really ? tmps : PL_Argv[0]), Strerror(errno));
if (do_report) {
- int e = errno;
+ const int e = errno;
PerlLIO_write(fd, (void*)&e, sizeof(int));
PerlLIO_close(fd);
void
Perl_do_execfree(pTHX)
{
+ dVAR;
Safefree(PL_Argv);
PL_Argv = Null(char **);
Safefree(PL_Cmd);
- PL_Cmd = Nullch;
+ PL_Cmd = NULL;
}
#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
if (*s)
*s++ = '\0';
}
- *a = Nullch;
+ *a = NULL;
if (PL_Argv[0]) {
PERL_FPU_PRE_EXEC
PerlProc_execvp(PL_Argv[0],PL_Argv);
do_execfree();
goto doshell;
}
- {
- if (ckWARN(WARN_EXEC))
- Perl_warner(aTHX_ packWARN(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);
- }
+ if (ckWARN(WARN_EXEC))
+ Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
+ PL_Argv[0], Strerror(errno));
+ if (do_report) {
+ const int e = errno;
+ PerlLIO_write(fd, (const void*)&e, sizeof(int));
+ PerlLIO_close(fd);
}
}
do_execfree();
I32
Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
{
+ dVAR;
register I32 val;
register I32 tot = 0;
- const char *what;
+ const char *const what = PL_op_name[type];
const char *s;
SV ** const oldmark = mark;
platforms where kill was not defined. */
#ifndef HAS_KILL
if (type == OP_KILL)
- Perl_die(aTHX_ PL_no_func, "kill");
+ Perl_die(aTHX_ PL_no_func, what);
#endif
#ifndef HAS_CHOWN
if (type == OP_CHOWN)
- Perl_die(aTHX_ PL_no_func, "chown");
+ Perl_die(aTHX_ PL_no_func, what);
#endif
}
switch (type) {
case OP_CHMOD:
- what = "chmod";
APPLY_TAINT_PROPER();
if (++mark <= sp) {
val = SvIVx(*mark);
break;
#ifdef HAS_CHOWN
case OP_CHOWN:
- what = "chown";
APPLY_TAINT_PROPER();
if (sp - mark > 2) {
register I32 val2;
*/
#ifdef HAS_KILL
case OP_KILL:
- what = "kill";
APPLY_TAINT_PROPER();
if (mark == sp)
break;
break;
#endif
case OP_UNLINK:
- what = "unlink";
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
break;
#if defined(HAS_UTIME) || defined(HAS_FUTIMES)
case OP_UTIME:
- what = "utime";
APPLY_TAINT_PROPER();
if (sp - mark > 2) {
#if defined(HAS_FUTIMES)
* is in the list of groups returned from getgroups().
*/
{
+ dVAR;
#ifdef DOSISH
/* [Comments and code from Len Reed]
* MS-DOS "user" is similar to UNIX's "superuser," but can't write
/* This is simply not correct for AppleShare, but fix it yerself. */
return TRUE;
#else
+ dVAR;
if (testgid == (effective ? PL_egid : PL_gid))
return TRUE;
#ifdef HAS_GETGROUPS
-#ifndef NGROUPS
-#define NGROUPS 32
-#endif
{
- Groups_t gary[NGROUPS];
+ Groups_t *gary = NULL;
I32 anum;
+ bool rc = FALSE;
- anum = getgroups(NGROUPS,gary);
+ anum = getgroups(0, gary);
+ Newx(gary, anum, Groups_t);
+ anum = getgroups(anum, gary);
while (--anum >= 0)
- if (gary[anum] == testgid)
- return TRUE;
+ if (gary[anum] == testgid) {
+ rc = TRUE;
+ break;
+ }
+
+ Safefree(gary);
+ return rc;
}
-#endif
+#else
return FALSE;
#endif
+#endif
}
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
I32
Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
{
+ dVAR;
const key_t key = (key_t)SvNVx(*++mark);
const I32 n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
const I32 flags = SvIVx(*++mark);
I32
Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
{
+ dVAR;
char *a;
I32 ret = -1;
const I32 id = SvIVx(*++mark);
I32
Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
{
+ dVAR;
#ifdef HAS_MSG
STRLEN len;
const I32 id = SvIVx(*++mark);
Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
{
#ifdef HAS_MSG
+ dVAR;
char *mbuf;
long mtype;
I32 msize, flags, ret;
Perl_do_semop(pTHX_ SV **mark, SV **sp)
{
#ifdef HAS_SEM
+ dVAR;
STRLEN opsize;
const I32 id = SvIVx(*++mark);
SV * const opstr = *++mark;
Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
{
#ifdef HAS_SHM
+ dVAR;
char *shm;
struct shmid_ds shmds;
const I32 id = SvIVx(*++mark);
Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
{
dVAR;
- SV * const tmpcmd = NEWSV(55, 0);
+ SV * const tmpcmd = newSV(0);
PerlIO *fp;
ENTER;
SAVEFREESV(tmpcmd);