[gitmo/Class-MOP.git] / xs / Package.xs


#include "mop.h"

static void
mop_deconstruct_variable_name(pTHX_ SV* const variable,
    const char** const var_name, STRLEN* const var_name_len,
    svtype* const type,
    const char** const type_name) {


    if(SvROK(variable) && SvTYPE(SvRV(variable)) == SVt_PVHV){
        /* e.g. variable = { type => "SCALAR", name => "foo" } */
        HV* const hv = (HV*)SvRV(variable);
        SV** svp;
        STRLEN len;
        const char* pv;

        svp = hv_fetchs(hv, "name", FALSE);
        if(!(svp && SvOK(*svp))){
            croak("You must pass a variable name");
        }
        *var_name     = SvPV_const(*svp, len);
        *var_name_len = len;
        if(len < 1){
            croak("You must pass a variable name");
        }

        svp = hv_fetchs(hv, "type", FALSE);
        if(!(svp && SvOK(*svp))) {
            croak("You must pass a variable type");
        }
        pv = SvPV_nolen_const(*svp);
        if(strEQ(pv, "SCALAR")){
            *type = SVt_PV; /* for all the type of scalars */
        }
        else if(strEQ(pv, "ARRAY")){
            *type = SVt_PVAV;
        }
        else if(strEQ(pv, "HASH")){
            *type = SVt_PVHV;
        }
        else if(strEQ(pv, "CODE")){
            *type = SVt_PVCV;
        }
        else if(strEQ(pv, "GLOB")){
            *type = SVt_PVGV;
        }
        else if(strEQ(pv, "IO")){
            *type = SVt_PVIO;
        }
        else{
            croak("I do not recognize that type '%s'", pv);
        }
        *type_name = pv;
    }
    else {
        STRLEN len;
        const char* pv;
        /* e.g. variable = '$foo' */
        if(!SvOK(variable)) {
            croak("You must pass a variable name");
        }
        pv = SvPV_const(variable, len);
        if(len < 2){
            croak("You must pass a variable name including a sigil");
        }

        *var_name     = pv  + 1;
        *var_name_len = len - 1;

        switch(pv[0]){
        case '$':
            *type      = SVt_PV; /* for all the types of scalars */
            *type_name = "SCALAR";
            break;
        case '@':
            *type      = SVt_PVAV;
            *type_name = "ARRAY";
            break;
        case '%':
            *type      = SVt_PVHV;
            *type_name = "HASH";
            break;
        case '&':
            *type      = SVt_PVCV;
            *type_name = "CODE";
            break;
        case '*':
            *type      = SVt_PVGV;
            *type_name = "GLOB";
            break;
        default:
            croak("I do not recognize that sigil '%c'", pv[0]);
        }
    }
}

static GV*
mop_get_gv(pTHX_ SV* const self, svtype const type, const char* const var_name, I32 const var_name_len, I32 const flags){
    SV* package_name;
    STRLEN len;
    const char* pv;

    if(!flags){
        SV* const ns = mop_call0(aTHX_ self, mop_namespace);
        GV** gvp;
        if(!(SvROK(ns) && SvTYPE(SvRV(ns)) == SVt_PVHV)){
            croak("namespace() did not return a hash reference");
        }
        gvp = (GV**)hv_fetch((HV*)SvRV(ns), var_name, var_name_len, FALSE);
        if(gvp && isGV_with_GP(*gvp)){
            return *gvp;
        }
    }

    package_name = mop_call0(aTHX_ self, KEY_FOR(name));

    if(!SvOK(package_name)){
        croak("name() did not return a defined value");
    }

    pv = SvPV_const(package_name, len);

    return gv_fetchpvn_flags(Perl_form(aTHX_ "%s::%s", pv, var_name), (len + var_name_len + 2), flags, type);
}

