return 0;
}
+MAGIC*
+S_mg_findext_flags(pTHX_ const SV *sv, int type, const MGVTBL *vtbl, U32 flags)
+{
+ PERL_UNUSED_CONTEXT;
+
+ assert(flags <= 1);
+
+ if (sv) {
+ MAGIC *mg;
+
+ for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+ if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) {
+ return mg;
+ }
+ }
+ }
+
+ return NULL;
+}
+
/*
=for apidoc mg_find
MAGIC*
Perl_mg_find(pTHX_ const SV *sv, int type)
{
- PERL_UNUSED_CONTEXT;
- if (sv) {
- MAGIC *mg;
- for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
- if (mg->mg_type == type)
- return mg;
- }
- }
- return NULL;
+ return S_mg_findext_flags(aTHX_ sv, type, NULL, 0);
+}
+
+/*
+=for apidoc mg_findext
+
+Finds the magic pointer of C<type> with the given C<vtbl> for the C<SV>. See
+C<sv_magicext>.
+
+=cut
+*/
+
+MAGIC*
+Perl_mg_findext(pTHX_ const SV *sv, int type, const MGVTBL *vtbl)
+{
+ return S_mg_findext_flags(aTHX_ sv, type, vtbl, 1);
}
/*
switch (*mg->mg_ptr) {
case '\001': /* ^A */
sv_setsv(sv, PL_bodytarget);
+ if (SvTAINTED(PL_bodytarget))
+ SvTAINTED_on(sv);
break;
case '\003': /* ^C, ^CHILD_ERROR_NATIVE */
if (nextchar == '\0') {
case '\006': /* ^F */
sv_setiv(sv, (IV)PL_maxsysfd);
break;
+ case '\007': /* ^GLOBAL_PHASE */
+ if (strEQ(remaining, "LOBAL_PHASE")) {
+ sv_setpvn(sv, PL_phase_names[PL_phase],
+ strlen(PL_phase_names[PL_phase]));
+ }
+ break;
case '\010': /* ^H */
sv_setiv(sv, (IV)PL_hints);
break;
Perl_emulate_cop_io(aTHX_ &PL_compiling, sv);
}
break;
- case '\020':
+ case '\020':
if (nextchar == '\0') { /* ^P */
sv_setiv(sv, (IV)PL_perldb);
} else if (strEQ(remaining, "REMATCH")) { /* $^PREMATCH */
#ifdef VMS
if (s && klen == 8 && strEQ(ptr, "DCL$PATH")) {
char pathbuf[256], eltbuf[256], *cp, *elt;
- Stat_t sbuf;
int i = 0, j = 0;
my_strlcpy(eltbuf, s, sizeof(eltbuf));
PERL_ARGS_ASSERT_MAGIC_CLEARISA;
/* Bail out if destruction is going on */
- if(PL_dirty) return 0;
+ if(PL_phase == PERL_PHASE_DESTRUCT) return 0;
if (sv)
av_clear(MUTABLE_AV(sv));
const char * const remaining = mg->mg_ptr + 1;
I32 i;
STRLEN len;
+ MAGIC *tmg;
PERL_ARGS_ASSERT_MAGIC_SET;
break;
case '\001': /* ^A */
sv_setsv(PL_bodytarget, sv);
+ /* mg_set() has temporarily made sv non-magical */
+ if (PL_tainting) {
+ if ((tmg = mg_find(sv,PERL_MAGIC_taint)) && tmg->mg_len & 1)
+ SvTAINTED_on(PL_bodytarget);
+ else
+ SvTAINTED_off(PL_bodytarget);
+ }
break;
case '\003': /* ^C */
PL_minus_c = cBOOL(SvIV(sv));