result = 0;
}
else if (IoTYPE(io) == '|')
- result = my_pclose(IoIFP(io));
+ result = PerlProc_pclose(IoIFP(io));
else if (IoIFP(io) != IoOFP(io)) {
if (IoOFP(io)) {
result = PerlIO_close(IoOFP(io));
result = rawmode & 3;
IoTYPE(io) = "<>++"[result];
writing = (result > 0);
- fd = open(name, rawmode, rawperm);
+ fd = PerlLIO_open3(name, rawmode, rawperm);
if (fd == -1)
fp = NULL;
else {
fpmode = (result == 1) ? "w" : "r+";
fp = PerlIO_fdopen(fd, fpmode);
if (!fp)
- close(fd);
+ PerlLIO_close(fd);
}
}
else {
TAINT_PROPER("piped open");
if (dowarn && name[strlen(name)-1] == '|')
warn("Can't do bidirectional pipe");
- fp = my_popen(name,"w");
+ fp = PerlProc_popen(name,"w");
writing = 1;
}
else if (*name == '>') {
fd = -1;
}
if (dodup)
- fd = dup(fd);
+ fd = PerlLIO_dup(fd);
if (!(fp = PerlIO_fdopen(fd,mode))) {
if (dodup)
- close(fd);
+ PerlLIO_close(fd);
}
}
}
if (strNE(name,"-"))
TAINT_ENV();
TAINT_PROPER("piped open");
- fp = my_popen(name,"r");
+ fp = PerlProc_popen(name,"r");
IoTYPE(io) = '|';
}
else {
if (IoTYPE(io) &&
IoTYPE(io) != '|' && IoTYPE(io) != '-') {
dTHR;
- if (Fstat(PerlIO_fileno(fp),&statbuf) < 0) {
+ if (PerlLIO_fstat(PerlIO_fileno(fp),&statbuf) < 0) {
(void)PerlIO_close(fp);
goto say_false;
}
) {
char tmpbuf[256];
Sock_size_t buflen = sizeof tmpbuf;
- if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tmpbuf,
+ if (PerlSock_getsockname(PerlIO_fileno(fp), (struct sockaddr *)tmpbuf,
&buflen) >= 0
|| errno != ENOTSOCK)
IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
int pid;
SV *sv;
- dup2(PerlIO_fileno(fp), fd);
+ PerlLIO_dup2(PerlIO_fileno(fp), fd);
sv = *av_fetch(fdpid,PerlIO_fileno(fp),TRUE);
(void)SvUPGRADE(sv, SVt_IV);
pid = SvIVX(sv);
#ifdef HAS_FCHMOD
(void)fchmod(lastfd,filemode);
#else
- (void)chmod(oldname,filemode);
+ (void)PerlLIO_chmod(oldname,filemode);
#endif
}
filemode = 0;
sv_catpv(sv,inplace);
#endif
#ifndef FLEXFILENAMES
- if (Stat(SvPVX(sv),&statbuf) >= 0
+ if (PerlLIO_stat(SvPVX(sv),&statbuf) >= 0
&& statbuf.st_dev == filedev
&& statbuf.st_ino == fileino
#ifdef DJGPP
#endif
#ifdef HAS_RENAME
#ifndef DOSISH
- if (rename(oldname,SvPVX(sv)) < 0) {
+ if (PerlLIO_rename(oldname,SvPVX(sv)) < 0) {
warn("Can't rename %s to %s: %s, skipping file",
oldname, SvPVX(sv), Strerror(errno) );
do_close(gv,FALSE);
}
#else
do_close(gv,FALSE);
- (void)unlink(SvPVX(sv));
- (void)rename(oldname,SvPVX(sv));
+ (void)PerlLIO_unlink(SvPVX(sv));
+ (void)PerlLIO_rename(oldname,SvPVX(sv));
do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp);
#endif /* DOSISH */
#else
}
setdefout(argvoutgv);
lastfd = PerlIO_fileno(IoIFP(GvIOp(argvoutgv)));
- (void)Fstat(lastfd,&statbuf);
+ (void)PerlLIO_fstat(lastfd,&statbuf);
#ifdef HAS_FCHMOD
(void)fchmod(lastfd,filemode);
#else
# if !(defined(WIN32) && defined(__BORLANDC__))
/* Borland runtime creates a readonly file! */
- (void)chmod(oldname,filemode);
+ (void)PerlLIO_chmod(oldname,filemode);
# endif
#endif
if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
if (IoIFP(wstio))
do_close(wgv,FALSE);
- if (pipe(fd) < 0)
+ if (PerlProc_pipe(fd) < 0)
goto badexit;
IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
IoTYPE(wstio) = '>';
if (!IoIFP(rstio) || !IoOFP(wstio)) {
if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
- else close(fd[0]);
+ else PerlLIO_close(fd[0]);
if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
- else close(fd[1]);
+ else PerlLIO_close(fd[1]);
goto badexit;
}
if (IoIFP(io)) {
if (IoTYPE(io) == '|') {
- status = my_pclose(IoIFP(io));
+ status = PerlProc_pclose(IoIFP(io));
STATUS_NATIVE_SET(status);
retval = (STATUS_POSIX == 0);
}
register PerlIO *fp;
if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
- return lseek(PerlIO_fileno(fp), pos, whence);
+ return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
if (dowarn)
warn("sysseek() on unopened file");
SETERRNO(EBADF,RMS$_IFI);
struct flock fl;
struct stat filebuf;
- if (Fstat(fd, &filebuf) < 0)
+ if (PerlLIO_fstat(fd, &filebuf) < 0)
return -1;
if (filebuf.st_size < length) {
/* extend file length */
- if ((lseek(fd, (length - 1), 0)) < 0)
+ if ((PerlLIO_lseek(fd, (length - 1), 0)) < 0)
return -1;
/* write a "0" byte */
- if ((write(fd, "", 1)) != 1)
+ if ((PerlLIO_write(fd, "", 1)) != 1)
return -1;
}
else {
statgv = tmpgv;
sv_setpv(statname,"");
laststype = OP_STAT;
- return (laststatval = Fstat(PerlIO_fileno(IoIFP(io)), &statcache));
+ return (laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &statcache));
}
else {
if (tmpgv == defgv)
statgv = Nullgv;
sv_setpv(statname,SvPV(sv, na));
laststype = OP_STAT;
- laststatval = Stat(SvPV(sv, na),&statcache);
+ laststatval = PerlLIO_stat(SvPV(sv, na),&statcache);
if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
warn(warn_nl, "stat");
return laststatval;
PUTBACK;
sv_setpv(statname,SvPV(sv, na));
#ifdef HAS_LSTAT
- laststatval = lstat(SvPV(sv, na),&statcache);
+ laststatval = PerlLIO_lstat(SvPV(sv, na),&statcache);
#else
- laststatval = Stat(SvPV(sv, na),&statcache);
+ laststatval = PerlLIO_stat(SvPV(sv, na),&statcache);
#endif
if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
warn(warn_nl, "lstat");
if (*Argv[0] != '/') /* will execvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
if (really && *(tmps = SvPV(really, na)))
- execvp(tmps,Argv);
+ PerlProc_execvp(tmps,Argv);
else
- execvp(Argv[0],Argv);
+ PerlProc_execvp(Argv[0],Argv);
if (dowarn)
warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
}
*--s = '\0';
if (s[-1] == '\'') {
*--s = '\0';
- execl(cshname,"csh", flags,ncmd,(char*)0);
+ PerlProc_execl(cshname,"csh", flags,ncmd,(char*)0);
*s = '\'';
return FALSE;
}
break;
}
doshell:
- execl(sh_path, "sh", "-c", cmd, (char*)0);
+ PerlProc_execl(sh_path, "sh", "-c", cmd, (char*)0);
return FALSE;
}
}
}
*a = Nullch;
if (Argv[0]) {
- execvp(Argv[0],Argv);
+ PerlProc_execvp(Argv[0],Argv);
if (errno == ENOEXEC) { /* for system V NIH syndrome */
do_execfree();
goto doshell;
tot = sp - mark;
val = SvIVx(*mark);
while (++mark <= sp) {
- if (chmod(SvPVx(*mark, na),val))
+ if (PerlLIO_chmod(SvPVx(*mark, na),val))
tot--;
}
}
while (++mark <= sp) {
I32 proc = SvIVx(*mark);
#ifdef HAS_KILLPG
- if (killpg(proc,val)) /* BSD */
+ if (PerlProc_killpg(proc,val)) /* BSD */
#else
- if (kill(-proc,val)) /* SYSV */
+ if (PerlProc_kill(-proc,val)) /* SYSV */
#endif
tot--;
}
}
else {
while (++mark <= sp) {
- if (kill(SvIVx(*mark),val))
+ if (PerlProc_kill(SvIVx(*mark),val))
tot--;
}
}
}
else { /* don't let root wipe out directories without -U */
#ifdef HAS_LSTAT
- if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
+ if (PerlLIO_lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
#else
- if (Stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
+ if (PerlLIO_stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
#endif
tot--;
else {
#endif
tot = sp - mark;
while (++mark <= sp) {
- if (utime(SvPVx(*mark, na),&utbuf))
+ if (PerlLIO_utime(SvPVx(*mark, na),&utbuf))
tot--;
}
}
botch(char *s)
{
PerlIO_printf(PerlIO_stderr(), "assertion botched: %s\n", s);
- abort();
+ PerlProc_abort();
}
#else
#define ASSERT(p)
if (OV_MAGIC(ovp, bucket) != MAGIC) {
static int bad_free_warn = -1;
if (bad_free_warn == -1) {
- char *pbf = getenv("PERL_BADFREE");
+ char *pbf = PerlENV_getenv("PERL_BADFREE");
bad_free_warn = (pbf) ? atoi(pbf) : 1;
}
if (!bad_free_warn)
static void
catch_sigsegv(int signo, struct sigcontext_struct sc)
{
- signal(SIGSEGV, SIG_DFL);
+ PerlProc_signal(SIGSEGV, SIG_DFL);
fprintf(stderr, "Segmentation fault dereferencing 0x%lx\n"
"return_address = 0x%lx, eip = 0x%lx\n",
sc.cr2, __builtin_return_address(0), sc.eip);
#ifdef DEBUGGING
{
char *s;
- if (s = getenv("PERL_DESTRUCT_LEVEL")) {
+ if (s = PerlENV_getenv("PERL_DESTRUCT_LEVEL")) {
int i = atoi(s);
if (destruct_level < i)
destruct_level = i;
croak("No -e allowed in setuid scripts");
if (!e_fp) {
e_tmpname = savepv(TMPPATH);
- (void)mktemp(e_tmpname);
+ (void)PerlLIO_mktemp(e_tmpname);
if (!*e_tmpname)
croak("Can't mktemp()");
e_fp = PerlIO_open(e_tmpname,"w");
}
switch_end:
- if (!tainting && (s = getenv("PERL5OPT"))) {
+ if (!tainting && (s = PerlENV_getenv("PERL5OPT"))) {
while (s && *s) {
while (isSPACE(*s))
s++;
}
else if (scriptname == Nullch) {
#ifdef MSDOS
- if ( isatty(PerlIO_fileno(PerlIO_stdin())) )
+ if ( PerlLIO_isatty(PerlIO_fileno(PerlIO_stdin())) )
moreswitches("h");
#endif
scriptname = "-";
#endif
#if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__)
- DEBUG_L(signal(SIGSEGV, (void(*)(int))catch_sigsegv););
+ DEBUG_L(PerlProc_signal(SIGSEGV, (void(*)(int))catch_sigsegv););
#endif
init_predump_symbols();
FREETMPS;
#ifdef MYMALLOC
- if ((s=getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
+ if ((s=PerlENV_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
dump_mstats("after compilation:");
#endif
if (endav)
call_list(oldscope, endav);
#ifdef MYMALLOC
- if (getenv("PERL_DEBUG_MSTATS"))
+ if (PerlENV_getenv("PERL_DEBUG_MSTATS"))
dump_mstats("after execution: ");
#endif
JMPENV_POP;
return s;
case 'h':
usage(origargv[0]);
- exit(0);
+ PerlProc_exit(0);
case 'i':
if (inplace)
Safefree(inplace);
printf("\n\
Perl may be copied only under the terms of either the Artistic License or the\n\
GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n");
- exit(0);
+ PerlProc_exit(0);
case 'w':
dowarn = TRUE;
s++;
if (status)
PerlIO_printf(PerlIO_stderr(), "unexec of %s into %s failed!\n",
SvPVX(prog), SvPVX(file));
- exit(status);
+ PerlProc_exit(status);
#else
# ifdef VMS
# include <lib$routines.h>
#ifdef DOSISH
&& !strchr(scriptname, '\\')
#endif
- && (s = getenv("PATH"))) {
+ && (s = PerlENV_getenv("PATH"))) {
bool seen_dot = 0;
bufend = s + strlen(s);
croak("Can't do seteuid!\n");
}
#endif /* IAMSUID */
- rsfp = my_popen(SvPVX(cmd), "r");
+ rsfp = PerlProc_popen(SvPVX(cmd), "r");
SvREFCNT_dec(cmd);
SvREFCNT_dec(cpp);
}
if (euid && Stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 &&
statbuf.st_mode & (S_ISUID|S_ISGID)) {
/* try again */
- execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
+ PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
croak("Can't do setuid\n");
}
#endif
dTHR;
char *s, *s2;
- if (Fstat(PerlIO_fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */
+ if (PerlLIO_fstat(PerlIO_fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */
croak("Can't stat script \"%s\"",origfilename);
if (fdscript < 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) {
I32 len;
* But I don't think it's too important. The manual lies when
* it says access() is useful in setuid programs.
*/
- if (access(SvPVX(GvSV(curcop->cop_filegv)),1)) /*double check*/
+ if (PerlLIO_access(SvPVX(GvSV(curcop->cop_filegv)),1)) /*double check*/
croak("Permission denied");
#else
/* If we can swap euid and uid, then we can determine access rights
if (tmpstatbuf.st_dev != statbuf.st_dev ||
tmpstatbuf.st_ino != statbuf.st_ino) {
(void)PerlIO_close(rsfp);
- if (rsfp = my_popen("/bin/mail root","w")) { /* heh, heh */
+ if (rsfp = PerlProc_popen("/bin/mail root","w")) { /* heh, heh */
PerlIO_printf(rsfp,
"User %ld tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\
(Filename of set-id script was %s, uid %ld gid %ld.)\n\nSincerely,\nperl\n",
(long)statbuf.st_dev, (long)statbuf.st_ino,
SvPVX(GvSV(curcop->cop_filegv)),
(long)statbuf.st_uid, (long)statbuf.st_gid);
- (void)my_pclose(rsfp);
+ (void)PerlProc_pclose(rsfp);
}
croak("Permission denied\n");
}
(void)PerlIO_close(rsfp);
#ifndef IAMSUID
/* try again */
- execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
+ PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
#endif
croak("Can't do setuid\n");
}
/* exec the real perl, substituting fd script for scriptname. */
/* (We pass script name as "subdir" of fd, which perl will grok.) */
PerlIO_rewind(rsfp);
- lseek(PerlIO_fileno(rsfp),(Off_t)0,0); /* just in case rewind didn't */
+ PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0); /* just in case rewind didn't */
for (which = 1; origargv[which] && origargv[which] != scriptname; which++) ;
if (!origargv[which])
croak("Permission denied");
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(PerlIO_fileno(rsfp),F_SETFD,0); /* ensure no close-on-exec */
#endif
- execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv); /* try again */
+ PerlProc_execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv); /* try again */
croak("Can't do setuid\n");
#endif /* IAMSUID */
#else /* !DOSUID */
if (euid != uid || egid != gid) { /* (suidperl doesn't exist, in fact) */
#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
dTHR;
- Fstat(PerlIO_fileno(rsfp),&statbuf); /* may be either wrapped or real suid */
+ PerlLIO_fstat(PerlIO_fileno(rsfp),&statbuf); /* may be either wrapped or real suid */
if ((euid != uid && euid == statbuf.st_uid && statbuf.st_mode & S_ISUID)
||
(egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID)
/*SUPPRESS 530*/
while (s = moreswitches(s)) ;
}
- if (cddir && chdir(cddir) < 0)
+ if (cddir && PerlDir_chdir(cddir) < 0)
croak("Can't chdir to %s",cddir);
}
}
*s = '=';
#if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV)
/* Sins of the RTL. See note in my_setenv(). */
- (void)putenv(savepv(*env));
+ (void)PerlENV_putenv(savepv(*env));
#endif
}
#endif
char *s;
if (!tainting) {
#ifndef VMS
- s = getenv("PERL5LIB");
+ s = PerlENV_getenv("PERL5LIB");
if (s)
incpush(s, TRUE);
else
- incpush(getenv("PERLLIB"), FALSE);
+ incpush(PerlENV_getenv("PERLLIB"), FALSE);
#else /* VMS */
/* Treat PERL5?LIB as a possible search list logical name -- the
* "natural" VMS idiom for a Unix path string. We allow each
#endif
#include "perlio.h"
+#include "perllio.h"
+#include "perlsock.h"
+#include "perlproc.h"
+#include "perlenv.h"
+#include "perldir.h"
#ifdef USE_NEXT_CTYPE
if (!(what)) { \
croak("Assertion failed: file \"%s\", line %d", \
__FILE__, __LINE__); \
- exit(1); \
+ PerlProc_exit(1); \
}})
#endif
--- /dev/null
+#ifndef H_PERLDIR
+#define H_PERLDIR 1
+
+#ifdef PERL_OBJECT
+#else
+#define PerlDir_mkdir(name, mode) mkdir((name), (mode))
+#define PerlDir_chdir(name) chdir((name))
+#define PerlDir_rmdir(name) rmdir((name))
+#define PerlDir_close(dir) closedir((dir))
+#define PerlDir_open(name) opendir((name))
+#define PerlDir_read(dir) readdir((dir))
+#define PerlDir_rewind(dir) rewinddir((dir))
+#define PerlDir_seek(dir, loc) seekdir((dir), (loc))
+#define PerlDir_tell(dir) telldir((dir))
+#endif /* PERL_OBJECT */
+
+#endif /* Include guard */
+
--- /dev/null
+#ifndef H_PERLENV
+#define H_PERLENV 1
+
+#ifdef PERL_OBJECT
+#else
+#define PerlENV_putenv(str) putenv((str))
+#define PerlENV_getenv(str) getenv((str))
+#endif /* PERL_OBJECT */
+
+#endif /* Include guard */
--- /dev/null
+#ifndef H_PERLLIO
+#define H_PERLLIO 1
+
+#ifdef PERL_OBJECT
+#else
+#define PerlLIO_access(file, mode) access((file), (mode))
+#define PerlLIO_chmod(file, mode) chmod((file), (mode))
+#define PerlLIO_chsize(fd, size) chsize((fd), (size))
+#define PerlLIO_close(fd) close((fd))
+#define PerlLIO_dup(fd) dup((fd))
+#define PerlLIO_dup2(fd1, fd2) dup2((fd1), (fd2))
+#define PerlLIO_fstat(fd, buf) Fstat((fd), (buf))
+#define PerlLIO_isatty(fd) isatty((fd))
+#define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode))
+#define PerlLIO_lstat(name, buf) lstat((name), (buf))
+#define PerlLIO_mktemp(file) mktemp((file))
+#define PerlLIO_open(file, flag) open((file), (flag))
+#define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm))
+#define PerlLIO_read(fd, buf, count) read((fd), (buf), (count))
+#define PerlLIO_rename(oldname, newname) rename((oldname), (newname))
+#define PerlLIO_setmode(fd, mode) setmode((fd), (mode))
+#define PerlLIO_stat(name, buf) Stat((name), (buf))
+#define PerlLIO_tmpnam(str) tmpnam((str))
+#define PerlLIO_umask(mode) umask((mode))
+#define PerlLIO_unlink(file) unlink((file))
+#define PerlLIO_utime(file, time) utime((file), (time))
+#define PerlLIO_write(fd, buf, count) write((fd), (buf), (count))
+#endif /* PERL_OBJECT */
+
+#endif /* Include guard */
+
--- /dev/null
+#ifndef H_PERLMEM
+#define H_PERLMEM 1
+
+#ifdef PERL_OBJECT
+#else
+#define PerlMem_malloc(size) malloc((size))
+#define PerlMem_realloc(buf, size) realloc((buf), (size))
+#define PerlMem_free(buf) free((buf))
+
+#endif /* PERL_OBJECT */
+
+#endif /* Include guard */
+
--- /dev/null
+#ifndef H_PERLPROC
+#define H_PERLPROC 1
+
+#ifdef PERL_OBJECT
+#else
+#define PerlProc_abort() abort()
+#define PerlProc_exit(s) exit((s))
+#define PerlProc__exit(s) _exit((s))
+#define PerlProc_execl(c, w, x, y, z) execl((c), (w), (x), (y), (z))
+#define PerlProc_execv(c, a) execv((c), (a))
+#define PerlProc_execvp(c, a) execvp((c), (a))
+#define PerlProc_kill(i, a) kill((i), (a))
+#define PerlProc_killpg(i, a) killpg((i), (a))
+#define PerlProc_popen(c, m) my_popen((c), (m))
+#define PerlProc_pclose(f) my_pclose((f))
+#define PerlProc_pipe(fd) pipe((fd))
+#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
+#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
+#define PerlProc_signal(n, h) signal((n), (h))
+#endif /* PERL_OBJECT */
+
+#endif /* Include guard */
--- /dev/null
+#ifndef H_PERLSOCK
+#define H_PERLSOCK 1
+
+#ifdef PERL_OBJECT
+#else
+#define PerlSock_htonl(x) htonl((x))
+#define PerlSock_htons(x) htons((x))
+#define PerlSock_ntohl(x) ntohl((x))
+#define PerlSock_ntohs(x) ntohs((x))
+#define PerlSock_accept(s, a, l) accept((s), (a), (l))
+#define PerlSock_bind(s, n, l) bind((s), (n), (l))
+#define PerlSock_connect(s, n, l) connect((s), (n), (l))
+#define PerlSock_gethostbyaddr(a, l, t) gethostbyaddr((a), (l), (t))
+#define PerlSock_gethostbyname(n) gethostbyname((n))
+#define PerlSock_gethostent() gethostent()
+#define PerlSock_gethostname(n, l) gethostname((n), (l))
+#define PerlSock_getpeername(s, n, l) getpeername((s), (n), (l))
+#define PerlSock_getprotobyname(n) getprotobyname((n))
+#define PerlSock_getprotobynumber(n) getprotobynumber((n))
+#define PerlSock_getprotoent() getprotoent()
+#define PerlSock_getservbyname(n, p) getservbyname((n), (p))
+#define PerlSock_getservbyport(port, p) getservbyport((port), (p))
+#define PerlSock_getservent() getservent()
+#define PerlSock_getsockname(s, n, l) getsockname((s), (n), (l))
+#define PerlSock_getsockopt(s, l, n, v, i) getsockopt((s), (l), (n), (v), (i))
+#define PerlSock_listen(s, b) listen((s), (b))
+#define PerlSock_recvfrom(s, b, l, f, from, fromlen) recvfrom((s), (b), (l), (f), (from), (fromlen))
+#define PerlSock_select(n, r, w, e, t) select((n), (r), (w), (e), (t))
+#define PerlSock_send(s, b, l, f) send((s), (b), (l), (f))
+#define PerlSock_sendto(s, b, l, f, t, tlen) sendto((s), (b), (l), (f), (t), (tlen))
+#define PerlSock_setsockopt(s, l, n, v, len) setsockopt((s), (l), (n), (v), (len))
+#define PerlSock_shutdown(s, h) shutdown((s), (h))
+#define PerlSock_socket(a, t, p) socket((a), (t), (p))
+#define PerlSock_socketpair(a, t, p, f) socketpair((a), (t), (p), (f))
+#endif /* PERL_OBJECT */
+
+#endif /* Include guard */
s += SIZE16;
#ifdef HAS_NTOHS
if (datumtype == 'n')
- aushort = ntohs(aushort);
+ aushort = PerlSock_ntohs(aushort);
#endif
#ifdef HAS_VTOHS
if (datumtype == 'v')
sv = NEWSV(39, 0);
#ifdef HAS_NTOHS
if (datumtype == 'n')
- aushort = ntohs(aushort);
+ aushort = PerlSock_ntohs(aushort);
#endif
#ifdef HAS_VTOHS
if (datumtype == 'v')
s += SIZE32;
#ifdef HAS_NTOHL
if (datumtype == 'N')
- aulong = ntohl(aulong);
+ aulong = PerlSock_ntohl(aulong);
#endif
#ifdef HAS_VTOHL
if (datumtype == 'V')
s += SIZE32;
#ifdef HAS_NTOHL
if (datumtype == 'N')
- aulong = ntohl(aulong);
+ aulong = PerlSock_ntohl(aulong);
#endif
#ifdef HAS_VTOHL
if (datumtype == 'V')
fromstr = NEXTFROM;
ashort = (I16)SvIV(fromstr);
#ifdef HAS_HTONS
- ashort = htons(ashort);
+ ashort = PerlSock_htons(ashort);
#endif
CAT16(cat, &ashort);
}
fromstr = NEXTFROM;
aulong = SvUV(fromstr);
#ifdef HAS_HTONL
- aulong = htonl(aulong);
+ aulong = PerlSock_htonl(aulong);
#endif
CAT32(cat, &aulong);
}
((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
but that's unsupported, so I don't want to do it now and
have it bite someone in the future. */
- strcat(tmpfnam,tmpnam(NULL));
+ strcat(tmpfnam,PerlLIO_tmpnam(NULL));
cp = SvPV(tmpglob,i);
for (; i; i--) {
if (cp[i] == ';') hasver = 1;
# ifdef my_chsize /* Probably #defined to Perl_my_chsize in embed.h */
# undef my_chsize
# endif
-# define my_chsize chsize
+# define my_chsize PerlLIO_chsize
#endif
#ifdef HAS_FLOCK
I32 gimme = GIMME_V;
TAINT_PROPER("``");
- fp = my_popen(tmps, "r");
+ fp = PerlProc_popen(tmps, "r");
if (fp) {
if (gimme == G_VOID) {
char tmpbuf[256];
SvTAINTED_on(sv);
}
}
- STATUS_NATIVE_SET(my_pclose(fp));
+ STATUS_NATIVE_SET(PerlProc_pclose(fp));
TAINT; /* "I believe that this is not gratuitous!" */
}
else {
if (IoIFP(wstio))
do_close(wgv, FALSE);
- if (pipe(fd) < 0)
+ if (PerlProc_pipe(fd) < 0)
goto badexit;
IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
if (!IoIFP(rstio) || !IoOFP(wstio)) {
if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
- else close(fd[0]);
+ else PerlLIO_close(fd[0]);
if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
- else close(fd[1]);
+ else PerlLIO_close(fd[1]);
goto badexit;
}
#ifdef HAS_UMASK
if (MAXARG < 1) {
- anum = umask(0);
- (void)umask(anum);
+ anum = PerlLIO_umask(0);
+ (void)PerlLIO_umask(anum);
}
else
- anum = umask(POPi);
+ anum = PerlLIO_umask(POPi);
TAINT_PROPER("umask");
XPUSHi(anum);
#else
else
RETPUSHUNDEF;
#else
- if (setmode(PerlIO_fileno(fp), OP_BINARY) != -1) {
+ if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -1) {
#if defined(WIN32) && defined(__BORLANDC__)
/* The translation mode of the stream is maintained independent
* of the translation mode of the fd in the Borland RTL (heavy
#endif
}
- nfound = select(
+ nfound = PerlSock_select(
maxlen * 8,
(Select_fd_set_t) fd_sets[1],
(Select_fd_set_t) fd_sets[2],
#endif
buffer = SvGROW(bufsv, length+1);
/* 'offset' means 'flags' here */
- length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
+ length = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
(struct sockaddr *)namebuf, &bufsize);
if (length < 0)
RETPUSHUNDEF;
Zero(buffer+bufsize, offset-bufsize, char);
}
if (op->op_type == OP_SYSREAD) {
- length = read(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
+ length = PerlLIO_read(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
}
else
#ifdef HAS_SOCKET__bad_code_maybe
#else
bufsize = sizeof namebuf;
#endif
- length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0,
+ length = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0,
(struct sockaddr *)namebuf, &bufsize);
}
else
offset = 0;
if (length > blen - offset)
length = blen - offset;
- length = write(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
+ length = PerlLIO_write(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
}
#ifdef HAS_SOCKET
else if (SP > MARK) {
char *sockbuf;
STRLEN mlen;
sockbuf = SvPVx(*++MARK, mlen);
- length = sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length,
+ length = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length,
(struct sockaddr *)sockbuf, mlen);
}
else
- length = send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
+ length = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
#else
else
#else
{
int tmpfd;
- if ((tmpfd = open(name, O_RDWR)) < 0)
+ if ((tmpfd = PerlLIO_open(name, O_RDWR)) < 0)
result = 0;
else {
if (my_chsize(tmpfd, len) < 0)
result = 0;
- close(tmpfd);
+ PerlLIO_close(tmpfd);
}
}
#endif
do_close(gv, FALSE);
TAINT_PROPER("socket");
- fd = socket(domain, type, protocol);
+ fd = PerlSock_socket(domain, type, protocol);
if (fd < 0)
RETPUSHUNDEF;
IoIFP(io) = PerlIO_fdopen(fd, "r"); /* stdio gets confused about sockets */
if (!IoIFP(io) || !IoOFP(io)) {
if (IoIFP(io)) PerlIO_close(IoIFP(io));
if (IoOFP(io)) PerlIO_close(IoOFP(io));
- if (!IoIFP(io) && !IoOFP(io)) close(fd);
+ if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd);
RETPUSHUNDEF;
}
do_close(gv2, FALSE);
TAINT_PROPER("socketpair");
- if (socketpair(domain, type, protocol, fd) < 0)
+ if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
RETPUSHUNDEF;
IoIFP(io1) = PerlIO_fdopen(fd[0], "r");
IoOFP(io1) = PerlIO_fdopen(fd[0], "w");
if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
if (IoOFP(io1)) PerlIO_close(IoOFP(io1));
- if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
+ if (!IoIFP(io1) && !IoOFP(io1)) PerlLIO_close(fd[0]);
if (IoIFP(io2)) PerlIO_close(IoIFP(io2));
if (IoOFP(io2)) PerlIO_close(IoOFP(io2));
- if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
+ if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]);
RETPUSHUNDEF;
}
addr = SvPV(addrsv, len);
TAINT_PROPER("bind");
- if (bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+ if (PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
RETPUSHYES;
else
RETPUSHUNDEF;
addr = SvPV(addrsv, len);
TAINT_PROPER("connect");
- if (connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+ if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
RETPUSHYES;
else
RETPUSHUNDEF;
if (!io || !IoIFP(io))
goto nuts;
- if (listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
+ if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
RETPUSHYES;
else
RETPUSHUNDEF;
if (IoIFP(nstio))
do_close(ngv, FALSE);
- fd = accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
+ fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
if (fd < 0)
goto badexit;
IoIFP(nstio) = PerlIO_fdopen(fd, "r");
if (!IoIFP(nstio) || !IoOFP(nstio)) {
if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
if (IoOFP(nstio)) PerlIO_close(IoOFP(nstio));
- if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
+ if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd);
goto badexit;
}
if (!io || !IoIFP(io))
goto nuts;
- PUSHi( shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
+ PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
RETURN;
nuts:
SvCUR_set(sv,256);
*SvEND(sv) ='\0';
len = SvCUR(sv);
- if (getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
+ if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
goto nuts2;
SvCUR_set(sv, len);
*SvEND(sv) ='\0';
buf = (char*)&aint;
len = sizeof(int);
}
- if (setsockopt(fd, lvl, optname, buf, len) < 0)
+ if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
goto nuts2;
PUSHs(&sv_yes);
}
fd = PerlIO_fileno(IoIFP(io));
switch (optype) {
case OP_GETSOCKNAME:
- if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
+ if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
goto nuts2;
break;
case OP_GETPEERNAME:
- if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
+ if (PerlSock_getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
goto nuts2;
#if defined(VMS_DO_SOCKETS) && defined (DECCRTL_SOCKETS)
{
statgv = tmpgv;
sv_setpv(statname, "");
laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv))
- ? Fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) : -1);
+ ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) : -1);
}
if (laststatval < 0)
max = 0;
#ifdef HAS_LSTAT
laststype = op->op_type;
if (op->op_type == OP_LSTAT)
- laststatval = lstat(SvPV(statname, na), &statcache);
+ laststatval = PerlLIO_lstat(SvPV(statname, na), &statcache);
else
#endif
laststatval = Stat(SvPV(statname, na), &statcache);
fd = atoi(tmps);
else
RETPUSHUNDEF;
- if (isatty(fd))
+ if (PerlLIO_isatty(fd))
RETPUSHYES;
RETPUSHNO;
}
if (io && IoIFP(io)) {
if (! PerlIO_has_base(IoIFP(io)))
DIE("-T and -B not implemented on filehandles");
- laststatval = Fstat(PerlIO_fileno(IoIFP(io)), &statcache);
+ laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &statcache);
if (laststatval < 0)
RETPUSHUNDEF;
if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */
laststatval = -1;
sv_setpv(statname, SvPV(sv, na));
#ifdef HAS_OPEN3
- i = open(SvPV(sv, na), O_RDONLY, 0);
+ i = PerlLIO_open3(SvPV(sv, na), O_RDONLY, 0);
#else
- i = open(SvPV(sv, na), 0);
+ i = PerlLIO_open(SvPV(sv, na), 0);
#endif
if (i < 0) {
if (dowarn && strchr(SvPV(sv, na), '\n'))
warn(warn_nl, "open");
RETPUSHUNDEF;
}
- laststatval = Fstat(i, &statcache);
+ laststatval = PerlLIO_fstat(i, &statcache);
if (laststatval < 0)
RETPUSHUNDEF;
- len = read(i, tbuf, 512);
- (void)close(i);
+ len = PerlLIO_read(i, tbuf, 512);
+ (void)PerlLIO_close(i);
if (len <= 0) {
if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
RETPUSHNO; /* special case NFS directories */
tmps = SvPV(*svp, na);
}
TAINT_PROPER("chdir");
- PUSHi( chdir(tmps) >= 0 );
+ PUSHi( PerlDir_chdir(tmps) >= 0 );
#ifdef VMS
/* Clear the DEFAULT element of ENV so we'll get the new value
* in the future. */
*s++ = *filename++;
}
strcpy(s, " 2>&1");
- myfp = my_popen(cmdline, "r");
+ myfp = PerlProc_popen(cmdline, "r");
Safefree(cmdline);
if (myfp) {
SV *tmpsv = sv_newmortal();
/* Need to save/restore 'rs' ?? */
s = sv_gets(tmpsv, myfp, 0);
- (void)my_pclose(myfp);
+ (void)PerlProc_pclose(myfp);
if (s != Nullch) {
int e;
for (e = 1;
TAINT_PROPER("mkdir");
#ifdef HAS_MKDIR
- SETi( Mkdir(tmps, mode) >= 0 );
+ SETi( PerlDir_mkdir(tmps, mode) >= 0 );
#else
SETi( dooneliner("mkdir", tmps) );
- oldumask = umask(0);
- umask(oldumask);
- chmod(tmps, (mode & ~oldumask) & 0777);
+ oldumask = PerlLIO_umask(0);
+ PerlLIO_umask(oldumask);
+ PerlLIO_chmod(tmps, (mode & ~oldumask) & 0777);
#endif
RETURN;
}
tmps = POPp;
TAINT_PROPER("rmdir");
#ifdef HAS_RMDIR
- XPUSHi( rmdir(tmps) >= 0 );
+ XPUSHi( PerlDir_rmdir(tmps) >= 0 );
#else
XPUSHi( dooneliner("rmdir", tmps) );
#endif
goto nope;
if (IoDIRP(io))
- closedir(IoDIRP(io));
- if (!(IoDIRP(io) = opendir(dirname)))
+ PerlDir_close(IoDIRP(io));
+ if (!(IoDIRP(io) = PerlDir_open(dirname)))
goto nope;
RETPUSHYES;
if (GIMME == G_ARRAY) {
/*SUPPRESS 560*/
- while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
+ while (dp = (Direntry_t *)PerlDir_read(IoDIRP(io))) {
#ifdef DIRNAMLEN
sv = newSVpv(dp->d_name, dp->d_namlen);
#else
}
}
else {
- if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
+ if (!(dp = (Direntry_t *)PerlDir_read(IoDIRP(io))))
goto nope;
#ifdef DIRNAMLEN
sv = newSVpv(dp->d_name, dp->d_namlen);
if (!io || !IoDIRP(io))
goto nope;
- PUSHi( telldir(IoDIRP(io)) );
+ PUSHi( PerlDir_tell(IoDIRP(io)) );
RETURN;
nope:
if (!errno)
if (!io || !IoDIRP(io))
goto nope;
- (void)seekdir(IoDIRP(io), along);
+ (void)PerlDir_seek(IoDIRP(io), along);
RETPUSHYES;
nope:
if (!io || !IoDIRP(io))
goto nope;
- (void)rewinddir(IoDIRP(io));
+ (void)PerlDir_rewind(IoDIRP(io));
RETPUSHYES;
nope:
if (!errno)
goto nope;
#ifdef VOID_CLOSEDIR
- closedir(IoDIRP(io));
+ PerlDir_close(IoDIRP(io));
#else
- if (closedir(IoDIRP(io)) < 0) {
+ if (PerlDir_close(IoDIRP(io)) < 0) {
IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */
goto nope;
}
else {
value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
}
- _exit(-1);
+ PerlProc__exit(-1);
#else /* ! FORK or VMS or OS/2 */
if (op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
register char **elem;
register SV *sv;
#if defined(HAS_GETHOSTENT) && !defined(DONT_DECLARE_STD)
- struct hostent *gethostbyname(const char *);
- struct hostent *gethostbyaddr(const Gethbadd_addr_t, Gethbadd_alen_t, int);
- struct hostent *gethostent(void);
+ struct hostent *PerlSock_gethostbyname(const char *);
+ struct hostent *PerlSock_gethostbyaddr(const Gethbadd_addr_t, Gethbadd_alen_t, int);
+ struct hostent *PerlSock_gethostent(void);
#endif
struct hostent *hent;
unsigned long len;
EXTEND(SP, 10);
if (which == OP_GHBYNAME) {
- hent = gethostbyname(POPp);
+ hent = PerlSock_gethostbyname(POPp);
}
else if (which == OP_GHBYADDR) {
int addrtype = POPi;
STRLEN addrlen;
Gethbadd_addr_t addr = (Gethbadd_addr_t) SvPV(addrsv, addrlen);
- hent = gethostbyaddr(addr, (Gethbadd_alen_t) addrlen, addrtype);
+ hent = PerlSock_gethostbyaddr(addr, (Gethbadd_alen_t) addrlen, addrtype);
}
else
#ifdef HAS_GETHOSTENT
- hent = gethostent();
+ hent = PerlSock_gethostent();
#else
DIE("gethostent not implemented");
#endif
register char **elem;
register SV *sv;
#ifndef DONT_DECLARE_STD
- struct protoent *getprotobyname(const char *);
- struct protoent *getprotobynumber(int);
- struct protoent *getprotoent(void);
+ struct protoent *PerlSock_getprotobyname(const char *);
+ struct protoent *PerlSock_getprotobynumber(int);
+ struct protoent *PerlSock_getprotoent(void);
#endif
struct protoent *pent;
if (which == OP_GPBYNAME)
- pent = getprotobyname(POPp);
+ pent = PerlSock_getprotobyname(POPp);
else if (which == OP_GPBYNUMBER)
- pent = getprotobynumber(POPi);
+ pent = PerlSock_getprotobynumber(POPi);
else
- pent = getprotoent();
+ pent = PerlSock_getprotoent();
EXTEND(SP, 3);
if (GIMME != G_ARRAY) {
register char **elem;
register SV *sv;
#ifndef DONT_DECLARE_STD
- struct servent *getservbyname(const char *, const char *);
- struct servent *getservbynumber();
- struct servent *getservent(void);
+ struct servent *PerlSock_getservbyname(const char *, const char *);
+ struct servent *PerlSock_getservbynumber();
+ struct servent *PerlSock_getservent(void);
#endif
struct servent *sent;
if (proto && !*proto)
proto = Nullch;
- sent = getservbyname(name, proto);
+ sent = PerlSock_getservbyname(name, proto);
}
else if (which == OP_GSBYPORT) {
char *proto = POPp;
unsigned short port = POPu;
#ifdef HAS_HTONS
- port = htons(port);
+ port = PerlSock_htons(port);
#endif
- sent = getservbyport(port, proto);
+ sent = PerlSock_getservbyport(port, proto);
}
else
- sent = getservent();
+ sent = PerlSock_getservent();
EXTEND(SP, 4);
if (GIMME != G_ARRAY) {
if (sent) {
if (which == OP_GSBYNAME) {
#ifdef HAS_NTOHS
- sv_setiv(sv, (IV)ntohs(sent->s_port));
+ sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port));
#else
sv_setiv(sv, (IV)(sent->s_port));
#endif
/* flock locks entire file so for lockf we need to do the same */
save_errno = errno;
- pos = lseek(fd, (Off_t)0, SEEK_CUR); /* get pos to restore later */
+ pos = PerlLIO_lseek(fd, (Off_t)0, SEEK_CUR); /* get pos to restore later */
if (pos > 0) /* is seekable and needs to be repositioned */
- if (lseek(fd, (Off_t)0, SEEK_SET) < 0)
+ if (PerlLIO_lseek(fd, (Off_t)0, SEEK_SET) < 0)
pos = -1; /* seek failed, so don't seek back afterwards */
errno = save_errno;
}
if (pos > 0) /* need to restore position of the handle */
- lseek(fd, pos, SEEK_SET); /* ignore error here */
+ PerlLIO_lseek(fd, pos, SEEK_SET); /* ignore error here */
return (i);
}
DEBUG_r(
if (!colorset) {
int i = 0;
- char *s = getenv("TERMCAP_COLORS");
+ char *s = PerlENV_getenv("TERMCAP_COLORS");
colorset = 1;
if (s) {
STMT_START { \
cur_env.je_prev = top_env; \
OP_REG_TO_MEM; \
- cur_env.je_ret = Sigsetjmp(cur_env.je_buf, 1); \
+ cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, 1); \
OP_MEM_TO_REG; \
top_env = &cur_env; \
cur_env.je_mustcatch = FALSE; \
STMT_START { \
OP_REG_TO_MEM; \
if (top_env->je_prev) \
- Siglongjmp(top_env->je_buf, (v)); \
+ PerlProc_longjmp(top_env->je_buf, (v)); \
if ((v) == 2) \
- exit(STATUS_NATIVE_EXPORT); \
+ PerlProc_exit(STATUS_NATIVE_EXPORT); \
PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \
- exit(1); \
+ PerlProc_exit(1); \
} STMT_END
#define CATCH_GET (top_env->je_mustcatch)
do { \
MUTEX_LOCK(&sv_mutex); \
reg_remove(p); \
- free((char*)(p)); \
+ Safefree((char*)(p)); \
MUTEX_UNLOCK(&sv_mutex); \
} while (0)
U32 flags;
{
if (!(flags & SVf_FAKE))
- free(ptr);
+ Safefree(ptr);
}
#else /* ! PURIFY */
#ifdef PURIFY
#define new_XIV() (void*)safemalloc(sizeof(XPVIV))
-#define del_XIV(p) free((char*)p)
+#define del_XIV(p) Safefree((char*)p)
#else
#define new_XIV() (void*)new_xiv()
#define del_XIV(p) del_xiv((XPVIV*) p)
#ifdef PURIFY
#define new_XNV() (void*)safemalloc(sizeof(XPVNV))
-#define del_XNV(p) free((char*)p)
+#define del_XNV(p) Safefree((char*)p)
#else
#define new_XNV() (void*)new_xnv()
#define del_XNV(p) del_xnv((XPVNV*) p)
#ifdef PURIFY
#define new_XRV() (void*)safemalloc(sizeof(XRV))
-#define del_XRV(p) free((char*)p)
+#define del_XRV(p) Safefree((char*)p)
#else
#define new_XRV() (void*)new_xrv()
#define del_XRV(p) del_xrv((XRV*) p)
#ifdef PURIFY
#define new_XPV() (void*)safemalloc(sizeof(XPV))
-#define del_XPV(p) free((char*)p)
+#define del_XPV(p) Safefree((char*)p)
#else
#define new_XPV() (void*)new_xpv()
#define del_XPV(p) del_xpv((XPV *)p)
#endif
#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
-#define del_XPVIV(p) free((char*)p)
+#define del_XPVIV(p) Safefree((char*)p)
#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
-#define del_XPVNV(p) free((char*)p)
+#define del_XPVNV(p) Safefree((char*)p)
#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
-#define del_XPVMG(p) free((char*)p)
+#define del_XPVMG(p) Safefree((char*)p)
#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
-#define del_XPVLV(p) free((char*)p)
+#define del_XPVLV(p) Safefree((char*)p)
#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
-#define del_XPVAV(p) free((char*)p)
+#define del_XPVAV(p) Safefree((char*)p)
#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
-#define del_XPVHV(p) free((char*)p)
+#define del_XPVHV(p) Safefree((char*)p)
#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
-#define del_XPVCV(p) free((char*)p)
+#define del_XPVCV(p) Safefree((char*)p)
#define new_XPVGV() (void*)safemalloc(sizeof(XPVGV))
-#define del_XPVGV(p) free((char*)p)
+#define del_XPVGV(p) Safefree((char*)p)
#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
-#define del_XPVBM(p) free((char*)p)
+#define del_XPVBM(p) Safefree((char*)p)
#define new_XPVFM() (void*)safemalloc(sizeof(XPVFM))
-#define del_XPVFM(p) free((char*)p)
+#define del_XPVFM(p) Safefree((char*)p)
#define new_XPVIO() (void*)safemalloc(sizeof(XPVIO))
-#define del_XPVIO(p) free((char*)p)
+#define del_XPVIO(p) Safefree((char*)p)
bool
sv_upgrade(register SV *sv, U32 mt)
oldoldbufptr = oldbufptr = bufptr = s = linestart = SvPVX(linestr);
bufend = SvPVX(linestr) + SvCUR(linestr);
if (preprocess && !in_eval)
- (void)my_pclose(rsfp);
+ (void)PerlProc_pclose(rsfp);
else if ((PerlIO*)rsfp == PerlIO_stdin())
PerlIO_clearerr(rsfp);
else
incl_perldb(void)
{
if (perldb) {
- char *pdb = getenv("PERL5DB");
+ char *pdb = PerlENV_getenv("PERL5DB");
if (pdb)
return pdb;
fake_eof:
if (rsfp) {
if (preprocess && !in_eval)
- (void)my_pclose(rsfp);
+ (void)PerlProc_pclose(rsfp);
else if ((PerlIO *)rsfp == PerlIO_stdin())
PerlIO_clearerr(rsfp);
else
if ((long)size < 0)
croak("panic: malloc");
#endif
- ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
+ ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
#if !(defined(I286) || defined(atarist))
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
#else
{
Malloc_t ptr;
#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
- Malloc_t realloc();
+ Malloc_t PerlMem_realloc();
#endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */
#ifdef HAS_64K_LIMIT
if ((long)size < 0)
croak("panic: realloc");
#endif
- ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
+ ptr = PerlMem_realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
#if !(defined(I286) || defined(atarist))
DEBUG_m( {
#endif
if (where) {
/*SUPPRESS 701*/
- free(where);
+ PerlMem_free(where);
}
}
croak("panic: calloc");
#endif
size *= count;
- ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
+ ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
#if !(defined(I286) || defined(atarist))
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) calloc %ld x %ld bytes\n",ptr,an++,(long)count,(long)size));
#else
#ifdef USE_LOCALE_NUMERIC
char *curnum = NULL;
#endif /* USE_LOCALE_NUMERIC */
- char *lc_all = getenv("LC_ALL");
- char *lang = getenv("LANG");
+ char *lc_all = PerlENV_getenv("LC_ALL");
+ char *lang = PerlENV_getenv("LANG");
bool setlocale_failure = FALSE;
#ifdef LOCALE_ENVIRON_REQUIRED
{
#ifdef USE_LOCALE_CTYPE
if (! (curctype = setlocale(LC_CTYPE,
- (!done && (lang || getenv("LC_CTYPE")))
+ (!done && (lang || PerlENV_getenv("LC_CTYPE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
if (! (curcoll = setlocale(LC_COLLATE,
- (!done && (lang || getenv("LC_COLLATE")))
+ (!done && (lang || PerlENV_getenv("LC_COLLATE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
if (! (curnum = setlocale(LC_NUMERIC,
- (!done && (lang || getenv("LC_NUMERIC")))
+ (!done && (lang || PerlENV_getenv("LC_NUMERIC")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_NUMERIC */
char *p;
bool locwarn = (printwarn > 1 ||
printwarn &&
- (!(p = getenv("PERL_BADLANG")) || atoi(p)));
+ (!(p = PerlENV_getenv("PERL_BADLANG")) || atoi(p)));
if (locwarn) {
#ifdef LC_ALL
vallen = strlen(val);
New(904, envstr, namlen + vallen + 3, char);
(void)sprintf(envstr,"%s=%s",nam,val);
- (void)putenv(envstr);
+ (void)PerlENV_putenv(envstr);
if (oldstr)
Safefree(oldstr);
#ifdef _MSC_VER
{
I32 i;
- for (i = 0; unlink(f) >= 0; i++) ;
+ for (i = 0; PerlLIO_unlink(f) >= 0; i++) ;
return i ? 0 : -1;
}
#endif
return my_syspopen(cmd,mode);
}
#endif
- if (pipe(p) < 0)
+ if (PerlProc_pipe(p) < 0)
return Nullfp;
This = (*mode == 'w');
that = !This;
}
while ((pid = (doexec?vfork():fork())) < 0) {
if (errno != EAGAIN) {
- close(p[This]);
+ PerlLIO_close(p[This]);
if (!doexec)
croak("Can't fork");
return Nullfp;
#define THIS that
#define THAT This
- close(p[THAT]);
+ PerlLIO_close(p[THAT]);
if (p[THIS] != (*mode == 'r')) {
- dup2(p[THIS], *mode == 'r');
- close(p[THIS]);
+ PerlLIO_dup2(p[THIS], *mode == 'r');
+ PerlLIO_close(p[THIS]);
}
if (doexec) {
#if !defined(HAS_FCNTL) || !defined(F_SETFD)
#define NOFILE 20
#endif
for (fd = maxsysfd + 1; fd < NOFILE; fd++)
- close(fd);
+ PerlLIO_close(fd);
#endif
do_exec(cmd); /* may or may not use the shell */
- _exit(1);
+ PerlProc__exit(1);
}
/*SUPPRESS 560*/
if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
#undef THAT
}
do_execfree(); /* free any memory malloced by child on vfork */
- close(p[that]);
+ PerlLIO_close(p[that]);
if (p[that] < p[This]) {
- dup2(p[This], p[that]);
- close(p[This]);
+ PerlLIO_dup2(p[This], p[that]);
+ PerlLIO_close(p[This]);
p[This] = p[that];
}
sv = *av_fetch(fdpid,p[This],TRUE);
PerlIO_printf(PerlIO_stderr(),"%s", s);
for (fd = 0; fd < 32; fd++) {
- if (Fstat(fd,&tmpstatbuf) >= 0)
+ if (PerlLIO_fstat(fd,&tmpstatbuf) >= 0)
PerlIO_printf(PerlIO_stderr()," %d",fd);
}
PerlIO_printf(PerlIO_stderr(),"\n");
#if defined(HAS_FCNTL) && defined(F_DUPFD)
if (oldfd == newfd)
return oldfd;
- close(newfd);
+ PerlLIO_close(newfd);
return fcntl(oldfd, F_DUPFD, newfd);
#else
#define DUP2_MAX_FDS 256
if (oldfd == newfd)
return oldfd;
- close(newfd);
+ PerlLIO_close(newfd);
/* good enough for low fd's... */
- while ((fd = dup(oldfd)) != newfd && fd >= 0) {
+ while ((fd = PerlLIO_dup(oldfd)) != newfd && fd >= 0) {
if (fdx >= DUP2_MAX_FDS) {
- close(fd);
+ PerlLIO_close(fd);
fd = -1;
break;
}
fdtmp[fdx++] = fd;
}
while (fdx > 0)
- close(fdtmp[--fdx]);
+ PerlLIO_close(fdtmp[--fdx]);
return fd;
#endif
}
Sighandler_t
rsignal(int signo, Sighandler_t handler)
{
- return signal(signo, handler);
+ return PerlProc_signal(signo, handler);
}
static int sig_trapped;
Sighandler_t oldsig;
sig_trapped = 0;
- oldsig = signal(signo, sig_trap);
- signal(signo, oldsig);
+ oldsig = PerlProc_signal(signo, sig_trap);
+ PerlProc_signal(signo, oldsig);
if (sig_trapped)
- kill(getpid(), signo);
+ PerlProc_kill(getpid(), signo);
return oldsig;
}
int
rsignal_save(int signo, Sighandler_t handler, Sigsave_t *save)
{
- *save = signal(signo, handler);
+ *save = PerlProc_signal(signo, handler);
return (*save == SIG_ERR) ? -1 : 0;
}
int
rsignal_restore(int signo, Sigsave_t *save)
{
- return (signal(signo, *save) == SIG_ERR) ? -1 : 0;
+ return (PerlProc_signal(signo, *save) == SIG_ERR) ? -1 : 0;
}
#endif /* !HAS_SIGACTION */
#endif
}
#ifdef UTS
- if(kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */
+ if(PerlProc_kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */
#endif
rsignal_save(SIGHUP, SIG_IGN, &hstat);
rsignal_save(SIGINT, SIG_IGN, &istat);
projects / p5sagit/p5-mst-13.2.git / commitdiff