static SV*
mop_gv_elem(pTHX_ GV* const gv, svtype const type, I32 const add){
    SV* sv;

    if(!gv){
        return NULL;
    }

    assert(isGV_with_GP(gv));

    switch(type){
    case SVt_PVAV:
        sv = (SV*)(add ? GvAVn(gv) : GvAV(gv));
        break;
    case SVt_PVHV:
        sv = (SV*)(add ? GvHVn(gv) : GvHV(gv));
        break;
    case SVt_PVCV:
        sv = (SV*)GvCV(gv);
        break;
    case SVt_PVIO:
        sv = (SV*)(add ? GvIOn(gv) : GvIO(gv));
        break;
    case SVt_PVGV:
        sv = (SV*)gv;
        break;
    default: /* SCALAR */
        sv =       add ? GvSVn(gv) : GvSV(gv);
        break;
    }

    return sv;
}


static void
mop_update_method_map(pTHX_ SV *const self, SV *const class_name, HV *const stash, HV *const map)
{
    const char *const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */
    SV   *method_metaclass_name;
    char *method_name;
    I32   method_name_len;
    SV   *coderef;
    HV   *symbols;
    dSP;

    symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE);
    sv_2mortal((SV*)symbols);
    (void)hv_iterinit(symbols);
    while ( (coderef = hv_iternextsv(symbols, &method_name, &method_name_len)) ) {
        CV *cv = (CV *)SvRV(coderef);
        char *cvpkg_name;
        char *cv_name;
        SV *method_slot;
        SV *method_object;

        if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) {
            continue;
        }

        /* this checks to see that the subroutine is actually from our package  */
        if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
            if ( strNE(cvpkg_name, class_name_pv) ) {
                continue;
            }
        }

        method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
        if ( SvOK(method_slot) ) {
            SV *const body = mop_call0(aTHX_ method_slot, KEY_FOR(body)); /* $method_object->body() */
            if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) {
                continue;
            }
        }

        method_metaclass_name = mop_call0(aTHX_ self, mop_method_metaclass); /* $self->method_metaclass() */

        /*
            $method_object = $method_metaclass->wrap(
                $cv,
                associated_metaclass => $self,
                package_name         => $class_name,
                name                 => $method_name
            );
        */
        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        EXTEND(SP, 8);
        PUSHs(method_metaclass_name); /* invocant */
        mPUSHs(newRV_inc((SV *)cv));
        PUSHs(mop_associated_metaclass);
        PUSHs(self);
        PUSHs(KEY_FOR(package_name));
        PUSHs(class_name);
        PUSHs(KEY_FOR(name));
        mPUSHs(newSVpv(method_name, method_name_len));
        PUTBACK;

        call_sv(mop_wrap, G_SCALAR | G_METHOD);
        SPAGAIN;
        method_object = POPs;
        PUTBACK;
        /* $map->{$method_name} = $method_object */
        sv_setsv(method_slot, method_object);

        FREETMPS;
        LEAVE;
    }
}

MODULE = Class::MOP::Package   PACKAGE = Class::MOP::Package

PROTOTYPES: DISABLE

void
get_all_package_symbols(self, filter=TYPE_FILTER_NONE)
    SV *self
    type_filter_t filter
    PREINIT:
        HV *stash = NULL;
        HV *symbols = NULL;
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call get_all_package_symbols as a class method");
        }

        if (GIMME_V == G_VOID) {
            XSRETURN_EMPTY;
        }

        PUTBACK;

        if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) {
            stash = gv_stashsv(HeVAL(he), 0);
        }


        if (!stash) {
            XSRETURN_UNDEF;
        }

        symbols = mop_get_all_package_symbols(stash, filter);
        PUSHs(sv_2mortal(newRV_noinc((SV *)symbols)));

void
get_method_map(self)
    SV *self
    PREINIT:
        HV *const obj        = (HV *)SvRV(self);
        SV *const class_name = HeVAL( hv_fetch_ent(obj, KEY_FOR(package), 0, HASH_FOR(package)) );
        HV *const stash      = gv_stashsv(class_name, 0);
        UV current;
        SV *cache_flag;
        SV *map_ref;
    PPCODE:
        if (!stash) {
             mXPUSHs(newRV_noinc((SV *)newHV()));
             return;
        }

        current    = mop_check_package_cache_flag(aTHX_ stash);
        cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag)));
        map_ref    = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods)));

        /* $self->{methods} does not yet exist (or got deleted) */
        if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) {
            SV *new_map_ref = newRV_noinc((SV *)newHV());
            sv_2mortal(new_map_ref);
            sv_setsv(map_ref, new_map_ref);
        }

        if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) {
            mop_update_method_map(aTHX_ self, class_name, stash, (HV *)SvRV(map_ref));
            sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */
        }

        XPUSHs(map_ref);

