view release on metacpan or  search on metacpan

lib/Data/Clone.xs  view on Meta::CPAN

        }
    }

    if(SvOBJECT(sv) && !SvRXOK(cloning)){
        proto = dc_clone_object(aTHX_ aMY_CXT_ cloning, MY_CXT.clone_method);

        if(proto){
            proto = SvRV(proto);
            goto finish;
        }

        /* fall through to make a deep copy */
    }
    else if((mg = SvTIED_mg(sv, PERL_MAGIC_tied))){
        assert(SvTYPE(sv) == SVt_PVAV || SvTYPE(sv) == SVt_PVHV);
        proto = dc_clone_object(aTHX_ aMY_CXT_ SvTIED_obj(sv, mg), MY_CXT.tieclone_method);

        if(proto){
            SV* const varsv = (SvTYPE(sv) == SVt_PVHV
                ? (SV*)newHV()
                : (SV*)newAV()); // can we use newSV_type()?
            sv_magic(varsv,  proto, PERL_MAGIC_tied, NULL, 0);
            proto = varsv;
            goto finish;
        }

        /* fall through to make a deep copy */
    }

    /* XXX: need to save caller_cv, or not? */
    //old_cv           = MY_CXT.caller_cv;
    MY_CXT.caller_cv = NULL;

    if(SvTYPE(sv) == SVt_PVAV){
        proto = sv_2mortal((SV*)newAV());
        if(may_be_circular){
            store_to_seen(aTHX_ aMY_CXT_ sv, proto);
        }
        clone_av_to(aTHX_ aMY_CXT_ (AV*)sv, (AV*)proto);
    }
    else if(SvTYPE(sv) == SVt_PVHV){
        proto = sv_2mortal((SV*)newHV());
        if(may_be_circular){
            store_to_seen(aTHX_ aMY_CXT_ sv, proto);
        }
        clone_hv_to(aTHX_ aMY_CXT_ (HV*)sv, (HV*)proto);
    }
    else {
        proto = sv; /* do nothing */
    }

    //MY_CXT.caller_cv = old_cv;

    finish:
    cloned = newRV_inc(proto);

    if(SvOBJECT(sv)){
        sv_bless(cloned, SvSTASH(sv));
    }

    return SvWEAKREF(cloning) ? sv_rvweaken(cloned) : cloned;
}

/* as SV* sv_clone(SV* sv) */
SV*
Data_Clone_sv_clone(pTHX_ SV* const sv) {
    SV* VOL retval = NULL;
    CV* VOL old_cv;
    dMY_CXT;
    dXCPT;

    if(++MY_CXT.depth == U32_MAX){
        croak("Depth overflow on clone()");
    }

    old_cv = MY_CXT.caller_cv;
    MY_CXT.caller_cv = caller_cv(aTHX);

    XCPT_TRY_START {
        retval = sv_2mortal(clone_sv(aTHX_ aMY_CXT_ sv));
    } XCPT_TRY_END

    MY_CXT.caller_cv = old_cv;

    if(--MY_CXT.depth == 0){
        hv_undef(MY_CXT.seen);
    }

    XCPT_CATCH {
        XCPT_RETHROW;
    }
    return retval;
}

static void
my_cxt_initialize(pTHX_ pMY_CXT) {
    MY_CXT.depth    = 0;
    MY_CXT.seen     = newHV();
    MY_CXT.my_clone = CvGV(get_cvs("Data::Clone::clone", GV_ADD));

    MY_CXT.object_callback = gv_fetchpvs("Data::Clone::ObjectCallback", GV_ADDMULTI, SVt_PV);

    MY_CXT.clone_method    = newSVpvs_share("clone");
    MY_CXT.tieclone_method = newSVpvs_share("TIECLONE");
}

MODULE = Data::Clone        PACKAGE = Data::Clone

PROTOTYPES: DISABLE

BOOT:
{
    MY_CXT_INIT;
    my_cxt_initialize(aTHX_ aMY_CXT);
}

#ifdef USE_ITHREADS

void
CLONE(...)
CODE: