#include "EXTERN.h"
#include "perl.h"
+#ifdef HAS_GETSPENT
+/* Shadow password support for solaris - pdo@cs.umd.edu*/
+#include <shadow.h>
+#endif
+
/* XXX If this causes problems, set i_unistd=undef in the hint file. */
#ifdef I_UNISTD
# include <unistd.h>
PP(pp_warn)
{
djSP; dMARK;
+ SV *tmpsv;
char *tmps;
- STRLEN n_a;
+ STRLEN len;
if (SP - MARK != 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
- tmps = SvPV(TARG, n_a);
+ tmpsv = TARG;
SP = MARK + 1;
}
else {
- tmps = SvPV(TOPs, n_a);
+ tmpsv = TOPs;
}
- if (!tmps || !*tmps) {
+ tmps = SvPV(tmpsv, len);
+ if (!tmps || !len) {
SV *error = ERRSV;
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...caught");
- tmps = SvPV(error, n_a);
+ tmpsv = error;
+ tmps = SvPV(tmpsv, len);
}
- if (!tmps || !*tmps)
- tmps = "Warning: something's wrong";
- warn("%s", tmps);
+ if (!tmps || !len)
+ tmpsv = sv_2mortal(newSVpvn("Warning: something's wrong", 26));
+
+ warn("%_", tmpsv);
RETSETYES;
}
{
djSP; dMARK;
char *tmps;
- SV *tmpsv = Nullsv;
- char *pat = "%s";
- STRLEN n_a;
+ SV *tmpsv;
+ STRLEN len;
+ bool multiarg = 0;
if (SP - MARK != 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
- tmps = SvPV(TARG, n_a);
+ tmpsv = TARG;
+ tmps = SvPV(tmpsv, len);
+ multiarg = 1;
SP = MARK + 1;
}
else {
tmpsv = TOPs;
- tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, n_a);
+ tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, len);
}
- if (!tmps || !*tmps) {
+ if (!tmps || !len) {
SV *error = ERRSV;
(void)SvUPGRADE(error, SVt_PV);
- if(tmpsv ? SvROK(tmpsv) : SvROK(error)) {
- if(tmpsv)
+ if (multiarg ? SvROK(error) : SvROK(tmpsv)) {
+ if (!multiarg)
SvSetSV(error,tmpsv);
- else if(sv_isobject(error)) {
+ else if (sv_isobject(error)) {
HV *stash = SvSTASH(SvRV(error));
GV *gv = gv_fetchmethod(stash, "PROPAGATE");
if (gv) {
sv_setsv(error,*PL_stack_sp--);
}
}
- pat = Nullch;
+ DIE(Nullch);
}
else {
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...propagated");
- tmps = SvPV(error, n_a);
+ tmpsv = error;
+ tmps = SvPV(tmpsv, len);
}
}
- if (!tmps || !*tmps)
- tmps = "Died";
- DIE(pat, tmps);
+ if (!tmps || !len)
+ tmpsv = sv_2mortal(newSVpvn("Died", 4));
+
+ DIE("%_", tmpsv);
}
/* I/O. */
SV *sv;
char *tmps;
STRLEN len;
+ MAGIC *mg;
if (MAXARG > 1)
sv = POPs;
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();
+#else
+ PerlIO *fp = tmpfile();
+#endif
+ if (fp != Nullfp && do_open(gv, "+>&", 3, FALSE, 0, 0, fp))
+ PUSHi( (I32)PL_forkprocess );
+ else
+ 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 );
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));
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)))
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;
{
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;
}
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;
}
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 {
GV *tmpgv;
EXTEND(SP, 1);
+ PERL_FLUSHALL_FOR_CHILD;
childpid = fork();
if (childpid < 0)
RETSETUNDEF;
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;
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;
TAINT_PROPER("system");
}
}
+ PERL_FLUSHALL_FOR_CHILD;
#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2)
while ((childpid = vfork()) == -1) {
if (errno != EAGAIN) {
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);
register SV *sv;
struct passwd *pwent;
STRLEN n_a;
+#ifdef HAS_GETSPENT
+ struct spwd *spwent;
+#endif
if (which == OP_GPWNAM)
pwent = getpwnam(POPpx);
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());
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);
djSP;
#if defined(HAS_PASSWD) && defined(HAS_SETPWENT) && !defined(CYGWIN32)
setpwent();
+#ifdef HAS_GETSPENT
+ setspent();
+#endif
RETPUSHYES;
#else
DIE(PL_no_func, "setpwent");
djSP;
#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
endpwent();
+#ifdef HAS_GETSPENT
+ endspent();
+#endif
RETPUSHYES;
#else
DIE(PL_no_func, "endpwent");
projects / p5sagit/p5-mst-13.2.git / blobdiff