BOOT:
    INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package);


SV*
add_package_symbol(SV* self, SV* variable, SV* ref = &PL_sv_undef)
PREINIT:
    svtype type;
    const char* type_name;
    const char* var_name;
    STRLEN var_name_len;
    GV* gv;
CODE:
    mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name);
    gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, GV_ADDMULTI);

    if(SvOK(ref)){ /* add_package_symbol with a value */
        if(type == SVt_PV){
            if(!SvROK(ref)){
                ref = newRV_noinc(newSVsv(ref));
                sv_2mortal(ref);
            }
        }
        else if(!(SvROK(ref) && SvTYPE(SvRV(ref)) == type)){
            croak("You must pass a reference of %s for the value of %s", type_name, GvNAME(CvGV(cv)));
        }

        if(type == SVt_PVCV && GvCV(gv)){
            /* XXX: clear it before redefinition */
            SvREFCNT_dec(GvCV(gv));
            GvCV(gv) = NULL;
        }
        sv_setsv_mg((SV*)gv, ref); /* magical assignment into type glob (*glob = $ref) */

        if(type == SVt_PVCV){ /* name a subroutine */
            CV* const subr = (CV*)SvRV(ref);
            if(CvANON(subr)
                && CvGV(subr)
                && isGV(CvGV(subr))
                && strEQ(GvNAME(CvGV(subr)), "__ANON__")){

                /* NOTE:
                    A gv "has-a" cv, but a cv refers to a gv as a (pseudo) weak ref.
                    so we can replace CvGV with no SvREFCNT_inc/dec.
                */
                CvGV(subr) = gv;
                CvANON_off(subr);
            }
        }
        RETVAL = ref;
        SvREFCNT_inc_simple_void_NN(ref);
    }
    else{
        SV* const sv = mop_gv_elem(aTHX_ gv, type, GV_ADDMULTI);
        RETVAL = (sv && GIMME_V != G_VOID) ? newRV_inc(sv) : &PL_sv_undef;
    }
OUTPUT:
    RETVAL

bool
has_package_symbol(SV* self, SV* variable)
PREINIT:
    svtype type;
    const char* type_name;
    const char* var_name;
    STRLEN var_name_len;
    GV* gv;
CODE:
    mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name);
    gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, 0);
    if(type == SVt_PV){
        /* In SCALAR, for backword compatibility,
           defined(${*gv{SCALAR}}) instead of defined(*gv{SCALAR}) */
        SV* const sv = mop_gv_elem(aTHX_ gv, type, FALSE);
        RETVAL = (sv && SvOK(sv)) ? TRUE : FALSE;
    }
    else{
        /* Otherwise, defined(*gv{TYPE}) */
        RETVAL = mop_gv_elem(aTHX_ gv, type, FALSE) ? TRUE : FALSE;
    }
OUTPUT:
    RETVAL

SV*
get_package_symbol(SV* self, SV* variable, ...)
PREINIT:
    svtype type;
    const char* type_name;
    const char* var_name;
    STRLEN var_name_len;
    I32 flags = 0;
    GV* gv;
    SV* sv;
CODE:
    if(items > 2){ /* parse options */
        I32 i;
        if((items % 2) != 0){
            croak("Odd number of arguments for get_package_symbol()");
        }
        for(i = 2; i < items; i += 2){
            SV* const opt = ST(i);
            SV* const val = ST(i+1);
            if(strEQ(SvPV_nolen_const(opt), "create")){
                if(SvTRUE(val)){
                    flags |= GV_ADDMULTI;
                }
                else{
                    flags &= ~GV_ADDMULTI;
                }
            }
            else{
                warn("Unknown option \"%"SVf"\" for get_package_symbol()", opt);
            }
        }
    }
    mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name);
    gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, flags);
    sv = mop_gv_elem(aTHX_ gv, type, FALSE);

    RETVAL = sv ? newRV_inc(sv) : &PL_sv_undef;
