+ if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS)))
+ {
+ if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
+ sv = sv_newmortal();
+
+ /* XXX should be able to skimp on the HE/HEK here when
+ HV_FETCH_JUST_SV is true. */
+
+ if (!keysv) {
+ keysv = newSVpvn(key, klen);
+ if (is_utf8) {
+ SvUTF8_on(keysv);
+ }
+ } else {
+ keysv = newSVsv(keysv);
+ }
+ mg_copy((SV*)hv, sv, (char *)keysv, HEf_SVKEY);
+
+ /* grab a fake HE/HEK pair from the pool or make a new one */
+ entry = PL_hv_fetch_ent_mh;
+ if (entry)
+ PL_hv_fetch_ent_mh = HeNEXT(entry);
+ else {
+ char *k;
+ entry = new_HE();
+ New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+ HeKEY_hek(entry) = (HEK*)k;
+ }
+ HeNEXT(entry) = Nullhe;
+ HeSVKEY_set(entry, keysv);
+ HeVAL(entry) = sv;
+ sv_upgrade(sv, SVt_PVLV);
+ LvTYPE(sv) = 'T';
+ /* so we can free entry when freeing sv */
+ LvTARG(sv) = (SV*)entry;
+
+ /* XXX remove at some point? */
+ if (flags & HVhek_FREEKEY)
+ Safefree(key);
+
+ return entry;
+ }
+#ifdef ENV_IS_CASELESS
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+ U32 i;
+ for (i = 0; i < klen; ++i)
+ if (isLOWER(key[i])) {
+ /* Would be nice if we had a routine to do the
+ copy and upercase in a single pass through. */
+ char *nkey = strupr(savepvn(key,klen));
+ /* Note that this fetch is for nkey (the uppercased
+ key) whereas the store is for key (the original) */
+ entry = hv_fetch_common(hv, Nullsv, nkey, klen,
+ HVhek_FREEKEY, /* free nkey */
+ 0 /* non-LVAL fetch */,
+ Nullsv /* no value */,
+ 0 /* compute hash */);
+ if (!entry && (action & HV_FETCH_LVALUE)) {
+ /* This call will free key if necessary.
+ Do it this way to encourage compiler to tail
+ call optimise. */
+ entry = hv_fetch_common(hv, keysv, key, klen,
+ flags, HV_FETCH_ISSTORE,
+ NEWSV(61,0), hash);
+ } else {
+ if (flags & HVhek_FREEKEY)
+ Safefree(key);
+ }
+ return entry;
+ }
+ }
+#endif
+ } /* ISFETCH */
+ else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) {
+ if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
+ SV* svret;
+ /* I don't understand why hv_exists_ent has svret and sv,
+ whereas hv_exists only had one. */
+ svret = sv_newmortal();
+ sv = sv_newmortal();
+
+ if (keysv || is_utf8) {
+ if (!keysv) {
+ keysv = newSVpvn(key, klen);
+ SvUTF8_on(keysv);
+ } else {
+ keysv = newSVsv(keysv);
+ }
+ mg_copy((SV*)hv, sv, (char *)sv_2mortal(keysv), HEf_SVKEY);
+ } else {
+ mg_copy((SV*)hv, sv, key, klen);
+ }
+ if (flags & HVhek_FREEKEY)
+ Safefree(key);
+ magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
+ /* This cast somewhat evil, but I'm merely using NULL/
+ not NULL to return the boolean exists.
+ And I know hv is not NULL. */
+ return SvTRUE(svret) ? (HE *)hv : NULL;
+ }