/* 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.
}
else {
GV *thatgv;
- thatgv = gv_fetchpv(type,FALSE,SVt_PVIO);
+ thatgv = gv_fetchpv(type,0,SVt_PVIO);
thatio = GvIO(thatgv);
}
if (!thatio) {
PerlIO *
Perl_nextargv(pTHX_ register GV *gv)
{
+ dVAR;
register SV *sv;
#ifndef FLEXFILENAMES
int filedev;
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;
I32
Perl_my_lstat(pTHX)
{
+ dVAR;
static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
dSP;
SV *sv;
#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);
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 *const what = PL_op_name[type];
* 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);
projects / p5sagit/p5-mst-13.2.git / blobdiff