OUTPUT:
    RETVAL
Commit	Line	Data
982b6f24	1
d846ade3	2	#include "mop.h"
d846ade3	3
e2e116c2	4	static void
	5	mop_deconstruct_variable_name(pTHX_ SV* const variable,
	6	const char** const var_name, STRLEN* const var_name_len,
	7	svtype* const type,
9742ab2a	8	const char** const type_name) {
e2e116c2	9
e170f134	10
4beb9a9a	11	if(SvROK(variable) && SvTYPE(SvRV(variable)) == SVt_PVHV){
	12	/* e.g. variable = { type => "SCALAR", name => "foo" } */
	13	HV* const hv = (HV*)SvRV(variable);
	14	SV** svp;
	15	STRLEN len;
	16	const char* pv;
	17
	18	svp = hv_fetchs(hv, "name", FALSE);
	19	if(!(svp && SvOK(*svp))){
	20	croak("You must pass a variable name");
	21	}
	22	var_name = SvPV_const(svp, len);
	23	*var_name_len = len;
	24	if(len < 1){
	25	croak("You must pass a variable name");
	26	}
	27
	28	svp = hv_fetchs(hv, "type", FALSE);
	29	if(!(svp && SvOK(*svp))) {
	30	croak("You must pass a variable type");
	31	}
	32	pv = SvPV_nolen_const(*svp);
	33	if(strEQ(pv, "SCALAR")){
	34	type = SVt_PV; / for all the type of scalars */
	35	}
	36	else if(strEQ(pv, "ARRAY")){
	37	*type = SVt_PVAV;
	38	}
	39	else if(strEQ(pv, "HASH")){
	40	*type = SVt_PVHV;
	41	}
	42	else if(strEQ(pv, "CODE")){
	43	*type = SVt_PVCV;
	44	}
	45	else if(strEQ(pv, "GLOB")){
	46	*type = SVt_PVGV;
	47	}
	48	else if(strEQ(pv, "IO")){
	49	*type = SVt_PVIO;
	50	}
	51	else{
	52	croak("I do not recognize that type '%s'", pv);
	53	}
	54	*type_name = pv;
	55	}
	56	else {
	57	STRLEN len;
	58	const char* pv;
	59	/* e.g. variable = '$foo' */
	60	if(!SvOK(variable)) {
	61	croak("You must pass a variable name");
	62	}
	63	pv = SvPV_const(variable, len);
	64	if(len < 2){
	65	croak("You must pass a variable name including a sigil");
	66	}
	67
	68	*var_name = pv + 1;
	69	*var_name_len = len - 1;
	70
	71	switch(pv[0]){
	72	case '$':
	73	type = SVt_PV; / for all the types of scalars */
	74	*type_name = "SCALAR";
75	break;
76	case '@':
77	*type = SVt_PVAV;
78	*type_name = "ARRAY";
79	break;
80	case '%':
81	*type = SVt_PVHV;
82	*type_name = "HASH";
83	break;
84	case '&':
85	*type = SVt_PVCV;
86	*type_name = "CODE";
87	break;
88	case '*':
89	*type = SVt_PVGV;
90	*type_name = "GLOB";
91	break;
92	default:
93	croak("I do not recognize that sigil '%c'", pv[0]);
94	}
95	}
e170f134	96	}
e170f134	97
9742ab2a	98	static GV*
9742ab2a	99	mop_get_gv(pTHX_ SV* const self, svtype const type, const char* const var_name, I32 const var_name_len, I32 const flags){
4beb9a9a	100	SV* package_name;
29d0da04	101	STRLEN len;
29d0da04	102	const char* pv;
4beb9a9a	103
dc9dd539	104	if(!flags){
4beb9a9a	105	SV* const ns = mop_call0(aTHX_ self, mop_namespace);
	106	GV** gvp;
	107	if(!(SvROK(ns) && SvTYPE(SvRV(ns)) == SVt_PVHV)){
	108	croak("namespace() did not return a hash reference");
	109	}
	110	gvp = (GV*)hv_fetch((HV)SvRV(ns), var_name, var_name_len, FALSE);
	111	if(gvp && isGV_with_GP(*gvp)){
	112	return *gvp;
	113	}
	114	}
	115
	116	package_name = mop_call0(aTHX_ self, KEY_FOR(name));
	117
	118	if(!SvOK(package_name)){
	119	croak("name() did not return a defined value");
	120	}
	121
29d0da04	122	pv = SvPV_const(package_name, len);
	123
	124	return gv_fetchpvn_flags(Perl_form(aTHX_ "%s::%s", pv, var_name), (len + var_name_len + 2), flags, type);
9742ab2a	125	}
	126
	127	static SV*
	128	mop_gv_elem(pTHX_ GV* const gv, svtype const type, I32 const add){
4beb9a9a	129	SV* sv;
	130
	131	if(!gv){
	132	return NULL;
	133	}
	134
	135	assert(isGV_with_GP(gv));
	136
	137	switch(type){
	138	case SVt_PVAV:
	139	sv = (SV*)(add ? GvAVn(gv) : GvAV(gv));
	140	break;
	141	case SVt_PVHV:
	142	sv = (SV*)(add ? GvHVn(gv) : GvHV(gv));
	143	break;
	144	case SVt_PVCV:
	145	sv = (SV*)GvCV(gv);
	146	break;
	147	case SVt_PVIO:
	148	sv = (SV*)(add ? GvIOn(gv) : GvIO(gv));
	149	break;
	150	case SVt_PVGV:
	151	sv = (SV*)gv;
	152	break;
	153	default: /* SCALAR */
	154	sv = add ? GvSVn(gv) : GvSV(gv);
	155	break;
	156	}
	157
	158	return sv;
9742ab2a	159	}
	160
	161
