# ifdef I_PWD
# include <pwd.h>
# else
+# if !defined(VMS)
struct passwd *getpwnam (char *);
struct passwd *getpwuid (Uid_t);
+# endif
# endif
# ifdef HAS_GETPWENT
struct passwd *getpwent (void);
# endif
#endif
-#ifdef I_SYS_UN
-# ifdef __linux__
-# include <sys/un.h>
-# endif
-#endif
-
/* Put this after #includes because fork and vfork prototypes may conflict. */
#ifndef HAS_VFORK
# define vfork fork
if (GvIOp(gv))
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
- if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
/* Method's args are same as ours ... */
/* ... except handle is replaced by the object */
*MARK-- = SvTIED_obj((SV*)gv, mg);
else
gv = (GV*)POPs;
- if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
RETPUSHUNDEF;
gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
if (discp)
SV *sv;
I32 markoff = MARK - PL_stack_base;
char *methname;
- int how = 'P';
+ int how = PERL_MAGIC_tied;
U32 items;
STRLEN n_a;
}
#endif
methname = "TIEHANDLE";
- how = 'q';
+ how = PERL_MAGIC_tiedscalar;
break;
default:
methname = "TIESCALAR";
- how = 'q';
+ how = PERL_MAGIC_tiedscalar;
break;
}
items = SP - MARK++;
{
dSP;
SV *sv = POPs;
- char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
+ char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
+ ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
MAGIC * mg ;
if ((mg = SvTIED_mg(sv, how))) {
{
dSP;
SV *sv = POPs;
- char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
+ char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
+ ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
MAGIC *mg;
if ((mg = SvTIED_mg(sv, how))) {
}
if (sv_isobject(TOPs)) {
- sv_unmagic((SV *) hv, 'P');
- sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
+ sv_unmagic((SV *) hv, PERL_MAGIC_tied);
+ sv_magic((SV*)hv, TOPs, PERL_MAGIC_tied, Nullch, 0);
}
LEAVE;
RETURN;
else
gv = (GV*)POPs;
- if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
I32 gimme = GIMME_V;
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
else
gv = PL_defoutgv;
- if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
if (MARK == ORIGMARK) {
MEXTEND(SP, 1);
++MARK;
gv = (GV*)*++MARK;
if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) &&
- (mg = SvTIED_mg((SV*)gv, 'q')))
+ (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar)))
{
SV *sv;
io = GvIO(gv);
if (!io || !IoIFP(io))
goto say_undef;
- if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTE) {
+ if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
buffer = SvPVutf8_force(bufsv, blen);
/* UTF8 may not have been set if they are all low bytes */
SvUTF8_on(bufsv);
(struct sockaddr *)namebuf, &bufsize);
if (count < 0)
RETPUSHUNDEF;
+#ifdef EPOC
+ /* Bogus return without padding */
+ bufsize = sizeof (struct sockaddr_in);
+#endif
SvCUR_set(bufsv, count);
*SvEND(bufsv) = '\0';
(void)SvPOK_only(bufsv);
if (!(IoFLAGS(io) & IOf_UNTAINT))
SvTAINTED_on(bufsv);
SP = ORIGMARK;
-#if defined(I_SYS_UN) && defined(__linux__)
- /* Linux returns the sum of actual pathname string length and the
- size of the other members of sockaddr_un members. It should
- return sizeof(struct sockaddr_un). */
- if (((struct sockaddr *)namebuf)->sa_family == AF_UNIX)
- bufsize = sizeof(struct sockaddr_un);
-#endif
sv_setpvn(TARG, namebuf, bufsize);
PUSHs(TARG);
RETURN;
SvCUR_set(bufsv, count+(buffer - SvPVX(bufsv)));
*SvEND(bufsv) = '\0';
(void)SvPOK_only(bufsv);
- if (fp_utf8 && !IN_BYTE) {
+ if (fp_utf8 && !IN_BYTES) {
/* Look at utf8 we got back and count the characters */
char *bend = buffer + count;
while (buffer < bend) {
MAGIC *mg;
gv = (GV*)*++MARK;
- if (PL_op->op_type == OP_SYSWRITE && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (PL_op->op_type == OP_SYSWRITE
+ && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar)))
+ {
SV *sv;
PUSHMARK(MARK-1);
else
gv = PL_last_in_gv = (GV*)POPs; /* eof(FH) */
- if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
else
gv = PL_last_in_gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
gv = PL_last_in_gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
#if LSEEKSIZE > IVSIZE
* at least as wide as size_t, so using an off_t should be okay. */
/* XXX Configure probe for the length type of *truncate() needed XXX */
Off_t len;
- int result = 1;
- GV *tmpgv;
- STRLEN n_a;
#if Size_t_size > IVSIZE
len = (Off_t)POPn;
/* XXX Configure probe for the signedness of the length type of *truncate() needed? XXX */
SETERRNO(0,0);
#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
- if (PL_op->op_flags & OPf_SPECIAL) {
- tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
- do_ftruncate:
- TAINT_PROPER("truncate");
- if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)))
- result = 0;
- else {
- PerlIO_flush(IoIFP(GvIOp(tmpgv)));
+ {
+ STRLEN n_a;
+ int result = 1;
+ GV *tmpgv;
+
+ if (PL_op->op_flags & OPf_SPECIAL) {
+ tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
+
+ do_ftruncate:
+ TAINT_PROPER("truncate");
+ if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)))
+ result = 0;
+ else {
+ PerlIO_flush(IoIFP(GvIOp(tmpgv)));
#ifdef HAS_TRUNCATE
- if (ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+ if (ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
#else
- if (my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+ if (my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
#endif
- result = 0;
- }
- }
- else {
- SV *sv = POPs;
- char *name;
- STRLEN n_a;
-
- if (SvTYPE(sv) == SVt_PVGV) {
- tmpgv = (GV*)sv; /* *main::FRED for example */
- goto do_ftruncate;
- }
- else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
- tmpgv = (GV*) SvRV(sv); /* \*main::FRED for example */
- goto do_ftruncate;
+ result = 0;
+ }
}
+ else {
+ SV *sv = POPs;
+ char *name;
+
+ if (SvTYPE(sv) == SVt_PVGV) {
+ tmpgv = (GV*)sv; /* *main::FRED for example */
+ goto do_ftruncate;
+ }
+ else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+ tmpgv = (GV*) SvRV(sv); /* \*main::FRED for example */
+ goto do_ftruncate;
+ }
- name = SvPV(sv, n_a);
- TAINT_PROPER("truncate");
+ name = SvPV(sv, n_a);
+ TAINT_PROPER("truncate");
#ifdef HAS_TRUNCATE
- if (truncate(name, len) < 0)
- result = 0;
+ if (truncate(name, len) < 0)
+ result = 0;
#else
- {
- int tmpfd;
- if ((tmpfd = PerlLIO_open(name, O_RDWR)) < 0)
- result = 0;
- else {
- if (my_chsize(tmpfd, len) < 0)
+ {
+ int tmpfd;
+
+ if ((tmpfd = PerlLIO_open(name, O_RDWR)) < 0)
result = 0;
- PerlLIO_close(tmpfd);
+ else {
+ if (my_chsize(tmpfd, len) < 0)
+ result = 0;
+ PerlLIO_close(tmpfd);
+ }
}
- }
#endif
- }
+ }
- if (result)
- RETPUSHYES;
- if (!errno)
- SETERRNO(EBADF,RMS$_IFI);
- RETPUSHUNDEF;
+ if (result)
+ RETPUSHYES;
+ if (!errno)
+ SETERRNO(EBADF,RMS$_IFI);
+ RETPUSHUNDEF;
+ }
#else
DIE(aTHX_ "truncate not implemented");
#endif
{
dSP; dTARGET;
SV *argsv = POPs;
- unsigned int func = U_I(POPn);
+ unsigned int func = POPu;
int optype = PL_op->op_type;
char *s;
IV retval;
RETPUSHUNDEF;
}
+ if (IoIFP(io))
+ do_close(gv, FALSE);
+
TAINT_PROPER("socket");
fd = PerlSock_socket(domain, type, protocol);
if (fd < 0)
RETPUSHUNDEF;
}
+ if (IoIFP(io1))
+ do_close(gv1, FALSE);
+ if (IoIFP(io2))
+ do_close(gv2, FALSE);
+
TAINT_PROPER("socketpair");
if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
RETPUSHUNDEF;
setbuf( IoIFP(nstio), NULL); /* EPOC gets confused about sockets */
#endif
-#if defined(I_SYS_UN) && defined(__linux__)
- /* see the comment in pp_sysread */
- if (saddr.sa_family == AF_UNIX)
- len = sizeof(struct sockaddr_un);
-#endif
-
PUSHp((char *)&saddr, len);
RETURN;
if (len == BOGUS_GETNAME_RETURN)
len = sizeof(struct sockaddr);
#endif
-#if defined(I_SYS_UN) && defined(__linux__)
- /* see the comment in pp_sysread */
- if (((struct sockaddr *)SvPVX(sv))->sa_family == AF_UNIX)
- len = sizeof(struct sockaddr_un);
-#endif
SvCUR_set(sv, len);
*SvEND(sv) ='\0';
PUSHs(sv);
#else
else if (*s & 128) {
#ifdef USE_LOCALE
- if ((PL_op->op_private & OPpLOCALE) && isALPHA_LC(*s))
+ if (IN_LOCALE_RUNTIME && isALPHA_LC(*s))
continue;
#endif
/* utf8 characters don't count as odd */
PP(pp_chroot)
{
dSP; dTARGET;
- char *tmps;
#ifdef HAS_CHROOT
STRLEN n_a;
- tmps = POPpx;
+ char *tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
RETURN;
{
dSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
-#ifndef I_DIRENT
+#if !defined(I_DIRENT) && !defined(VMS)
Direntry_t *readdir (DIR *);
#endif
register Direntry_t *dp;
Pid_t childpid;
int argflags;
+#ifdef PERL_OLD_SIGNALS
childpid = wait4pid(-1, &argflags, 0);
+#else
+ while ((childpid = wait4pid(-1, &argflags, 0)) == -1 && errno == EINTR) {
+ PERL_ASYNC_CHECK();
+ }
+#endif
# if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
/* 0 and -1 are both error returns (the former applies to WNOHANG case) */
STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
optype = POPi;
childpid = TOPi;
+#ifdef PERL_OLD_SIGNALS
childpid = wait4pid(childpid, &argflags, optype);
+#else
+ while ((childpid = wait4pid(childpid, &argflags, optype)) == -1 && errno == EINTR) {
+ PERL_ASYNC_CHECK();
+ }
+#endif
# if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
/* 0 and -1 are both error returns (the former applies to WNOHANG case) */
STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
if (SP - MARK == 1) {
if (PL_tainting) {
- char *junk = SvPV(TOPs, n_a);
+ (void)SvPV_nolen(TOPs); /* stringify for taint check */
TAINT_ENV();
TAINT_PROPER("system");
}
#endif
else {
if (PL_tainting) {
- char *junk = SvPV(*SP, n_a);
+ (void)SvPV_nolen(*SP); /* stringify for taint check */
TAINT_ENV();
TAINT_PROPER("exec");
}
PP(pp_getpriority)
{
dSP; dTARGET;
- int which;
- int who;
#ifdef HAS_GETPRIORITY
- who = POPi;
- which = TOPi;
+ int who = POPi;
+ int which = TOPi;
SETi( getpriority(which, who) );
RETURN;
#else
PP(pp_setpriority)
{
dSP; dTARGET;
- int which;
- int who;
- int niceval;
#ifdef HAS_SETPRIORITY
- niceval = POPi;
- who = POPi;
- which = TOPi;
+ int niceval = POPi;
+ int who = POPi;
+ int which = TOPi;
TAINT_PROPER("setpriority");
SETi( setpriority(which, who, niceval) >= 0 );
RETURN;
else if (which == OP_GNBYADDR) {
#ifdef HAS_GETNETBYADDR
int addrtype = POPi;
- Netdb_net_t addr = (Netdb_net_t) U_L(POPn);
+ Netdb_net_t addr = (Netdb_net_t) (U32)POPu;
nent = PerlSock_getnetbyaddr(addr, addrtype);
#else
DIE(aTHX_ PL_no_sock_func, "getnetbyaddr");
projects / p5sagit/p5-mst-13.2.git / blobdiff