The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

static void
S_reset_amagic (pTHX_ SV *rv, const bool on)
{
    /* It is assumed that you've already turned magic on/off on rv  */

    SV *sva;
    SV *const target = SvRV (rv);

    /* Less 1 for the reference we've already dealt with.  */
    U32 how_many = SvREFCNT (target) - 1;
    MAGIC *mg;

    if (SvMAGICAL (target) && (mg = mg_find (target, PERL_MAGIC_backref))) {
        /* Back references also need to be found, but aren't part of the target's reference count. */
        how_many += 1 + av_len ((AV *)mg->mg_obj);
    }

    if (!how_many) {
        /* There was only 1 reference to this object.  */
        return;
    }

    for (sva = PL_sv_arenaroot; sva; sva = (SV *)SvANY (sva)) {
        register const SV *const svend = &sva[SvREFCNT (sva)];
        register SV *sv;
        for (sv = sva + 1; sv < svend; ++sv) {
            if (SvTYPE (sv) != SVTYPEMASK
             && ((sv->sv_flags & SVf_ROK) == SVf_ROK)
             && SvREFCNT (sv)
             && SvRV (sv) == target
             && sv != rv) {
                if (on) {
                    SvAMAGIC_on (sv);
                }
                else {
                    SvAMAGIC_off (sv);
                }

                if (--how_many == 0) {
                    /* We have found them all. */
                    return;
                }
            }
        }
    }
}

MODULE = Moose::Meta::Role::Application::ToInstance PACKAGE = Moose::Meta::Role::Application::ToInstance

PROTOTYPES: DISABLE

void
_reset_amagic (rv)
        SV *rv
    CODE:
        if (Gv_AMG (SvSTASH (SvRV (rv))) && !SvAMAGIC (rv)) {
            SvAMAGIC_on (rv);
            S_reset_amagic (aTHX_ rv, TRUE);
        }