c8fd7a1e	162	static void
b1ff395f	163	mop_update_method_map(pTHX_ SV const self, SV const class_name, HV const stash, HV const map)
	164	{
	165	const char const class_name_pv = HvNAME(stash); / must be HvNAME(stash), not SvPV_nolen_const(class_name) */
	166	SV *method_metaclass_name;
	167	char *method_name;
	168	I32 method_name_len;
	169	SV *coderef;
	170	HV *symbols;
	171	dSP;
	172
	173	symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE);
	174	sv_2mortal((SV*)symbols);
	175	(void)hv_iterinit(symbols);
	176	while ( (coderef = hv_iternextsv(symbols, &method_name, &method_name_len)) ) {
	177	CV cv = (CV )SvRV(coderef);
	178	char *cvpkg_name;
	179	char *cv_name;
	180	SV *method_slot;
	181	SV *method_object;
	182
	183	if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) {
	184	continue;
	185	}
	186
	187	/* this checks to see that the subroutine is actually from our package */
	188	if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
	189	if ( strNE(cvpkg_name, class_name_pv) ) {
	190	continue;
	191	}
	192	}
	193
	194	method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
	195	if ( SvOK(method_slot) ) {
	196	SV const body = mop_call0(aTHX_ method_slot, KEY_FOR(body)); / $method_object->body() */
	197	if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) {
	198	continue;
	199	}
	200	}
	201
	202	method_metaclass_name = mop_call0(aTHX_ self, mop_method_metaclass); /* $self->method_metaclass() */
	203
	204	/*
	205	$method_object = $method_metaclass->wrap(
	206	$cv,
	207	associated_metaclass => $self,
	208	package_name => $class_name,
	209	name => $method_name
	210	);
	211	*/
	212	ENTER;
	213	SAVETMPS;
	214
	215	PUSHMARK(SP);
	216	EXTEND(SP, 8);
	217	PUSHs(method_metaclass_name); /* invocant */
	218	mPUSHs(newRV_inc((SV *)cv));
	219	PUSHs(mop_associated_metaclass);
	220	PUSHs(self);
	221	PUSHs(KEY_FOR(package_name));
	222	PUSHs(class_name);
	223	PUSHs(KEY_FOR(name));
	224	mPUSHs(newSVpv(method_name, method_name_len));
	225	PUTBACK;
	226
