/* mg.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
"magical" properties. When any Perl code tries to read from, or assign to,
an SV marked as magical, it calls the 'get' or 'set' function associated
with that SV's magic. A get is called prior to reading an SV, in order to
-give it a chance to update its interval value (get on $. writes the line
+give it a chance to update its internal value (get on $. writes the line
number of the last read filehandle into to the SV's IV slot), while
set is called after an SV has been written to, in order to allow it to make
-use of it's changed value (set on $/ copies the SV's new value to the
+use of its changed value (set on $/ copies the SV's new value to the
PL_rs global variable).
Magic is implemented as a linked list of MAGIC structures attached to the
if (SvREFCNT(sv) == 1) {
/* We hold the last reference to this SV, which implies that the
SV was deleted as a side effect of the routines we called. */
- (void)SvOK_off(sv);
+ SvOK_off(sv);
}
return 0;
}
case '\023': /* ^S */
if (*(mg->mg_ptr+1) == '\0') {
if (PL_lex_state != LEX_NOTPARSING)
- (void)SvOK_off(sv);
+ SvOK_off(sv);
else if (PL_in_eval)
sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE));
else
? (PL_taint_warn || PL_unsafe ? -1 : 1)
: 0);
break;
- case '\025': /* $^UNICODE */
+ case '\025': /* $^UNICODE, $^UTF8LOCALE */
if (strEQ(mg->mg_ptr, "\025NICODE"))
sv_setuv(sv, (UV) PL_unicode);
+ else if (strEQ(mg->mg_ptr, "\025TF8LOCALE"))
+ sv_setuv(sv, (UV) PL_utf8locale);
break;
case '\027': /* ^W & $^WARNING_BITS */
if (*(mg->mg_ptr+1) == '\0')
# endif
{
# ifndef PERL_USE_SAFE_PUTENV
+ if (!PL_use_safe_putenv) {
I32 i;
if (environ == PL_origenviron)
else
for (i = 0; environ[i]; i++)
safesysfree(environ[i]);
+ }
# endif /* PERL_USE_SAFE_PUTENV */
environ[0] = Nullch;
return 0;
}
}
- (void)SvOK_off(sv);
+ SvOK_off(sv);
return 0;
}
int
Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
{
- register char *s;
GV* gv;
- STRLEN n_a;
-
+
if (!SvOK(sv))
return 0;
- s = SvPV(sv, n_a);
- if (*s == '*' && s[1])
- s++;
- gv = gv_fetchpv(s,TRUE, SVt_PVGV);
+ gv = gv_fetchsv(sv,TRUE, SVt_PVGV);
if (sv == (SV*)gv)
return 0;
if (GvGP(sv))
SV *lsv = LvTARG(sv);
if (!lsv) {
- (void)SvOK_off(sv);
+ SvOK_off(sv);
return 0;
}
Perl_croak(aTHX_ "panic: magic_killbackrefs");
/* XXX Should we check that it hasn't changed? */
SvRV(svp[i]) = 0;
- (void)SvOK_off(svp[i]);
+ SvOK_off(svp[i]);
SvWEAKREF_off(svp[i]);
svp[i] = Nullsv;
}
case '\004': /* ^D */
#ifdef DEBUGGING
s = SvPV_nolen(sv);
- PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
+ PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
DEBUG_x(dump_all());
#else
PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
if (PL_inplace)
Safefree(PL_inplace);
if (SvOK(sv))
- PL_inplace = savepv(SvPV(sv,len));
+ PL_inplace = savesvpv(sv);
else
PL_inplace = Nullch;
break;
}
if (SvOK(sv)) {
TAINT_PROPER("assigning to $^O");
- PL_osname = savepv(SvPV(sv,len));
+ PL_osname = savesvpv(sv);
}
}
else if (strEQ(mg->mg_ptr, "\017PEN")) {
break;
case '^':
Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
- IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
- IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+ IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savesvpv(sv);
+ IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
break;
case '~':
Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
- IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
- IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+ IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savesvpv(sv);
+ IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
break;
case '=':
IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
case '#':
if (PL_ofmt)
Safefree(PL_ofmt);
- PL_ofmt = savepv(SvPV(sv,len));
+ PL_ofmt = savesvpv(sv);
break;
case '[':
PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
(void)rsignal(sig, PL_csighandlerp);
#endif
#endif /* !PERL_MICRO */
- Perl_die(aTHX_ Nullformat);
+ DieNull;
}
cleanup:
if (flags & 1)