diff options
author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1997-04-23 00:00:00 +1200 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1997-04-23 00:00:00 +1200 |
commit | 46fc3d4c69a0adf236bfcba70daee7fd597cf30d (patch) | |
tree | 3b70f4a42d2ccd034756c9786032a1e531569e62 /pp_sys.c | |
parent | 10a676f83f541430b63a3192b246bf6f86d3b189 (diff) | |
download | perl-46fc3d4c69a0adf236bfcba70daee7fd597cf30d.tar.gz |
[inseparable changes from match from perl-5.003_97g to perl-5.003_97h]
BUILD PROCESS
Subject: Fix up Linux hints for tcsh, and Configure patch
Date: Tue, 22 Apr 1997 11:02:27 -0400 (EDT)
From: Andy Dougherty <doughera@lafcol.lafayette.edu>
Files: Configure hints/linux.sh
Msg-ID: Pine.SOL.3.95q.970422101051.2506C-100000@fractal.lafayette.e
(applied based on p5p patch as commit 1eb1b1cb9647b817d039bb17afa3e74940b5ef92)
Subject: There is no standard answer to 'Use suidperl?'
From: Chip Salzenberg <chip@perl.com>
Files: hints/bsdos.sh hints/freebsd.sh hints/linux.sh hints/machten_2.sh
CORE LANGUAGE CHANGES
Subject: Support PRINTF for tied handles
Date: Sun, 20 Apr 1997 18:26:13 -0400
From: Doug MacEachern <dougm@opengroup.org>
Files: pod/perldelta.pod pod/perltie.pod pp_sys.c t/op/misc.t
Msg-ID: 199704202226.SAA08032@postman.osf.org
(applied based on p5p patch as commit e7c5525577c16ee25e3521e86aca2b5105dba394)
CORE PORTABILITY
Subject: Fix bitwise shifts and pack('w') on Crays
From: Chip Salzenberg <chip@perl.com>
Files: pp.c
DOCUMENTATION
Subject: FAQ udpate (23-apr-97)
Date: Wed, 23 Apr 1997 12:22:55 -0600 (MDT)
From: Nathan Torkington <gnat@prometheus.frii.com>
Files: pod/perlfaq*.pod
private-msgid: 199704231822.MAA05074@prometheus.frii.com
OTHER CORE CHANGES
Subject: Mondo Cool patch for buffer safety and convenience
From: Chip Salzenberg <chip@perl.com>
Files: XSUB.h doop.c dump.c ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs ext/DynaLoader/dlutils.c ext/ODBM_File/ODBM_File.xs global.sym gv.c interp.sym mg.c op.c perl.c perl.h pod/perlguts.pod pp.c pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c regexec.c sv.c toke.c util.c
Subject: Problems with glob
Date: Sun, 20 Apr 1997 02:44:32 -0400 (EDT)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: op.c
Msg-ID: 1997Apr20.024432.1941365@hmivax.humgen.upenn.edu
(applied based on p5p patch as commit a1230b335277820e65b8a9454ab751341204cf4f)
Subject: Fix scalar leak in closures
From: Chip Salzenberg <chip@perl.com>
Files: op.c scope.c
Subject: Refine error messages re: anon subs' prototypes
From: Chip Salzenberg <chip@perl.com>
Files: op.c
Subject: Outermost scope is void, not scalar
From: Chip Salzenberg <chip@perl.com>
Files: pp_ctl.c
Diffstat (limited to 'pp_sys.c')
-rw-r--r-- | pp_sys.c | 73 |
1 files changed, 53 insertions, 20 deletions
@@ -154,6 +154,13 @@ static int dooneliner _((char *cmd, char *filename)); #endif /* no flock() */ +#ifndef MAXPATHLEN +# ifdef PATH_MAX +# define MAXPATHLEN PATH_MAX +# else +# define MAXPATHLEN 1024 +# endif +#endif #define ZBTLEN 10 static char zero_but_true[ZBTLEN + 1] = "0 but true"; @@ -171,7 +178,7 @@ PP(pp_backtick) fp = my_popen(tmps, "r"); if (fp) { if (gimme == G_VOID) { - while (PerlIO_read(fp, buf, sizeof buf) > 0) + while (PerlIO_read(fp, tokenbuf, sizeof tokenbuf) > 0) /*SUPPRESS 530*/ ; } @@ -971,16 +978,16 @@ PP(pp_leavewrite) CV *cv; if (!IoTOP_GV(io)) { GV *topgv; - char tmpbuf[256]; + SV *topname; if (!IoTOP_NAME(io)) { if (!IoFMT_NAME(io)) IoFMT_NAME(io) = savepv(GvNAME(gv)); - sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io)); - topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM); + topname = sv_2mortal(newSVpvf("%s_TOP", IoFMT_NAME(io))); + topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM); if ((topgv && GvFORM(topgv)) || !gv_fetchpv("top",FALSE,SVt_PVFM)) - IoTOP_NAME(io) = savepv(tmpbuf); + IoTOP_NAME(io) = savepv(SvPVX(topname)); else IoTOP_NAME(io) = savepv("top"); } @@ -1072,11 +1079,33 @@ PP(pp_prtf) IO *io; PerlIO *fp; SV *sv = NEWSV(0,0); + MAGIC *mg; if (op->op_flags & OPf_STACKED) gv = (GV*)*++MARK; else gv = defoutgv; + + if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { + if (MARK == ORIGMARK) { + EXTEND(SP, 1); + ++MARK; + Move(MARK, MARK + 1, (SP - MARK) + 1, SV*); + ++SP; + } + PUSHMARK(MARK - 1); + *MARK = mg->mg_obj; + PUTBACK; + ENTER; + perl_call_method("PRINTF", G_SCALAR); + LEAVE; + SPAGAIN; + MARK = ORIGMARK + 1; + *MARK = *SP; + SP = MARK; + RETURN; + } + if (!(io = GvIO(gv))) { if (dowarn) { gv_fullname3(sv, gv, Nullch); @@ -1201,11 +1230,12 @@ PP(pp_sysread) goto say_undef; #ifdef HAS_SOCKET if (op->op_type == OP_RECV) { - bufsize = sizeof buf; + char namebuf[MAXPATHLEN]; + bufsize = sizeof namebuf; buffer = SvGROW(bufsv, length+1); /* 'offset' means 'flags' here */ length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, - (struct sockaddr *)buf, &bufsize); + (struct sockaddr *)namebuf, &bufsize); if (length < 0) RETPUSHUNDEF; SvCUR_set(bufsv, length); @@ -1216,7 +1246,7 @@ PP(pp_sysread) if (!(IoFLAGS(io) & IOf_UNTAINT)) SvTAINTED_on(bufsv); SP = ORIGMARK; - sv_setpvn(TARG, buf, bufsize); + sv_setpvn(TARG, namebuf, bufsize); PUSHs(TARG); RETURN; } @@ -1240,9 +1270,10 @@ PP(pp_sysread) else #ifdef HAS_SOCKET__bad_code_maybe if (IoTYPE(io) == 's') { - bufsize = sizeof buf; + char namebuf[MAXPATHLEN]; + bufsize = sizeof namebuf; length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0, - (struct sockaddr *)buf, &bufsize); + (struct sockaddr *)namebuf, &bufsize); } else #endif @@ -2631,7 +2662,9 @@ PP(pp_readlink) dSP; dTARGET; #ifdef HAS_SYMLINK char *tmps; + char buf[MAXPATHLEN]; int len; + tmps = POPp; len = readlink(tmps, buf, sizeof buf); EXTEND(SP, 1); @@ -3304,18 +3337,18 @@ PP(pp_gmtime) EXTEND_MORTAL(9); if (GIMME != G_ARRAY) { dTARGET; - char mybuf[30]; + SV *tsv; if (!tmbuf) RETPUSHUNDEF; - sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d", - dayname[tmbuf->tm_wday], - monname[tmbuf->tm_mon], - tmbuf->tm_mday, - tmbuf->tm_hour, - tmbuf->tm_min, - tmbuf->tm_sec, - tmbuf->tm_year + 1900); - PUSHp(mybuf, strlen(mybuf)); + tsv = newSVpvf("%s %s %2d %02d:%02d:%02d %d", + dayname[tmbuf->tm_wday], + monname[tmbuf->tm_mon], + tmbuf->tm_mday, + tmbuf->tm_hour, + tmbuf->tm_min, + tmbuf->tm_sec, + tmbuf->tm_year + 1900); + PUSHs(sv_2mortal(tsv)); } else if (tmbuf) { PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec))); |