227	call_sv(mop_wrap, G_SCALAR \| G_METHOD);
228	SPAGAIN;
229	method_object = POPs;
230	PUTBACK;
231	/* $map->{$method_name} = $method_object */
232	sv_setsv(method_slot, method_object);
233
234	FREETMPS;
235	LEAVE;
236	}
237	}
238
d846ade3	239	MODULE = Class::MOP::Package PACKAGE = Class::MOP::Package
	240
	241	PROTOTYPES: DISABLE
	242
	243	void
	244	get_all_package_symbols(self, filter=TYPE_FILTER_NONE)
	245	SV *self
	246	type_filter_t filter
	247	PREINIT:
	248	HV *stash = NULL;
	249	HV *symbols = NULL;
	250	register HE *he;
	251	PPCODE:
	252	if ( ! SvROK(self) ) {
	253	die("Cannot call get_all_package_symbols as a class method");
	254	}
	255
	256	if (GIMME_V == G_VOID) {
	257	XSRETURN_EMPTY;
	258	}
	259
	260	PUTBACK;
	261
22932438	262	if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) {
d846ade3	263	stash = gv_stashsv(HeVAL(he), 0);
	264	}
	265
	266
	267	if (!stash) {
	268	XSRETURN_UNDEF;
	269	}
	270
e1f52a8a	271	symbols = mop_get_all_package_symbols(stash, filter);
d846ade3	272	PUSHs(sv_2mortal(newRV_noinc((SV *)symbols)));
d846ade3	273
b1ff395f	274	void
	275	get_method_map(self)
	276	SV *self
	277	PREINIT:
	278	HV const obj = (HV )SvRV(self);
	279	SV *const class_name = HeVAL( hv_fetch_ent(obj, KEY_FOR(package), 0, HASH_FOR(package)) );
	280	HV *const stash = gv_stashsv(class_name, 0);
	281	UV current;
	282	SV *cache_flag;
	283	SV *map_ref;
	284	PPCODE:
	285	if (!stash) {
	286	mXPUSHs(newRV_noinc((SV *)newHV()));
	287	return;
	288	}
	289
	290	current = mop_check_package_cache_flag(aTHX_ stash);
	291	cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag)));
	292	map_ref = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods)));
	293
	294	/* $self->{methods} does not yet exist (or got deleted) */
	295	if ( !SvROK(map_ref) \|\| SvTYPE(SvRV(map_ref)) != SVt_PVHV ) {
	296	SV new_map_ref = newRV_noinc((SV )newHV());
	297	sv_2mortal(new_map_ref);
	298	sv_setsv(map_ref, new_map_ref);
	299	}
	300
	301	if ( !SvOK(cache_flag) \|\| SvUV(cache_flag) != current ) {
	302	mop_update_method_map(aTHX_ self, class_name, stash, (HV *)SvRV(map_ref));
	303	sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */
	304	}
	305
	306	XPUSHs(map_ref);
	307
7ec7b950	308	BOOT:
7ec7b950	309	INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package);
e170f134	310
e2e116c2	311
e170f134	312	SV*
	313	add_package_symbol(SV* self, SV* variable, SV* ref = &PL_sv_undef)
	314	PREINIT:
4beb9a9a	315	svtype type;
	316	const char* type_name;
	317	const char* var_name;
	318	STRLEN var_name_len;
	319	GV* gv;
