/* pp_sys.c
*
- * Copyright (c) 1991-2001, Larry Wall
+ * Copyright (c) 1991-2002, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
# include <sys/resource.h>
#endif
+#ifdef NETWARE
+NETDB_DEFINE_CONTEXT
+#endif
+
#ifdef HAS_SELECT
# ifdef I_SYS_SELECT
# include <sys/select.h>
# 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
-/* Put this after #includes because fork and vfork prototypes may conflict. */
-#ifndef HAS_VFORK
-# define vfork fork
-#endif
-
#ifdef HAS_CHSIZE
# ifdef my_chsize /* Probably #defined to Perl_my_chsize in embed.h */
# undef my_chsize
#endif
#if !defined(PERL_EFF_ACCESS_R_OK)
+/* With it or without it: anyway you get a warning: either that
+ it is unused, or it is declared static and never defined.
+ */
STATIC int
S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
{
return result;
}
-#if 0 /* XXX never used! */
-PP(pp_indread)
-{
- STRLEN n_a;
- PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), n_a), TRUE,SVt_PVIO);
- return do_readline();
-}
-#endif
-
PP(pp_rcatline)
{
PL_last_in_gv = cGVOP_gv;
SV *tmpsv;
STRLEN len;
bool multiarg = 0;
+#ifdef VMS
+ VMSISH_HUSHED = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
+#endif
if (SP - MARK != 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
sv_setsv(error,*PL_stack_sp--);
}
}
- DIE(aTHX_ Nullch);
+ DIE(aTHX_ Nullformat);
}
else {
if (SvPOK(error) && SvCUR(error))
dTARGET;
GV *gv;
SV *sv;
+ IO *io;
char *tmps;
STRLEN len;
MAGIC *mg;
gv = (GV *)*++MARK;
if (!isGV(gv))
DIE(aTHX_ PL_no_usym, "filehandle");
- if (GvIOp(gv))
+ if ((io = GvIOp(gv)))
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
- if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
/* Method's args are same as ours ... */
/* ... except handle is replaced by the object */
- *MARK-- = SvTIED_obj((SV*)gv, mg);
+ *MARK-- = SvTIED_obj((SV*)io, mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
{
dSP;
GV *gv;
+ IO *io;
MAGIC *mg;
if (MAXARG == 0)
else
gv = (GV*)POPs;
- if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
ENTER;
call_method("CLOSE", G_SCALAR);
PP(pp_pipe_op)
{
- dSP;
#ifdef HAS_PIPE
+ dSP;
GV *rgv;
GV *wgv;
register IO *rstio;
RETPUSHUNDEF;
gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
ENTER;
call_method("FILENO", G_SCALAR);
PP(pp_umask)
{
dSP; dTARGET;
+#ifdef HAS_UMASK
Mode_t anum;
-#ifdef HAS_UMASK
if (MAXARG < 1) {
anum = PerlLIO_umask(0);
(void)PerlLIO_umask(anum);
PerlIO *fp;
MAGIC *mg;
SV *discp = Nullsv;
- STRLEN len = 0;
- char *names = NULL;
if (MAXARG < 1)
RETPUSHUNDEF;
gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
if (discp)
XPUSHs(discp);
PUTBACK;
RETPUSHUNDEF;
}
- if (discp) {
- names = SvPV(discp,len);
- }
-
if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
(discp) ? SvPV_nolen(discp) : Nullch))
RETPUSHYES;
SV *sv;
I32 markoff = MARK - PL_stack_base;
char *methname;
- int how = 'P';
+ int how = PERL_MAGIC_tied;
U32 items;
STRLEN n_a;
switch(SvTYPE(varsv)) {
case SVt_PVHV:
methname = "TIEHASH";
+ HvEITER((HV *)varsv) = Null(HE *);
break;
case SVt_PVAV:
methname = "TIEARRAY";
break;
case SVt_PVGV:
-#ifdef GV_SHARED_CHECK
- if (GvSHARED((GV*)varsv)) {
- Perl_croak(aTHX_ "Attempt to tie shared GV");
+#ifdef GV_UNIQUE_CHECK
+ if (GvUNIQUE((GV*)varsv)) {
+ Perl_croak(aTHX_ "Attempt to tie unique GV");
}
#endif
methname = "TIEHANDLE";
- how = 'q';
+ how = PERL_MAGIC_tiedscalar;
+ /* For tied filehandles, we apply tiedscalar magic to the IO
+ slot of the GP rather than the GV itself. AMS 20010812 */
+ if (!GvIOp(varsv))
+ GvIOp(varsv) = newIO();
+ varsv = (SV *)GvIOp(varsv);
break;
default:
methname = "TIESCALAR";
- how = 'q';
+ how = PERL_MAGIC_tiedscalar;
break;
}
items = SP - MARK++;
PP(pp_untie)
{
dSP;
+ MAGIC *mg;
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;
+
+ if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv)))
+ RETPUSHYES;
- MAGIC * mg ;
- if ((mg = SvTIED_mg(sv, how))) {
+ if ((mg = SvTIED_mg(sv, how))) {
SV *obj = SvRV(mg->mg_obj);
GV *gv;
CV *cv = NULL;
- if ((gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE)) &&
- isGV(gv) && (cv = GvCV(gv))) {
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
- XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
- PUTBACK;
- ENTER;
- call_sv((SV *)cv, G_VOID);
- LEAVE;
- SPAGAIN;
- }
- else if (ckWARN(WARN_UNTIE)) {
- if (mg && SvREFCNT(obj) > 1)
- Perl_warner(aTHX_ WARN_UNTIE,
- "untie attempted while %"UVuf" inner references still exist",
- (UV)SvREFCNT(obj) - 1 ) ;
+ if (obj) {
+ if ((gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE)) &&
+ isGV(gv) && (cv = GvCV(gv))) {
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
+ PUTBACK;
+ ENTER;
+ call_sv((SV *)cv, G_VOID);
+ LEAVE;
+ SPAGAIN;
+ }
+ else if (ckWARN(WARN_UNTIE)) {
+ if (mg && SvREFCNT(obj) > 1)
+ Perl_warner(aTHX_ WARN_UNTIE,
+ "untie attempted while %"UVuf" inner references still exist",
+ (UV)SvREFCNT(obj) - 1 ) ;
+ }
}
+ sv_unmagic(sv, how) ;
}
- sv_unmagic(sv, how);
RETPUSHYES;
}
PP(pp_tied)
{
dSP;
- SV *sv = POPs;
- char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
MAGIC *mg;
+ SV *sv = POPs;
+ char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
+ ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
+
+ if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv)))
+ RETPUSHUNDEF;
if ((mg = SvTIED_mg(sv, how))) {
SV *osv = SvTIED_obj(sv, mg);
}
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;
PP(pp_sselect)
{
- dSP; dTARGET;
#ifdef HAS_SELECT
+ dSP; dTARGET;
register I32 i;
register I32 j;
register char *s;
{
dSP; dTARGET;
GV *gv;
+ IO *io;
MAGIC *mg;
if (MAXARG == 0)
else
gv = (GV*)POPs;
- if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
I32 gimme = GIMME_V;
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
ENTER;
call_method("GETC", gimme);
else
gv = PL_defoutgv;
- if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
if (MARK == ORIGMARK) {
MEXTEND(SP, 1);
++MARK;
++SP;
}
PUSHMARK(MARK - 1);
- *MARK = SvTIED_obj((SV*)gv, mg);
+ *MARK = SvTIED_obj((SV*)io, mg);
PUTBACK;
ENTER;
call_method("PRINTF", G_SCALAR);
int fp_utf8;
Size_t got = 0;
Size_t wanted;
+ bool charstart = FALSE;
+ STRLEN charskip = 0;
+ STRLEN skip = 0;
gv = (GV*)*++MARK;
- if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) &&
- (mg = SvTIED_mg((SV*)gv, 'q')))
+ if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
+ && gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
{
SV *sv;
PUSHMARK(MARK-1);
- *MARK = SvTIED_obj((SV*)gv, mg);
+ *MARK = SvTIED_obj((SV*)io, mg);
ENTER;
call_method("READ", G_SCALAR);
LEAVE;
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);
DIE(aTHX_ "Negative length");
wanted = length;
+ charstart = TRUE;
+ charskip = 0;
+ skip = 0;
+
#ifdef HAS_SOCKET
if (PL_op->op_type == OP_RECV) {
char namebuf[MAXPATHLEN];
(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);
count = -1;
}
if (count < 0) {
- if ((IoTYPE(io) == IoTYPE_WRONLY || IoIFP(io) == PerlIO_stdout()
- || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO))
+ if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO))
{
/* integrate with report_evil_fh()? */
char *name = NULL;
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) {
- STRLEN skip = UTF8SKIP(buffer);
- if (buffer+skip > bend) {
+ if (charstart) {
+ skip = UTF8SKIP(buffer);
+ charskip = 0;
+ }
+ if (buffer - charskip + skip > bend) {
/* partial character - try for rest of it */
length = skip - (bend-buffer);
offset = bend - SvPVX(bufsv);
+ charstart = FALSE;
+ charskip += count;
goto more_bytes;
}
else {
got++;
buffer += skip;
+ charstart = TRUE;
+ charskip = 0;
}
}
/* If we have not 'got' the number of _characters_ we 'wanted' get some more
provided amount read (count) was what was requested (length)
*/
if (got < wanted && count == length) {
- length = (wanted-got);
+ length = wanted - got;
offset = bend - SvPVX(bufsv);
goto more_bytes;
}
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
+ && gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
SV *sv;
PUSHMARK(MARK-1);
- *MARK = SvTIED_obj((SV*)gv, mg);
+ *MARK = SvTIED_obj((SV*)io, mg);
ENTER;
call_method("WRITE", G_SCALAR);
LEAVE;
if (retval < 0)
goto say_undef;
SP = ORIGMARK;
+ if (DO_UTF8(bufsv))
+ retval = utf8_length((U8*)buffer, (U8*)buffer + retval);
#if Size_t_size > IVSIZE
PUSHn(retval);
#else
{
dSP;
GV *gv;
+ IO *io;
MAGIC *mg;
if (MAXARG == 0) {
if (PL_op->op_flags & OPf_SPECIAL) { /* eof() */
IO *io;
- gv = PL_last_in_gv = PL_argvgv;
+ gv = PL_last_in_gv = GvEGV(PL_argvgv);
io = GvIO(gv);
if (io && !IoIFP(io)) {
if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
else
gv = PL_last_in_gv = (GV*)POPs; /* eof(FH) */
- if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
ENTER;
call_method("EOF", G_SCALAR);
{
dSP; dTARGET;
GV *gv;
+ IO *io;
MAGIC *mg;
if (MAXARG == 0)
else
gv = PL_last_in_gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
ENTER;
call_method("TELL", G_SCALAR);
{
dSP;
GV *gv;
+ IO *io;
int whence = POPi;
#if LSEEKSIZE > IVSIZE
Off_t offset = (Off_t)SvNVx(POPs);
gv = PL_last_in_gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
#if LSEEKSIZE > IVSIZE
XPUSHs(sv_2mortal(newSVnv((NV) offset)));
#else
* 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;
if (SvPOK(argsv)) {
if (s[SvCUR(argsv)] != 17)
DIE(aTHX_ "Possible memory corruption: %s overflowed 3rd argument",
- PL_op_name[optype]);
+ OP_NAME(PL_op));
s[SvCUR(argsv)] = 0; /* put our null back */
SvSETMAGIC(argsv); /* Assume it has changed */
}
PP(pp_flock)
{
+#ifdef FLOCK
dSP; dTARGET;
I32 value;
int argtype;
IO *io = NULL;
PerlIO *fp;
-#ifdef FLOCK
argtype = POPi;
if (MAXARG == 0)
gv = PL_last_in_gv;
PP(pp_socket)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
GV *gv;
register IO *io;
int protocol = POPi;
RETPUSHUNDEF;
}
+ if (IoIFP(io))
+ do_close(gv, FALSE);
+
TAINT_PROPER("socket");
fd = PerlSock_socket(domain, type, protocol);
if (fd < 0)
PP(pp_sockpair)
{
+#if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM))
dSP;
-#ifdef HAS_SOCKETPAIR
GV *gv1;
GV *gv2;
register IO *io1;
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;
PP(pp_bind)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
#ifdef MPE /* Requires PRIV mode to bind() to ports < 1024 */
- extern GETPRIVMODE();
- extern GETUSERMODE();
+ extern void GETPRIVMODE();
+ extern void GETUSERMODE();
#endif
SV *addrsv = POPs;
char *addr;
PP(pp_connect)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
SV *addrsv = POPs;
char *addr;
GV *gv = (GV*)POPs;
PP(pp_listen)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
int backlog = POPi;
GV *gv = (GV*)POPs;
register IO *io = gv ? GvIOn(gv) : NULL;
PP(pp_accept)
{
- dSP; dTARGET;
#ifdef HAS_SOCKET
+ dSP; dTARGET;
GV *ngv;
GV *ggv;
register IO *nstio;
struct sockaddr saddr; /* use a struct to avoid alignment problems */
Sock_size_t len = sizeof saddr;
int fd;
+ int fd2;
ggv = (GV*)POPs;
ngv = (GV*)POPs;
goto nuts;
nstio = GvIOn(ngv);
- if (IoIFP(nstio))
- do_close(ngv, FALSE);
-
fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
if (fd < 0)
goto badexit;
+ if (IoIFP(nstio))
+ do_close(ngv, FALSE);
IoIFP(nstio) = PerlIO_fdopen(fd, "r");
- IoOFP(nstio) = PerlIO_fdopen(fd, "w");
+ /* FIXME: we dup(fd) here so that refcounting of fd's does not inhibit
+ fclose of IoOFP's FILE * - and hence leak memory.
+ Special treatment of _this_ case of IoIFP != IoOFP seems wrong.
+ */
+ IoOFP(nstio) = PerlIO_fdopen(fd2 = PerlLIO_dup(fd), "w");
IoTYPE(nstio) = IoTYPE_SOCKET;
if (!IoIFP(nstio) || !IoOFP(nstio)) {
if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */
+ fcntl(fd2, F_SETFD, fd2 > PL_maxsysfd); /* ensure close-on-exec */
#endif
#ifdef EPOC
PP(pp_shutdown)
{
- dSP; dTARGET;
#ifdef HAS_SOCKET
+ dSP; dTARGET;
int how = POPi;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
PP(pp_ssockopt)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
int optype = PL_op->op_type;
SV *sv;
int fd;
PP(pp_getpeername)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
int optype = PL_op->op_type;
SV *sv;
int fd;
if (PL_op->op_flags & OPf_REF) {
gv = cGVOP_gv;
if (PL_op->op_type == OP_LSTAT) {
- if (PL_laststype != OP_LSTAT)
- Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
- if (ckWARN(WARN_IO) && gv != PL_defgv)
- Perl_warner(aTHX_ WARN_IO,
+ if (gv != PL_defgv) {
+ if (ckWARN(WARN_IO))
+ Perl_warner(aTHX_ WARN_IO,
"lstat() on filehandle %s", GvENAME(gv));
- /* Perl_my_lstat (-l) croak's on filehandle, why warn here? */
+ } else if (PL_laststype != OP_LSTAT)
+ Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
}
do_fstat:
}
else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
gv = (GV*)SvRV(sv);
+ if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO))
+ Perl_warner(aTHX_ WARN_IO,
+ "lstat() on filehandle %s", GvENAME(gv));
goto do_fstat;
}
sv_setpv(PL_statname, SvPV(sv,n_a));
really_filename:
PL_statgv = Nullgv;
PL_laststatval = -1;
+ PL_laststype = OP_STAT;
sv_setpv(PL_statname, SvPV(sv, n_a));
if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) {
if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
#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 */
SV **svp;
STRLEN n_a;
- if (MAXARG < 1)
- tmps = Nullch;
+ if( MAXARG == 1 )
+ tmps = POPpx;
else
- tmps = POPpx;
- if (!tmps || !*tmps) {
- svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE);
- if (svp)
- tmps = SvPV(*svp, n_a);
- }
- if (!tmps || !*tmps) {
- svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE);
- if (svp)
- tmps = SvPV(*svp, n_a);
- }
+ tmps = 0;
+
+ if( !tmps || !*tmps ) {
+ if ( (svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE))
+ || (svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE))
#ifdef VMS
- if (!tmps || !*tmps) {
- svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE);
- if (svp)
- tmps = SvPV(*svp, n_a);
- }
+ || (svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE))
#endif
+ )
+ {
+ if( MAXARG == 1 )
+ deprecate("chdir('') or chdir(undef) as chdir()");
+ tmps = SvPV(*svp, n_a);
+ }
+ else {
+ PUSHi(0);
+ TAINT_PROPER("chdir");
+ RETURN;
+ }
+ }
+
TAINT_PROPER("chdir");
PUSHi( PerlDir_chdir(tmps) >= 0 );
#ifdef VMS
PP(pp_chown)
{
- dSP; dMARK; dTARGET;
- I32 value;
#ifdef HAS_CHOWN
- value = (I32)apply(PL_op->op_type, MARK, SP);
+ dSP; dMARK; dTARGET;
+ I32 value = (I32)apply(PL_op->op_type, MARK, SP);
+
SP = MARK;
PUSHi(value);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function chown");
+ DIE(aTHX_ PL_no_func, "chown");
#endif
}
PP(pp_chroot)
{
- dSP; dTARGET;
- char *tmps;
#ifdef HAS_CHROOT
+ dSP; dTARGET;
STRLEN n_a;
- tmps = POPpx;
+ char *tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
RETURN;
PP(pp_link)
{
- dSP; dTARGET;
#ifdef HAS_LINK
+ dSP; dTARGET;
STRLEN n_a;
char *tmps2 = POPpx;
char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("link");
SETi( PerlLIO_link(tmps, tmps2) >= 0 );
+ RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function link");
+ DIE(aTHX_ PL_no_func, "link");
#endif
- RETURN;
}
PP(pp_symlink)
{
- dSP; dTARGET;
#ifdef HAS_SYMLINK
+ dSP; dTARGET;
STRLEN n_a;
char *tmps2 = POPpx;
char *tmps = SvPV(TOPs, n_a);
PP(pp_readlink)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_SYMLINK
+ dTARGET;
char *tmps;
char buf[MAXPATHLEN];
int len;
TAINT;
#endif
tmps = POPpx;
- len = readlink(tmps, buf, sizeof buf);
+ len = readlink(tmps, buf, sizeof(buf) - 1);
EXTEND(SP, 1);
if (len < 0)
RETPUSHUNDEF;
PP(pp_open_dir)
{
- dSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
+ dSP;
STRLEN n_a;
char *dirname = POPpx;
GV *gv = (GV*)POPs;
PP(pp_readdir)
{
- dSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
-#ifndef I_DIRENT
+ dSP;
+#if !defined(I_DIRENT) && !defined(VMS)
Direntry_t *readdir (DIR *);
#endif
register Direntry_t *dp;
PP(pp_telldir)
{
- dSP; dTARGET;
#if defined(HAS_TELLDIR) || defined(telldir)
+ dSP; dTARGET;
/* XXX does _anyone_ need this? --AD 2/20/1998 */
/* XXX netbsd still seemed to.
XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style.
PP(pp_seekdir)
{
- dSP;
#if defined(HAS_SEEKDIR) || defined(seekdir)
+ dSP;
long along = POPl;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
PP(pp_rewinddir)
{
- dSP;
#if defined(HAS_REWINDDIR) || defined(rewinddir)
+ dSP;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
PP(pp_closedir)
{
- dSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
+ dSP;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
EXTEND(SP, 1);
PERL_FLUSHALL_FOR_CHILD;
- childpid = fork();
+ childpid = PerlProc_fork();
if (childpid < 0)
RETSETUNDEF;
if (!childpid) {
/*SUPPRESS 560*/
- if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV)))
+ if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV))) {
+ SvREADONLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
+ SvREADONLY_on(GvSV(tmpgv));
+ }
hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
}
PUSHi(childpid);
PUSHi(childpid);
RETURN;
# else
- DIE(aTHX_ PL_no_func, "Unsupported function fork");
+ DIE(aTHX_ PL_no_func, "fork");
# endif
#endif
}
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);
XPUSHi(childpid);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function wait");
+ DIE(aTHX_ PL_no_func, "wait");
#endif
}
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);
SETi(childpid);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function waitpid");
+ DIE(aTHX_ PL_no_func, "waitpid");
#endif
}
{
dSP; dMARK; dORIGMARK; dTARGET;
I32 value;
- Pid_t childpid;
- int result;
- int status;
- Sigsave_t ihand,qhand; /* place to save signals during system() */
STRLEN n_a;
- I32 did_pipes = 0;
+ int result;
int pp[2];
+ I32 did_pipes = 0;
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");
}
}
PERL_FLUSHALL_FOR_CHILD;
-#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) && !defined(__CYGWIN__) || defined(PERL_MICRO)
- if (PerlProc_pipe(pp) >= 0)
- did_pipes = 1;
- while ((childpid = vfork()) == -1) {
- if (errno != EAGAIN) {
- value = -1;
- SP = ORIGMARK;
- PUSHi(value);
- if (did_pipes) {
- PerlLIO_close(pp[0]);
- PerlLIO_close(pp[1]);
- }
- RETURN;
- }
- sleep(5);
- }
- if (childpid > 0) {
- if (did_pipes)
- PerlLIO_close(pp[1]);
+#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)
+ {
+ Pid_t childpid;
+ int status;
+ Sigsave_t ihand,qhand; /* place to save signals during system() */
+
+ if (PL_tainting) {
+ SV *cmd = NULL;
+ if (PL_op->op_flags & OPf_STACKED)
+ cmd = *(MARK + 1);
+ else if (SP - MARK != 1)
+ cmd = *SP;
+ if (cmd && *(SvPV_nolen(cmd)) != '/')
+ TAINT_ENV();
+ }
+
+ if (PerlProc_pipe(pp) >= 0)
+ did_pipes = 1;
+ while ((childpid = PerlProc_fork()) == -1) {
+ if (errno != EAGAIN) {
+ value = -1;
+ SP = ORIGMARK;
+ PUSHi(value);
+ if (did_pipes) {
+ PerlLIO_close(pp[0]);
+ PerlLIO_close(pp[1]);
+ }
+ RETURN;
+ }
+ sleep(5);
+ }
+ if (childpid > 0) {
+ if (did_pipes)
+ PerlLIO_close(pp[1]);
#ifndef PERL_MICRO
- rsignal_save(SIGINT, SIG_IGN, &ihand);
- rsignal_save(SIGQUIT, SIG_IGN, &qhand);
+ rsignal_save(SIGINT, SIG_IGN, &ihand);
+ rsignal_save(SIGQUIT, SIG_IGN, &qhand);
#endif
- do {
- result = wait4pid(childpid, &status, 0);
- } while (result == -1 && errno == EINTR);
+ do {
+ result = wait4pid(childpid, &status, 0);
+ } while (result == -1 && errno == EINTR);
#ifndef PERL_MICRO
- (void)rsignal_restore(SIGINT, &ihand);
- (void)rsignal_restore(SIGQUIT, &qhand);
-#endif
- STATUS_NATIVE_SET(result == -1 ? -1 : status);
- do_execfree(); /* free any memory child malloced on vfork */
- SP = ORIGMARK;
- if (did_pipes) {
- int errkid;
- int n = 0, n1;
-
- while (n < sizeof(int)) {
- n1 = PerlLIO_read(pp[0],
- (void*)(((char*)&errkid)+n),
- (sizeof(int)) - n);
- if (n1 <= 0)
- break;
- n += n1;
- }
- PerlLIO_close(pp[0]);
- if (n) { /* Error */
- if (n != sizeof(int))
- DIE(aTHX_ "panic: kid popen errno read");
- errno = errkid; /* Propagate errno from kid */
- STATUS_CURRENT = -1;
- }
- }
- PUSHi(STATUS_CURRENT);
- RETURN;
- }
- if (did_pipes) {
- PerlLIO_close(pp[0]);
+ (void)rsignal_restore(SIGINT, &ihand);
+ (void)rsignal_restore(SIGQUIT, &qhand);
+#endif
+ STATUS_NATIVE_SET(result == -1 ? -1 : status);
+ do_execfree(); /* free any memory child malloced on fork */
+ SP = ORIGMARK;
+ if (did_pipes) {
+ int errkid;
+ int n = 0, n1;
+
+ while (n < sizeof(int)) {
+ n1 = PerlLIO_read(pp[0],
+ (void*)(((char*)&errkid)+n),
+ (sizeof(int)) - n);
+ if (n1 <= 0)
+ break;
+ n += n1;
+ }
+ PerlLIO_close(pp[0]);
+ if (n) { /* Error */
+ if (n != sizeof(int))
+ DIE(aTHX_ "panic: kid popen errno read");
+ errno = errkid; /* Propagate errno from kid */
+ STATUS_CURRENT = -1;
+ }
+ }
+ PUSHi(STATUS_CURRENT);
+ RETURN;
+ }
+ if (did_pipes) {
+ PerlLIO_close(pp[0]);
#if defined(HAS_FCNTL) && defined(F_SETFD)
- fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+ fcntl(pp[1], F_SETFD, FD_CLOEXEC);
#endif
+ }
}
if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
#endif
else {
if (PL_tainting) {
- char *junk = SvPV(*SP, n_a);
+ (void)SvPV_nolen(*SP); /* stringify for taint check */
TAINT_ENV();
TAINT_PROPER("exec");
}
#endif
}
-#if !defined(HAS_FORK) && defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
- if (value >= 0)
- my_exit(value);
-#endif
-
SP = ORIGMARK;
PUSHi(value);
RETURN;
PP(pp_kill)
{
+#ifdef HAS_KILL
dSP; dMARK; dTARGET;
I32 value;
-#ifdef HAS_KILL
value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
PUSHi(value);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function kill");
+ DIE(aTHX_ PL_no_func, "kill");
#endif
}
PP(pp_getpriority)
{
- dSP; dTARGET;
- int which;
- int who;
#ifdef HAS_GETPRIORITY
- who = POPi;
- which = TOPi;
+ dSP; dTARGET;
+ 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;
+ dSP; dTARGET;
+ int niceval = POPi;
+ int who = POPi;
+ int which = TOPi;
TAINT_PROPER("setpriority");
SETi( setpriority(which, who, niceval) >= 0 );
RETURN;
it's supported. --AD 9/96.
*/
+#ifdef __BEOS__
+# define HZ 1000000
+#endif
+
#ifndef HZ
# ifdef CLK_TCK
# define HZ CLK_TCK
PP(pp_tms)
{
+#ifdef HAS_TIMES
dSP;
-
-#ifndef HAS_TIMES
- DIE(aTHX_ "times not implemented");
-#else
EXTEND(SP, 4);
-
#ifndef VMS
(void)PerlProc_times(&PL_timesbuf);
#else
PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cstime)/HZ)));
}
RETURN;
+#else
+ DIE(aTHX_ "times not implemented");
#endif /* HAS_TIMES */
}
else
tmbuf = gmtime(&when);
- EXTEND(SP, 9);
- EXTEND_MORTAL(9);
if (GIMME != G_ARRAY) {
SV *tsv;
+ EXTEND(SP, 1);
+ EXTEND_MORTAL(1);
if (!tmbuf)
RETPUSHUNDEF;
tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %d",
PUSHs(sv_2mortal(tsv));
}
else if (tmbuf) {
- PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec)));
+ EXTEND(SP, 9);
+ EXTEND_MORTAL(9);
+ PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec)));
PUSHs(sv_2mortal(newSViv(tmbuf->tm_min)));
PUSHs(sv_2mortal(newSViv(tmbuf->tm_hour)));
PUSHs(sv_2mortal(newSViv(tmbuf->tm_mday)));
PP(pp_alarm)
{
+#ifdef HAS_ALARM
dSP; dTARGET;
int anum;
-#ifdef HAS_ALARM
anum = POPi;
anum = alarm((unsigned int)anum);
EXTEND(SP, 1);
PUSHi(anum);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function alarm");
+ DIE(aTHX_ PL_no_func, "alarm");
#endif
}
PP(pp_ghostent)
{
- dSP;
#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
+ dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
PP(pp_gnetent)
{
- dSP;
#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
+ dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
if (which == OP_GNBYNAME)
#ifdef HAS_GETNETBYNAME
- nent = PerlSock_getnetbyname(POPpx);
+ nent = PerlSock_getnetbyname(POPpbytex);
#else
DIE(aTHX_ PL_no_sock_func, "getnetbyname");
#endif
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");
PP(pp_gprotoent)
{
- dSP;
#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
+ dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
if (which == OP_GPBYNAME)
#ifdef HAS_GETPROTOBYNAME
- pent = PerlSock_getprotobyname(POPpx);
+ pent = PerlSock_getprotobyname(POPpbytex);
#else
DIE(aTHX_ PL_no_sock_func, "getprotobyname");
#endif
PP(pp_gservent)
{
- dSP;
#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
+ dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
if (which == OP_GSBYNAME) {
#ifdef HAS_GETSERVBYNAME
- char *proto = POPpx;
- char *name = POPpx;
+ char *proto = POPpbytex;
+ char *name = POPpbytex;
if (proto && !*proto)
proto = Nullch;
}
else if (which == OP_GSBYPORT) {
#ifdef HAS_GETSERVBYPORT
- char *proto = POPpx;
+ char *proto = POPpbytex;
unsigned short port = POPu;
#ifdef HAS_HTONS
PP(pp_shostent)
{
- dSP;
#ifdef HAS_SETHOSTENT
+ dSP;
PerlSock_sethostent(TOPi);
RETSETYES;
#else
PP(pp_snetent)
{
- dSP;
#ifdef HAS_SETNETENT
+ dSP;
PerlSock_setnetent(TOPi);
RETSETYES;
#else
PP(pp_sprotoent)
{
- dSP;
#ifdef HAS_SETPROTOENT
+ dSP;
PerlSock_setprotoent(TOPi);
RETSETYES;
#else
PP(pp_sservent)
{
- dSP;
#ifdef HAS_SETSERVENT
+ dSP;
PerlSock_setservent(TOPi);
RETSETYES;
#else
PP(pp_ehostent)
{
- dSP;
#ifdef HAS_ENDHOSTENT
+ dSP;
PerlSock_endhostent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_enetent)
{
- dSP;
#ifdef HAS_ENDNETENT
+ dSP;
PerlSock_endnetent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_eprotoent)
{
- dSP;
#ifdef HAS_ENDPROTOENT
+ dSP;
PerlSock_endprotoent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_eservent)
{
- dSP;
#ifdef HAS_ENDSERVENT
+ dSP;
PerlSock_endservent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_gpwent)
{
- dSP;
#ifdef HAS_PASSWD
+ dSP;
I32 which = PL_op->op_type;
register SV *sv;
STRLEN n_a;
switch (which) {
case OP_GPWNAM:
- pwent = getpwnam(POPpx);
+ pwent = getpwnam(POPpbytex);
break;
case OP_GPWUID:
pwent = getpwuid((Uid_t)POPi);
PP(pp_spwent)
{
- dSP;
#if defined(HAS_PASSWD) && defined(HAS_SETPWENT)
+ dSP;
setpwent();
RETPUSHYES;
#else
PP(pp_epwent)
{
- dSP;
#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
+ dSP;
endpwent();
RETPUSHYES;
#else
PP(pp_ggrent)
{
- dSP;
#ifdef HAS_GROUP
+ dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
STRLEN n_a;
if (which == OP_GGRNAM)
- grent = (struct group *)getgrnam(POPpx);
+ grent = (struct group *)getgrnam(POPpbytex);
else if (which == OP_GGRGID)
grent = (struct group *)getgrgid(POPi);
else
PP(pp_sgrent)
{
- dSP;
#if defined(HAS_GROUP) && defined(HAS_SETGRENT)
+ dSP;
setgrent();
RETPUSHYES;
#else
PP(pp_egrent)
{
- dSP;
#if defined(HAS_GROUP) && defined(HAS_ENDGRENT)
+ dSP;
endgrent();
RETPUSHYES;
#else
PP(pp_getlogin)
{
- dSP; dTARGET;
#ifdef HAS_GETLOGIN
+ dSP; dTARGET;
char *tmps;
EXTEND(SP, 1);
if (!(tmps = PerlProc_getlogin()))
https://perl5.git.perl.org / perl5.git / blobdiff