return result;
}
-#if 0 /* XXX never used! */
-PP(pp_indread)
-{
- STRLEN n_a;
- PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), n_a), TRUE,SVt_PVIO);
- return do_readline();
-}
-#endif
-
PP(pp_rcatline)
{
PL_last_in_gv = cGVOP_gv;
sv_setsv(error,*PL_stack_sp--);
}
}
- DIE(aTHX_ Nullch);
+ DIE(aTHX_ Nullformat);
}
else {
if (SvPOK(error) && SvCUR(error))
dTARGET;
GV *gv;
SV *sv;
+ IO *io;
char *tmps;
STRLEN len;
MAGIC *mg;
gv = (GV *)*++MARK;
if (!isGV(gv))
DIE(aTHX_ PL_no_usym, "filehandle");
- if (GvIOp(gv))
+ if ((io = GvIOp(gv)))
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
- if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+ if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
/* Method's args are same as ours ... */
/* ... except handle is replaced by the object */
- *MARK-- = SvTIED_obj((SV*)gv, mg);
+ *MARK-- = SvTIED_obj((SV*)io, mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
{
dSP;
GV *gv;
+ IO *io;
MAGIC *mg;
if (MAXARG == 0)
else
gv = (GV*)POPs;
- if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
ENTER;
call_method("CLOSE", G_SCALAR);
RETPUSHUNDEF;
gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
ENTER;
call_method("FILENO", G_SCALAR);
gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
if (discp)
XPUSHs(discp);
PUTBACK;
switch(SvTYPE(varsv)) {
case SVt_PVHV:
methname = "TIEHASH";
+ HvEITER((HV *)varsv) = Null(HE *);
break;
case SVt_PVAV:
methname = "TIEARRAY";
#endif
methname = "TIEHANDLE";
how = PERL_MAGIC_tiedscalar;
+ /* For tied filehandles, we apply tiedscalar magic to the IO
+ slot of the GP rather than the GV itself. AMS 20010812 */
+ if (!GvIOp(varsv))
+ GvIOp(varsv) = newIO();
+ varsv = (SV *)GvIOp(varsv);
break;
default:
methname = "TIESCALAR";
PP(pp_untie)
{
dSP;
+ MAGIC *mg;
SV *sv = POPs;
char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
- MAGIC * mg ;
- if ((mg = SvTIED_mg(sv, how))) {
+ if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv)))
+ RETPUSHYES;
+
+ if ((mg = SvTIED_mg(sv, how))) {
SV *obj = SvRV(mg->mg_obj);
GV *gv;
CV *cv = NULL;
"untie attempted while %"UVuf" inner references still exist",
(UV)SvREFCNT(obj) - 1 ) ;
}
+ sv_unmagic(sv, how);
}
- sv_unmagic(sv, how);
RETPUSHYES;
}
PP(pp_tied)
{
dSP;
+ MAGIC *mg;
SV *sv = POPs;
char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
- MAGIC *mg;
+
+ if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv)))
+ RETPUSHUNDEF;
if ((mg = SvTIED_mg(sv, how))) {
SV *osv = SvTIED_obj(sv, mg);
{
dSP; dTARGET;
GV *gv;
+ IO *io;
MAGIC *mg;
if (MAXARG == 0)
else
gv = (GV*)POPs;
- if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
I32 gimme = GIMME_V;
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
ENTER;
call_method("GETC", gimme);
else
gv = PL_defoutgv;
- if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
if (MARK == ORIGMARK) {
MEXTEND(SP, 1);
++MARK;
++SP;
}
PUSHMARK(MARK - 1);
- *MARK = SvTIED_obj((SV*)gv, mg);
+ *MARK = SvTIED_obj((SV*)io, mg);
PUTBACK;
ENTER;
call_method("PRINTF", G_SCALAR);
Size_t wanted;
gv = (GV*)*++MARK;
- if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) &&
- (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar)))
+ if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
+ && gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
{
SV *sv;
PUSHMARK(MARK-1);
- *MARK = SvTIED_obj((SV*)gv, mg);
+ *MARK = SvTIED_obj((SV*)io, mg);
ENTER;
call_method("READ", G_SCALAR);
LEAVE;
gv = (GV*)*++MARK;
if (PL_op->op_type == OP_SYSWRITE
- && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar)))
+ && gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
{
SV *sv;
PUSHMARK(MARK-1);
- *MARK = SvTIED_obj((SV*)gv, mg);
+ *MARK = SvTIED_obj((SV*)io, mg);
ENTER;
call_method("WRITE", G_SCALAR);
LEAVE;
{
dSP;
GV *gv;
+ IO *io;
MAGIC *mg;
if (MAXARG == 0) {
else
gv = PL_last_in_gv = (GV*)POPs; /* eof(FH) */
- if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
ENTER;
call_method("EOF", G_SCALAR);
{
dSP; dTARGET;
GV *gv;
+ IO *io;
MAGIC *mg;
if (MAXARG == 0)
else
gv = PL_last_in_gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
ENTER;
call_method("TELL", G_SCALAR);
{
dSP;
GV *gv;
+ IO *io;
int whence = POPi;
#if LSEEKSIZE > IVSIZE
Off_t offset = (Off_t)SvNVx(POPs);
gv = PL_last_in_gv = (GV*)POPs;
- if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
#if LSEEKSIZE > IVSIZE
XPUSHs(sv_2mortal(newSVnv((NV) offset)));
#else
if (SvPOK(argsv)) {
if (s[SvCUR(argsv)] != 17)
DIE(aTHX_ "Possible memory corruption: %s overflowed 3rd argument",
- PL_op_name[optype]);
+ OP_NAME(PL_op));
s[SvCUR(argsv)] = 0; /* put our null back */
SvSETMAGIC(argsv); /* Assume it has changed */
}
SV **svp;
STRLEN n_a;
- if (MAXARG < 1)
- tmps = Nullch;
- else
- tmps = POPpx;
- if (!tmps || !*tmps) {
- svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE);
- if (svp)
- tmps = SvPV(*svp, n_a);
- }
- if (!tmps || !*tmps) {
- svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE);
- if (svp)
- tmps = SvPV(*svp, n_a);
- }
+ if (MAXARG < 1) {
+ if (((svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE))
+ || (svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE))
#ifdef VMS
- if (!tmps || !*tmps) {
- svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE);
- if (svp)
- tmps = SvPV(*svp, n_a);
- }
+ || (svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE))
#endif
+ ) && SvPOK(*svp))
+ {
+ tmps = SvPV(*svp, n_a);
+ }
+ else
+ tmps = Nullch;
+ }
+ else
+ tmps = POPpx;
+
TAINT_PROPER("chdir");
PUSHi( PerlDir_chdir(tmps) >= 0 );
#ifdef VMS