e170f134	320	CODE:
4beb9a9a	321	mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name);
	322	gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, GV_ADDMULTI);
	323
	324	if(SvOK(ref)){ /* add_package_symbol with a value */
	325	if(type == SVt_PV){
	326	if(!SvROK(ref)){
	327	ref = newRV_noinc(newSVsv(ref));
	328	sv_2mortal(ref);
	329	}
	330	}
	331	else if(!(SvROK(ref) && SvTYPE(SvRV(ref)) == type)){
	332	croak("You must pass a reference of %s for the value of %s", type_name, GvNAME(CvGV(cv)));
	333	}
	334
	335	if(type == SVt_PVCV && GvCV(gv)){
	336	/* XXX: clear it before redefinition */
	337	SvREFCNT_dec(GvCV(gv));
	338	GvCV(gv) = NULL;
	339	}
	340	sv_setsv_mg((SV)gv, ref); / magical assignment into type glob (glob = $ref) /
	341
	342	if(type == SVt_PVCV){ /* name a subroutine */
	343	CV* const subr = (CV*)SvRV(ref);
	344	if(CvANON(subr)
	345	&& CvGV(subr)
	346	&& isGV(CvGV(subr))
	347	&& strEQ(GvNAME(CvGV(subr)), "__ANON__")){
	348
3b7c6e11	349	/* NOTE:
	350	A gv "has-a" cv, but a cv refers to a gv as a (pseudo) weak ref.
	351	so we can replace CvGV with no SvREFCNT_inc/dec.
	352	*/
4beb9a9a	353	CvGV(subr) = gv;
	354	CvANON_off(subr);
	355	}
	356	}
	357	RETVAL = ref;
	358	SvREFCNT_inc_simple_void_NN(ref);
	359	}
	360	else{
	361	SV* const sv = mop_gv_elem(aTHX_ gv, type, GV_ADDMULTI);
	362	RETVAL = (sv && GIMME_V != G_VOID) ? newRV_inc(sv) : &PL_sv_undef;
	363	}
9742ab2a	364	OUTPUT:
4beb9a9a	365	RETVAL
982b6f24	366
9742ab2a	367	bool
	368	has_package_symbol(SV* self, SV* variable)
	369	PREINIT:
4beb9a9a	370	svtype type;
	371	const char* type_name;
	372	const char* var_name;
	373	STRLEN var_name_len;
	374	GV* gv;
9742ab2a	375	CODE:
4beb9a9a	376	mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name);
4beb9a9a	377	gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, 0);
dc9dd539	378	if(type == SVt_PV){
	379	/* In SCALAR, for backword compatibility,
	380	defined(${gv{SCALAR}}) instead of defined(gv{SCALAR}) */
	381	SV* const sv = mop_gv_elem(aTHX_ gv, type, FALSE);
	382	RETVAL = (sv && SvOK(sv)) ? TRUE : FALSE;
	383	}
	384	else{
	385	/* Otherwise, defined(gv{TYPE}) /
	386	RETVAL = mop_gv_elem(aTHX_ gv, type, FALSE) ? TRUE : FALSE;
	387	}
9742ab2a	388	OUTPUT:
4beb9a9a	389	RETVAL
e170f134	390
9742ab2a	391	SV*
	392	get_package_symbol(SV* self, SV* variable, ...)
	393	PREINIT:
4beb9a9a	394	svtype type;
	395	const char* type_name;
	396	const char* var_name;
	397	STRLEN var_name_len;
	398	I32 flags = 0;
	399	GV* gv;
	400	SV* sv;
9742ab2a	401	CODE:
b1f957d2	402	if(items > 2){ /* parse options */
4beb9a9a	403	I32 i;
	404	if((items % 2) != 0){
	405	croak("Odd number of arguments for get_package_symbol()");
	406	}
	407	for(i = 2; i < items; i += 2){
	408	SV* const opt = ST(i);
	409	SV* const val = ST(i+1);
	410	if(strEQ(SvPV_nolen_const(opt), "create")){
	411	if(SvTRUE(val)){
	412	flags \|= GV_ADDMULTI;
	413	}
	414	else{
	415	flags &= ~GV_ADDMULTI;
	416	}
	417	}
	418	else{
	419	warn("Unknown option \"%"SVf"\" for get_package_symbol()", opt);
	420	}
	421	}
	422	}
	423	mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name);
	424	gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, flags);
	425	sv = mop_gv_elem(aTHX_ gv, type, FALSE);
	426
	427	RETVAL = sv ? newRV_inc(sv) : &PL_sv_undef;
9742ab2a	428	OUTPUT:
4beb9a9a	429	RETVAL