PUTBACK;
if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
(discp) ? SvPV_nolen(discp) : Nullch)) {
+ if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
+ if (!PerlIO_binmode(aTHX_ IoOFP(io),IoTYPE(io),
+ mode_from_discipline(discp),
+ (discp) ? SvPV_nolen(discp) : Nullch)) {
+ SPAGAIN;
+ RETPUSHUNDEF;
+ }
+ }
SPAGAIN;
RETPUSHYES;
}
RETPUSHYES;
if ((mg = SvTIED_mg(sv, how))) {
- SV *obj = SvRV(mg->mg_obj);
+ SV *obj = SvRV(SvTIED_obj(sv, mg));
GV *gv;
CV *cv = NULL;
if (obj) {
(UV)SvREFCNT(obj) - 1 ) ;
}
}
- sv_unmagic(sv, how) ;
}
+ sv_unmagic(sv, how) ;
RETPUSHYES;
}
Zero(&fd_sets[0], 4, char*);
#endif
-# if SELECT_MIN_BITS > 1
+# if SELECT_MIN_BITS == 1
+ growsize = sizeof(fd_set);
+# else
+# if defined(__GLIBC__) && defined(__FD_SETSIZE)
+# undef SELECT_MIN_BITS
+# define SELECT_MIN_BITS __FD_SETSIZE
+# endif
/* If SELECT_MIN_BITS is greater than one we most probably will want
* to align the sizes with SELECT_MIN_BITS/8 because for example
* in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
* UNIX, Solaris, NeXT, Darwin) the smallest quantum select() operates
* on (sets/tests/clears bits) is 32 bits. */
growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
-# else
- growsize = sizeof(fd_set);
# endif
sv = SP[4];
buffer = SvPVutf8(bufsv, blen);
}
else {
- if (DO_UTF8(bufsv))
- sv_utf8_downgrade(bufsv, FALSE);
- buffer = SvPV(bufsv, blen);
+ if (DO_UTF8(bufsv)) {
+ /* Not modifying source SV, so making a temporary copy. */
+ bufsv = sv_2mortal(newSVsv(bufsv));
+ sv_utf8_downgrade(bufsv, FALSE);
+ }
+ buffer = SvPV(bufsv, blen);
}
if (PL_op->op_type == OP_SYSWRITE) {
#else
retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
#endif
+#endif
+#if defined(HAS_IOCTL) || defined(HAS_FCNTL)
if (SvPOK(argsv)) {
if (s[SvCUR(argsv)] != 17)
DIE(aTHX_ "Possible memory corruption: %s overflowed 3rd argument",
GV *ggv;
register IO *nstio;
register IO *gstio;
- struct sockaddr saddr; /* use a struct to avoid alignment problems */
- Sock_size_t len = sizeof saddr;
+ char namebuf[MAXPATHLEN];
+#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE) || defined(__QNXNTO__)
+ Sock_size_t len = sizeof (struct sockaddr_in);
+#else
+ Sock_size_t len = sizeof namebuf;
+#endif
int fd;
ggv = (GV*)POPs;
goto nuts;
nstio = GvIOn(ngv);
- fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
+ fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len);
if (fd < 0)
goto badexit;
if (IoIFP(nstio))
#endif
#ifdef EPOC
- len = sizeof saddr; /* EPOC somehow truncates info */
+ len = sizeof (struct sockaddr_in); /* EPOC somehow truncates info */
setbuf( IoIFP(nstio), NULL); /* EPOC gets confused about sockets */
#endif
+#ifdef __SCO_VERSION__
+ len = sizeof (struct sockaddr_in); /* OpenUNIX 8 somehow truncates info */
+#endif
- PUSHp((char *)&saddr, len);
+ PUSHp(namebuf, len);
RETURN;
nuts:
dSP;
#if defined(HAS_ACCESS) && defined(R_OK)
STRLEN n_a;
- if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
- result = access(TOPpx, R_OK);
+ if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ result = access(POPpx, R_OK);
if (result == 0)
RETPUSHYES;
if (result < 0)
dSP;
#if defined(HAS_ACCESS) && defined(W_OK)
STRLEN n_a;
- if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
- result = access(TOPpx, W_OK);
+ if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ result = access(POPpx, W_OK);
if (result == 0)
RETPUSHYES;
if (result < 0)
dSP;
#if defined(HAS_ACCESS) && defined(X_OK)
STRLEN n_a;
- if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
- result = access(TOPpx, X_OK);
+ if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ result = access(POPpx, X_OK);
if (result == 0)
RETPUSHYES;
if (result < 0)
dSP;
#ifdef PERL_EFF_ACCESS_R_OK
STRLEN n_a;
- if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
- result = PERL_EFF_ACCESS_R_OK(TOPpx);
+ if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ result = PERL_EFF_ACCESS_R_OK(POPpx);
if (result == 0)
RETPUSHYES;
if (result < 0)
dSP;
#ifdef PERL_EFF_ACCESS_W_OK
STRLEN n_a;
- if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
- result = PERL_EFF_ACCESS_W_OK(TOPpx);
+ if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ result = PERL_EFF_ACCESS_W_OK(POPpx);
if (result == 0)
RETPUSHYES;
if (result < 0)
dSP;
#ifdef PERL_EFF_ACCESS_X_OK
STRLEN n_a;
- if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
- result = PERL_EFF_ACCESS_X_OK(TOPpx);
+ if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ result = PERL_EFF_ACCESS_X_OK(POPpx);
if (result == 0)
RETPUSHYES;
if (result < 0)
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'))
+ if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
RETPUSHUNDEF;
}
result = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
-# ifdef WIN32
+# if defined(WIN32) || defined(OS2)
value = (I32)do_aspawn(really, MARK, SP);
# else
value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
# endif
}
else if (SP - MARK != 1) {
-# ifdef WIN32
+# if defined(WIN32) || defined(OS2)
value = (I32)do_aspawn(Nullsv, MARK, SP);
# else
value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
}
RETURN;
#else
+# ifdef PERL_MICRO
+ dSP;
+ PUSHs(sv_2mortal(newSVnv((NV)0.0)));
+ EXTEND(SP, 4);
+ if (GIMME == G_ARRAY) {
+ PUSHs(sv_2mortal(newSVnv((NV)0.0)));
+ PUSHs(sv_2mortal(newSVnv((NV)0.0)));
+ PUSHs(sv_2mortal(newSVnv((NV)0.0)));
+ }
+ RETURN;
+# else
DIE(aTHX_ "times not implemented");
+# endif
#endif /* HAS_TIMES */
}
* AIX getpwnam() is clever enough to return the encrypted password
* only if the caller (euid?) is root.
*
- * There are at least two other shadow password APIs. Many platforms
+ * There are at least three other shadow password APIs. Many platforms
* seem to contain more than one interface for accessing the shadow
* password databases, possibly for compatibility reasons.
* The getsp*() is by far he simplest one, the other two interfaces
* char *(getespw*(...).ufld.fd_encrypt)
* Mention HAS_GETESPWNAM here so that Configure probes for it.
*
+ * <userpw.h> (AIX)
+ * struct userpw *getuserpw();
+ * The password is in
+ * char *(getuserpw(...)).spw_upw_passwd
+ * (but the de facto standard getpwnam() should work okay)
+ *
* Mention I_PROT here so that Configure probes for it.
*
* In HP-UX for getprpw*() the manual page claims that one should include
* Divert the urge to writing an extension instead.
*
* --jhi */
-# ifdef HAS_GETSPNAM
+ /* Some AIX setups falsely(?) detect some getspnam(), which
+ * has a different API than the Solaris/IRIX one. */
+# if defined(HAS_GETSPNAM) && !defined(_AIX)
{
struct spwd *spwent;
int saverrno; /* Save and restore errno so that
projects / p5sagit/p5-mst-13.2.git / blobdiff