view release on metacpan or  search on metacpan

Alias.xs  view on Meta::CPAN

		process_flag("Alias::AttrPrefix", &attrpfx, &attrpfx_c, &attrpfx_l);
		process_flag("Alias::Deref", &deref, &deref_c, &deref_l);
		deref_call = (deref && !deref_c);
		
		LEAVE;                      /* operate at a higher level */
		
		(void)hv_iterinit(hv);
		while ((val = hv_iternextsv(hv, &key, &klen))) {
		    GV *gv;
		    int stype = SvTYPE(val);
		    int deref_this = 1;
		    int deref_objects = 0;

		    /* check the key for validity by either looking at
		     * its prefix, or by calling &$Alias::KeyFilter */
		    if (keypfx) {
			if (keypfx_c) {
			    if (keypfx_l && klen > keypfx_l
				&& strncmp(key, keypfx_c, keypfx_l))
				continue;
			}
			else {
			    dSP;
			    SV *ret = Nullsv;
			    I32 i;
			    
			    ENTER; SAVETMPS; PUSHMARK(sp);
			    XPUSHs(sv_2mortal(newSVpv(key,klen)));
			    PUTBACK;
			    if (perl_call_sv(keypfx, G_SCALAR))
				ret = *PL_stack_sp--;
			    SPAGAIN;
			    i = SvTRUE(ret);
			    FREETMPS; LEAVE;
			    if (!i)
				continue;
			}
		    }

		    if (SvROK(val) && deref) {
			if (deref_c) {
			    if (deref_l && !(deref_l == 1 && *deref_c == '0'))
				deref_objects = 1;
			}
			else {
			    dSP;
			    SV *ret = Nullsv;
			    
			    ENTER; SAVETMPS; PUSHMARK(sp);
			    XPUSHs(sv_2mortal(newSVpv(key,klen)));
			    XPUSHs(sv_2mortal(newSVsv(val)));
			    PUTBACK;
			    if (perl_call_sv(deref, G_SCALAR))
				ret = *PL_stack_sp--;
			    SPAGAIN;
			    deref_this = SvTRUE(ret);
			    FREETMPS; LEAVE;
			}
		    }
		    
		    /* attributes may need to be prefixed/renamed */
		    if (attrpfx) {
			STRLEN len;
			if (attrpfx_c) {
			    if (attrpfx_l) {
				SV *keysv = sv_2mortal(newSVpv(attrpfx_c, attrpfx_l));
				sv_catpvn(keysv, key, klen);
				key = SvPV(keysv, len);
				klen = len;
			    }
			}
			else {
			    dSP;
			    SV *ret = Nullsv;
			    
			    ENTER; PUSHMARK(sp);
			    XPUSHs(sv_2mortal(newSVpv(key,klen)));
			    PUTBACK;
			    if (perl_call_sv(attrpfx, G_SCALAR))
				ret = *PL_stack_sp--;
			    SPAGAIN; LEAVE;
			    key = SvPV(ret, len);
			    klen = len;
			}
		    }

		    if (SvROK(val) && (tmpsv = SvRV(val))) {
			if (deref_call) {
			    if (!deref_this)
				goto no_deref;
			}
			else if (!deref_objects && SvOBJECT(tmpsv))
			    goto no_deref;

			stype = SvTYPE(tmpsv);
			if (stype == SVt_PVGV)
			    val = tmpsv;

		    }
		    else if (stype != SVt_PVGV) {
		    no_deref:
			val = sv_2mortal(newRV(val));
		    }
		    
		    /* add symbol, forgoing "used once" warnings */
		    gv = gv_fetchpv(key, GV_ADDMULTI, SVt_PVGV);
		    
		    switch (stype) {
		    case SVt_PVAV:
			save_ary(gv);
			break;
		    case SVt_PVHV:
			save_hash(gv);
			break;
		    case SVt_PVGV:
			save_gp(gv,TRUE);   /* hide previous entry in symtab */
			break;
		    case SVt_PVCV:
			SAVESPTR(GvCV(gv));
			GvCV(gv) = Null(CV*);
			break;