# if defined(I_SYS_SECURITY)
# include <sys/security.h>
# endif
- /* XXX Configure test needed for eaccess */
# ifdef ACC_SELF
/* HP SecureWare */
# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
STRLEN n_a;
char *tmps = POPpx;
I32 gimme = GIMME_V;
+ char *mode = "r";
TAINT_PROPER("``");
- fp = PerlProc_popen(tmps, "r");
+ if (PL_op->op_private & OPpOPEN_IN_RAW)
+ mode = "rb";
+ else if (PL_op->op_private & OPpOPEN_IN_CRLF)
+ mode = "rt";
+ fp = PerlProc_popen(tmps, mode);
if (fp) {
if (gimme == G_VOID) {
char tmpbuf[256];
GV *gv = gv_fetchmethod(stash, "PROPAGATE");
if (gv) {
SV *file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
- SV *line = sv_2mortal(newSViv(CopLINE(PL_curcop)));
+ SV *line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
EXTEND(SP, 3);
PUSHMARK(SP);
PUSHs(error);
IO *io;
PerlIO *fp;
MAGIC *mg;
+ SV *discp = Nullsv;
if (MAXARG < 1)
RETPUSHUNDEF;
+ if (MAXARG > 1)
+ discp = POPs;
gv = (GV*)POPs;
if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
+ if (discp)
+ XPUSHs(discp);
PUTBACK;
ENTER;
call_method("BINMODE", G_SCALAR);
if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
RETPUSHUNDEF;
- if (do_binmode(fp,IoTYPE(io),TRUE))
+ if (do_binmode(fp,IoTYPE(io),mode_from_discipline(discp)))
RETPUSHYES;
else
RETPUSHUNDEF;
}
-
PP(pp_tie)
{
djSP;
PUSHs(sv);
PUSHs(left);
if (SvIV(right))
- PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT)));
+ PUSHs(sv_2mortal(newSVuv(O_RDWR|O_CREAT)));
else
- PUSHs(sv_2mortal(newSViv(O_RDWR)));
+ PUSHs(sv_2mortal(newSVuv(O_RDWR)));
PUSHs(right);
PUTBACK;
call_sv((SV*)GvCV(gv), G_SCALAR);
PUSHMARK(SP);
PUSHs(sv);
PUSHs(left);
- PUSHs(sv_2mortal(newSViv(O_RDONLY)));
+ PUSHs(sv_2mortal(newSVuv(O_RDONLY)));
PUSHs(right);
PUTBACK;
call_sv((SV*)GvCV(gv), G_SCALAR);
djSP; dMARK; dORIGMARK; dTARGET;
GV *gv;
IO *io;
- Off_t offset;
SV *bufsv;
char *buffer;
- Off_t length;
+ Size_t length;
+ SSize_t retval;
+ IV offset;
STRLEN blen;
MAGIC *mg;
goto say_undef;
bufsv = *++MARK;
buffer = SvPV(bufsv, blen);
-#if Off_t_SIZE > IVSIZE
- length = SvNVx(*++MARK);
+#if Size_t_size > IVSIZE
+ length = (Size_t)SvNVx(*++MARK);
#else
- length = SvIVx(*++MARK);
+ length = (Size_t)SvIVx(*++MARK);
#endif
- if (length < 0)
+ if ((SSize_t)length < 0)
DIE(aTHX_ "Negative length");
SETERRNO(0,0);
io = GvIO(gv);
if (!io || !IoIFP(io)) {
- length = -1;
+ retval = -1;
if (ckWARN(WARN_CLOSED)) {
if (PL_op->op_type == OP_SYSWRITE)
report_closed_fh(gv, io, "syswrite", "filehandle");
}
else if (PL_op->op_type == OP_SYSWRITE) {
if (MARK < SP) {
-#if Off_t_SIZE > IVSIZE
- offset = SvNVx(*++MARK);
-#else
offset = SvIVx(*++MARK);
-#endif
if (offset < 0) {
if (-offset > blen)
DIE(aTHX_ "Offset outside string");
length = blen - offset;
#ifdef PERL_SOCK_SYSWRITE_IS_SEND
if (IoTYPE(io) == 's') {
- length = PerlSock_send(PerlIO_fileno(IoIFP(io)),
+ retval = PerlSock_send(PerlIO_fileno(IoIFP(io)),
buffer+offset, length, 0);
}
else
#endif
{
/* See the note at doio.c:do_print about filesize limits. --jhi */
- length = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
+ retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
buffer+offset, length);
}
}
char *sockbuf;
STRLEN mlen;
sockbuf = SvPVx(*++MARK, mlen);
- length = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length,
- (struct sockaddr *)sockbuf, mlen);
+ retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
+ length, (struct sockaddr *)sockbuf, mlen);
}
else
- length = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
+ retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
#else
else
DIE(aTHX_ PL_no_sock_func, "send");
#endif
- if (length < 0)
+ if (retval < 0)
goto say_undef;
SP = ORIGMARK;
- PUSHi(length);
+#if Size_t_size > IVSIZE
+ PUSHn(retval);
+#else
+ PUSHi(retval);
+#endif
RETURN;
say_undef:
#if LSEEKSIZE > IVSIZE
XPUSHs(sv_2mortal(newSVnv((NV) offset)));
#else
- XPUSHs(sv_2mortal(newSViv((IV) offset)));
+ XPUSHs(sv_2mortal(newSViv(offset)));
#endif
- XPUSHs(sv_2mortal(newSViv((IV) whence)));
+ XPUSHs(sv_2mortal(newSViv(whence)));
PUTBACK;
ENTER;
call_method("SEEK", G_SCALAR);
if (PL_op->op_type == OP_SEEK)
PUSHs(boolSV(do_seek(gv, offset, whence)));
else {
- Off_t n = do_sysseek(gv, offset, whence);
- if (n < 0)
+ Off_t sought = do_sysseek(gv, offset, whence);
+ if (sought < 0)
PUSHs(&PL_sv_undef);
else {
- SV* sv = n ?
+ SV* sv = sought ?
#if LSEEKSIZE > IVSIZE
- newSVnv((NV)n)
+ newSVnv((NV)sought)
#else
- newSViv((IV)n)
+ newSViv(sought)
#endif
: newSVpvn(zero_but_true, ZBTLEN);
PUSHs(sv_2mortal(sv));
PP(pp_truncate)
{
djSP;
- Off_t len = (Off_t)POPn;
+ /* There seems to be no consensus on the length type of truncate()
+ * and ftruncate(), both off_t and size_t have supporters. In
+ * general one would think that when using large files, off_t is
+ * 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;
+#else
+ len = (Off_t)POPi;
+#endif
+ /* Checking for length < 0 is problematic as the type might or
+ * might not be signed: if it is not, clever compilers will moan. */
+ /* 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) {
EXTEND_MORTAL(max);
PUSHs(sv_2mortal(newSViv(PL_statcache.st_dev)));
PUSHs(sv_2mortal(newSViv(PL_statcache.st_ino)));
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_mode)));
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_nlink)));
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_mode)));
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_nlink)));
#if Uid_t_size > IVSIZE
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_uid)));
#else
+# if Uid_t_sign <= 0
PUSHs(sv_2mortal(newSViv(PL_statcache.st_uid)));
+# else
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_uid)));
+# endif
#endif
#if Gid_t_size > IVSIZE
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_gid)));
#else
+# if Gid_t_sign <= 0
PUSHs(sv_2mortal(newSViv(PL_statcache.st_gid)));
+# else
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_gid)));
+# endif
#endif
#ifdef USE_STAT_RDEV
PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev)));
PUSHs(sv_2mortal(newSViv(PL_statcache.st_ctime)));
#endif
#ifdef USE_STAT_BLOCKS
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_blksize)));
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_blocks)));
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blksize)));
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blocks)));
#else
PUSHs(sv_2mortal(newSVpvn("", 0)));
PUSHs(sv_2mortal(newSVpvn("", 0)));
(void)PerlIO_close(fp);
RETPUSHUNDEF;
}
- do_binmode(fp, '<', TRUE);
+ do_binmode(fp, '<', O_BINARY);
len = PerlIO_read(fp, tbuf, sizeof(tbuf));
(void)PerlIO_close(fp);
if (len <= 0) {
#else
else if (*s & 128) {
#ifdef USE_LOCALE
- if (!(PL_op->op_private & OPpLOCALE) || !isALPHA_LC(*s))
-#endif
- odd++;
+ if ((PL_op->op_private & OPpLOCALE) && isALPHA_LC(*s))
+ continue;
+#endif
+ /* utf8 characters don't count as odd */
+ if (*s & 0x40) {
+ int ulen = UTF8SKIP(s);
+ if (ulen < len - i) {
+ int j;
+ for (j = 1; j < ulen; j++) {
+ if ((s[j] & 0xc0) != 0x80)
+ goto not_utf8;
+ }
+ --ulen; /* loop does extra increment */
+ s += ulen;
+ i += ulen;
+ continue;
+ }
+ }
+ not_utf8:
+ odd++;
}
else if (*s < 32 &&
*s != '\n' && *s != '\r' && *s != '\b' &&
SV *tsv;
if (!tmbuf)
RETPUSHUNDEF;
- tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %d",
+ tsv = Perl_newSVpvf(aTHX_ "%s %s %2"IVdf" %02"IVdf":%02"IVdf":%02"IVdf" %"IVdf,
dayname[tmbuf->tm_wday],
monname[tmbuf->tm_mon],
- tmbuf->tm_mday,
- tmbuf->tm_hour,
- tmbuf->tm_min,
- tmbuf->tm_sec,
- tmbuf->tm_year + 1900);
+ (IV)tmbuf->tm_mday,
+ (IV)tmbuf->tm_hour,
+ (IV)tmbuf->tm_min,
+ (IV)tmbuf->tm_sec,
+ (IV)tmbuf->tm_year + 1900);
PUSHs(sv_2mortal(tsv));
}
else if (tmbuf) {
#ifdef HAS_PASSWD
I32 which = PL_op->op_type;
register SV *sv;
- struct passwd *pwent;
STRLEN n_a;
-#if defined(HAS_GETSPENT) || defined(HAS_GETSPNAM)
- struct spwd *spwent = NULL;
-#endif
+ struct passwd *pwent = NULL;
+/* We do not use HAS_GETSPENT in pp_gpwent() but leave it here in the case
+ * somebody wants to write an XS to access the shadow passwords. --jhi */
+# ifdef HAS_GETSPNAM
+ struct spwd *spwent = NULL;
+# endif
- if (which == OP_GPWNAM)
- pwent = getpwnam(POPpx);
- else if (which == OP_GPWUID)
- pwent = getpwuid(POPi);
- else
-#ifdef HAS_GETPWENT
- pwent = (struct passwd *)getpwent();
-#else
+ switch (which) {
+ case OP_GPWNAM:
+ pwent = getpwnam(POPpx);
+ break;
+ case OP_GPWUID:
+ pwent = getpwuid((Uid_t)POPi);
+ break;
+ case OP_GPWENT:
+# ifdef HAS_GETPWENT
+ pwent = getpwent();
+# else
DIE(aTHX_ PL_no_func, "getpwent");
-#endif
-
-#ifdef HAS_GETSPNAM
- if (which == OP_GPWNAM) {
- if (pwent)
- spwent = getspnam(pwent->pw_name);
- }
-# ifdef HAS_GETSPUID /* AFAIK there isn't any anywhere. --jhi */
- else if (which == OP_GPWUID) {
- if (pwent)
- spwent = getspnam(pwent->pw_name);
+# endif
+ break;
}
-# endif
-# ifdef HAS_GETSPENT
- else
- spwent = (struct spwd *)getspent();
-# endif
-#endif
EXTEND(SP, 10);
if (GIMME != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (pwent) {
if (which == OP_GPWNAM)
+# if Uid_t_sign <= 0
sv_setiv(sv, (IV)pwent->pw_uid);
+# else
+ sv_setuv(sv, (UV)pwent->pw_uid);
+# endif
else
sv_setpv(sv, pwent->pw_name);
}
sv_setpv(sv, pwent->pw_name);
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-#ifdef PWPASSWD
-# if defined(HAS_GETSPENT) || defined(HAS_GETSPNAM)
- if (spwent)
- sv_setpv(sv, spwent->sp_pwdp);
- else
- sv_setpv(sv, pwent->pw_passwd);
+# ifdef HAS_GETSPNAM
+ spwent = getspnam(pwent->pw_name);
+ if (spwent)
+ sv_setpv(sv, spwent->sp_pwdp);
+ else
+ sv_setpv(sv, pwent->pw_passwd);
# else
sv_setpv(sv, pwent->pw_passwd);
# endif
-#endif
+# ifndef INCOMPLETE_TAINTS
+ /* passwd is tainted because user himself can diddle with it. */
+ SvTAINTED_on(sv);
+# endif
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+# if Uid_t_sign <= 0
sv_setiv(sv, (IV)pwent->pw_uid);
+# else
+ sv_setuv(sv, (UV)pwent->pw_uid);
+# endif
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+# if Uid_t_sign <= 0
sv_setiv(sv, (IV)pwent->pw_gid);
-
+# else
+ sv_setuv(sv, (UV)pwent->pw_gid);
+# endif
/* pw_change, pw_quota, and pw_age are mutually exclusive. */
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-#ifdef PWCHANGE
+# ifdef PWCHANGE
sv_setiv(sv, (IV)pwent->pw_change);
-#else
-# ifdef PWQUOTA
- sv_setiv(sv, (IV)pwent->pw_quota);
# else
-# ifdef PWAGE
+# ifdef PWQUOTA
+ sv_setiv(sv, (IV)pwent->pw_quota);
+# else
+# ifdef PWAGE
sv_setpv(sv, pwent->pw_age);
+# endif
# endif
# endif
-#endif
/* pw_class and pw_comment are mutually exclusive. */
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-#ifdef PWCLASS
+# ifdef PWCLASS
sv_setpv(sv, pwent->pw_class);
-#else
-# ifdef PWCOMMENT
+# else
+# ifdef PWCOMMENT
sv_setpv(sv, pwent->pw_comment);
+# endif
# endif
-#endif
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
-#ifdef PWGECOS
+# ifdef PWGECOS
sv_setpv(sv, pwent->pw_gecos);
-#endif
-#ifndef INCOMPLETE_TAINTS
+# endif
+# ifndef INCOMPLETE_TAINTS
/* pw_gecos is tainted because user himself can diddle with it. */
SvTAINTED_on(sv);
-#endif
+# endif
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, pwent->pw_dir);
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, pwent->pw_shell);
+# ifndef INCOMPLETE_TAINTS
+ /* pw_shell is tainted because user himself can diddle with it. */
+ SvTAINTED_on(sv);
+# endif
-#ifdef PWEXPIRE
+# ifdef PWEXPIRE
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setiv(sv, (IV)pwent->pw_expire);
-#endif
+# endif
}
RETURN;
#else
projects / p5sagit/p5-mst-13.2.git / blobdiff