X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=1d1c84927123d9df0effb0db1712cef1201f51c8;hb=45c0de28763808112fd2f46ea311b6bb0c6050b3;hp=3f4a112276702a52804a8e78784bef0a3e3b617b;hpb=3eb568f1c9e22faaefbd6531878f947fab30705b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index 3f4a112..1d1c849 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -17,6 +17,11 @@ #include "EXTERN.h" #include "perl.h" +#ifdef HAS_GETSPENT +/* Shadow password support for solaris - pdo@cs.umd.edu*/ +#include +#endif + /* XXX If this causes problems, set i_unistd=undef in the hint file. */ #ifdef I_UNISTD # include @@ -494,6 +499,7 @@ PP(pp_open) SV *sv; char *tmps; STRLEN len; + MAGIC *mg; if (MAXARG > 1) sv = POPs; @@ -506,6 +512,8 @@ PP(pp_open) DIE(PL_no_usym, "filehandle"); if (GvIOp(gv)) IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; + +#if 0 /* no undef means tmpfile() yet */ if (sv == &PL_sv_undef) { #ifdef PerlIO PerlIO *fp = PerlIO_tmpfile(); @@ -518,6 +526,21 @@ PP(pp_open) RETPUSHUNDEF; RETURN; } +#endif /* no undef means tmpfile() yet */ + + + if (mg = SvTIED_mg((SV*)gv, 'q')) { + PUSHMARK(SP); + XPUSHs(SvTIED_obj((SV*)gv, mg)); + XPUSHs(sv); + PUTBACK; + ENTER; + perl_call_method("OPEN", G_SCALAR); + LEAVE; + SPAGAIN; + RETURN; + } + tmps = SvPV(sv, len); if (do_open(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp)) PUSHi( (I32)PL_forkprocess ); @@ -615,9 +638,23 @@ PP(pp_fileno) GV *gv; IO *io; PerlIO *fp; + MAGIC *mg; + if (MAXARG < 1) RETPUSHUNDEF; gv = (GV*)POPs; + + if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { + PUSHMARK(SP); + XPUSHs(SvTIED_obj((SV*)gv, mg)); + PUTBACK; + ENTER; + perl_call_method("FILENO", G_SCALAR); + LEAVE; + SPAGAIN; + RETURN; + } + if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) RETPUSHUNDEF; PUSHi(PerlIO_fileno(fp)); @@ -655,11 +692,23 @@ PP(pp_binmode) GV *gv; IO *io; PerlIO *fp; + MAGIC *mg; if (MAXARG < 1) RETPUSHUNDEF; - gv = (GV*)POPs; + gv = (GV*)POPs; + + if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { + PUSHMARK(SP); + XPUSHs(SvTIED_obj((SV*)gv, mg)); + PUTBACK; + ENTER; + perl_call_method("BINMODE", G_SCALAR); + LEAVE; + SPAGAIN; + RETURN; + } EXTEND(SP, 1); if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) @@ -1349,6 +1398,8 @@ PP(pp_sysopen) sv = POPs; gv = (GV *)POPs; + /* Need TIEHANDLE method ? */ + tmps = SvPV(sv, len); if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) { IoLINES(GvIOp(gv)) = 0; @@ -1618,11 +1669,24 @@ PP(pp_eof) { djSP; GV *gv; + MAGIC *mg; if (MAXARG <= 0) gv = PL_last_in_gv; else gv = PL_last_in_gv = (GV*)POPs; + + if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { + PUSHMARK(SP); + XPUSHs(SvTIED_obj((SV*)gv, mg)); + PUTBACK; + ENTER; + perl_call_method("EOF", G_SCALAR); + LEAVE; + SPAGAIN; + RETURN; + } + PUSHs(boolSV(!gv || do_eof(gv))); RETURN; } @@ -1630,12 +1694,25 @@ PP(pp_eof) PP(pp_tell) { djSP; dTARGET; - GV *gv; + GV *gv; + MAGIC *mg; if (MAXARG <= 0) gv = PL_last_in_gv; else gv = PL_last_in_gv = (GV*)POPs; + + if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { + PUSHMARK(SP); + XPUSHs(SvTIED_obj((SV*)gv, mg)); + PUTBACK; + ENTER; + perl_call_method("TELL", G_SCALAR); + LEAVE; + SPAGAIN; + RETURN; + } + PUSHi( do_tell(gv) ); RETURN; } @@ -1651,8 +1728,23 @@ PP(pp_sysseek) GV *gv; int whence = POPi; Off_t offset = POPl; + MAGIC *mg; gv = PL_last_in_gv = (GV*)POPs; + + if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { + PUSHMARK(SP); + XPUSHs(SvTIED_obj((SV*)gv, mg)); + XPUSHs(sv_2mortal(newSViv((IV) offset))); + XPUSHs(sv_2mortal(newSViv((IV) whence))); + PUTBACK; + ENTER; + perl_call_method("SEEK", G_SCALAR); + LEAVE; + SPAGAIN; + RETURN; + } + if (PL_op->op_type == OP_SEEK) PUSHs(boolSV(do_seek(gv, offset, whence))); else { @@ -3404,6 +3496,7 @@ PP(pp_fork) GV *tmpgv; EXTEND(SP, 1); + PERL_FLUSHALL_FOR_CHILD; childpid = fork(); if (childpid < 0) RETSETUNDEF; @@ -3422,7 +3515,7 @@ PP(pp_fork) PP(pp_wait) { -#if !defined(DOSISH) || defined(OS2) || defined(WIN32) +#if !defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(CYGWIN32) djSP; dTARGET; Pid_t childpid; int argflags; @@ -3438,7 +3531,7 @@ PP(pp_wait) PP(pp_waitpid) { -#if !defined(DOSISH) || defined(OS2) || defined(WIN32) +#if !defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(CYGWIN32) djSP; dTARGET; Pid_t childpid; int optype; @@ -3472,6 +3565,7 @@ PP(pp_system) TAINT_PROPER("system"); } } + PERL_FLUSHALL_FOR_CHILD; #if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) while ((childpid = vfork()) == -1) { if (errno != EAGAIN) { @@ -3530,6 +3624,7 @@ PP(pp_exec) I32 value; STRLEN n_a; + PERL_FLUSHALL_FOR_CHILD; if (PL_op->op_flags & OPf_STACKED) { SV *really = *++MARK; value = (I32)do_aexec(really, MARK, SP); @@ -4458,6 +4553,9 @@ PP(pp_gpwent) register SV *sv; struct passwd *pwent; STRLEN n_a; +#ifdef HAS_GETSPENT + struct spwd *spwent; +#endif if (which == OP_GPWNAM) pwent = getpwnam(POPpx); @@ -4466,6 +4564,15 @@ PP(pp_gpwent) else pwent = (struct passwd *)getpwent(); +#ifdef HAS_GETSPENT + if (which == OP_GPWNAM) + spwent = getspnam(pwent->pw_name); + else if (which == OP_GPWUID) + spwent = getspnam(pwent->pw_name); + else + spwent = (struct spwd *)getspent(); +#endif + EXTEND(SP, 10); if (GIMME != G_ARRAY) { PUSHs(sv = sv_newmortal()); @@ -4484,8 +4591,15 @@ PP(pp_gpwent) PUSHs(sv = sv_mortalcopy(&PL_sv_no)); #ifdef PWPASSWD +#ifdef HAS_GETSPENT + if (spwent) + sv_setpv(sv, spwent->sp_pwdp); + else + sv_setpv(sv, pwent->pw_passwd); +#else sv_setpv(sv, pwent->pw_passwd); #endif +#endif PUSHs(sv = sv_mortalcopy(&PL_sv_no)); sv_setiv(sv, (IV)pwent->pw_uid); @@ -4548,6 +4662,9 @@ PP(pp_spwent) djSP; #if defined(HAS_PASSWD) && defined(HAS_SETPWENT) && !defined(CYGWIN32) setpwent(); +#ifdef HAS_GETSPENT + setspent(); +#endif RETPUSHYES; #else DIE(PL_no_func, "setpwent"); @@ -4559,6 +4676,9 @@ PP(pp_epwent) djSP; #if defined(HAS_PASSWD) && defined(HAS_ENDPWENT) endpwent(); +#ifdef HAS_GETSPENT + endspent(); +#endif RETPUSHYES; #else DIE(PL_no_func, "endpwent");