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

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define NEED_sv_2pv_flags
#define NEED_sv_2pv_nolen
#include "ppport.h"

SV *key_name;
U32 hash_name;

SV *key_package;
U32 hash_package;

SV *key_package_name;
U32 hash_package_name;

SV *key_body;
U32 hash_body;

SV* method_metaclass;
SV* associated_metaclass;
SV* wrap;


#define check_package_cache_flag(stash) mop_check_package_cache_flag(aTHX_ stash)
#ifdef HvMROMETA /* 5.10.0 */

#ifndef mro_meta_init
#define mro_meta_init(stash) Perl_mro_meta_init(aTHX_ stash) /* used in HvMROMETA macro */
#endif /* !mro_meta_init */

static UV
mop_check_package_cache_flag(pTHX_ HV* stash) {
    assert(SvTYPE(stash) == SVt_PVHV);

    return HvMROMETA(stash)->pkg_gen; /* mro::get_pkg_gen($pkg) */
}

#else /* pre 5.10.0 */

static UV
mop_check_package_cache_flag(pTHX_ HV* stash) {
    PERL_UNUSED_ARG(stash);
    assert(SvTYPE(stash) == SVt_PVHV);

    return PL_sub_generation;
}
#endif

#define call0(s, m)  mop_call0(aTHX_ s, m)
static SV*
mop_call0(pTHX_ SV* const self, SV* const method) {
    dSP;
    SV* ret;

    PUSHMARK(SP);
    XPUSHs(self);
    PUTBACK;

    call_sv(method, G_SCALAR | G_METHOD);

    SPAGAIN;
    ret = POPs;
    PUTBACK;

    return ret;
}

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;
    GV* gv;
    dSP;
    
    hv_iterinit(stash);
    while ( gv = (GV*)hv_iternextsv(stash, &method_name, &method_name_len) ) {
        CV* cv;
        if ( SvROK(gv) ) {
            /* rafl says that this wastes memory savings that GvSVs have
               in 5.8.9 and 5.10.x. But without it some tests fail. rafl
               says the right thing to do is to handle GvSVs differently
               here. */
            gv_init((GV*)gv, stash, method_name, method_name_len, GV_ADDMULTI);
        }

        if ( SvTYPE(gv) == SVt_PVGV && (cv = GvCVu(gv)) ) {
            GV* const cvgv = CvGV(cv);
            /* ($cvpkg_name, $cv_name) = get_code_info($cv) */
            const char* const cvpkg_name = HvNAME(GvSTASH(cvgv));
            const char* const cv_name    = GvNAME(cvgv);
            SV* method_slot;
            SV* method_object;

            /* 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 = call0(method_slot, key_body); /* $method_object->body() */
                if ( SvROK(body) && ((CV*) SvRV(body)) == cv ) {
                    continue;
                }
            }

            method_metaclass_name = call0(self, 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(associated_metaclass);
            PUSHs(self);
            PUSHs(key_package_name);
            PUSHs(class_name);
            PUSHs(key_name);
            mPUSHs(newSVpv(method_name, method_name_len));
            PUTBACK;

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

            FREETMPS;
            LEAVE;
        }
    }
}


/*
get_code_info:
  Pass in a coderef, returns:
  [ $pkg_name, $coderef_name ] ie:
  [ 'Foo::Bar', 'new' ]
*/

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

BOOT:
    key_name = newSVpvs("name");
    key_body = newSVpvs("body");
    key_package = newSVpvs("package");
    key_package_name = newSVpvs("package_name");

    PERL_HASH(hash_name, "name", 4);
    PERL_HASH(hash_body, "body", 4);
    PERL_HASH(hash_package, "package", 7);
    PERL_HASH(hash_package_name, "package_name", 12);

    method_metaclass     = newSVpvs("method_metaclass");
    wrap                 = newSVpvs("wrap");
    associated_metaclass = newSVpvs("associated_metaclass");


PROTOTYPES: ENABLE


void
get_code_info(coderef)
  SV* coderef
  PREINIT:
    char* name;
    char* pkg;
  PPCODE:
    if ( SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV ) {
      coderef = SvRV(coderef);
      /* I think this only gets triggered with a mangled coderef, but if
         we hit it without the guard, we segfault. The slightly odd return
         value strikes me as an improvement (mst)
      */
#ifdef isGV_with_GP
      if ( isGV_with_GP(CvGV(coderef)) ) {
#endif
        pkg     = HvNAME( GvSTASH(CvGV(coderef)) );
        name    = GvNAME( CvGV(coderef) );
#ifdef isGV_with_GP
      } else {
        pkg     = "__UNKNOWN__";
        name    = "__ANON__";
      }
#endif

      EXTEND(SP, 2);
      PUSHs(newSVpvn(pkg, strlen(pkg)));
      PUSHs(newSVpvn(name, strlen(name)));
    }


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

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

        switch (GIMME_V) {
            case G_VOID: return; break;
            case G_SCALAR: ST(0) = &PL_sv_undef; return; break;
        }

        if ( items > 1 ) type_filter = ST(1);

        PUTBACK;

        if ( (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)) )
            stash = gv_stashsv(HeVAL(he),0);

        if (stash) {

            (void)hv_iterinit(stash);

            if ( type_filter && SvPOK(type_filter) ) {
                const char *const type = SvPV_nolen(type_filter);

                while ( (he = hv_iternext(stash)) ) {
                    SV *const gv = HeVAL(he);
                    SV *sv;
                    char *key;
                    STRLEN keylen;
                    char *package;
                    SV *fq;

                    switch( SvTYPE(gv) ) {
                        case SVt_PVGV:
                            switch (*type) {
                                case 'C': sv = (SV *)GvCVu(gv); break; /* CODE */
                                case 'A': sv = (SV *)GvAV(gv); break; /* ARRAY */
                                case 'I': sv = (SV *)GvIO(gv); break; /* IO */
                                case 'H': sv = (SV *)GvHV(gv); break; /* HASH */
                                case 'S': sv = (SV *)GvSV(gv); break; /* SCALAR */
                                default:
                                          croak("Unknown type %s\n", type);
                            }
                            break;
                        case SVt_RV:
                            /* BAH! constants are horrible */

                            if ( ! SvROK(gv) ) {
                                continue;
                            }

                            /* we don't really care about the length,
                               but that's the API */
                            key = HePV(he, keylen);
                            package = HvNAME(stash);
                            fq = newSVpvf("%s::%s", package, key);
                            sv = (SV*)get_cv(SvPV_nolen(fq), 0);
                            break;
                        default:
                            continue;
                    }

                    if (sv) {
                        SV *key = hv_iterkeysv(he);
                        SPAGAIN;
                        EXTEND(SP, 2);
                        PUSHs(key);
                        PUSHs(sv_2mortal(newRV_inc(sv)));
                        PUTBACK;
                    }
                }
            } else {
                EXTEND(SP, HvKEYS(stash) * 2);

                while (he = hv_iternext(stash)) {
                    SV *key = hv_iterkeysv(he);
                    SV *sv = HeVAL(he);
                    SPAGAIN;
                    PUSHs(key);
                    PUSHs(sv);
                    PUTBACK;
                }
            }

        }

void
name(self)
    SV *self
    PREINIT:
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call name as a class method");
        }

        if ( he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package) )
            XPUSHs(HeVAL(he));
        else
            ST(0) = &PL_sv_undef;

MODULE = Class::MOP   PACKAGE = Class::MOP::Attribute

void
name(self)
    SV *self
    PREINIT:
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call name as a class method");
        }

        if ( he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name) )
            XPUSHs(HeVAL(he));
        else
            ST(0) = &PL_sv_undef;

MODULE = Class::MOP   PACKAGE = Class::MOP::Method

void
name(self)
    SV *self
    PREINIT:
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call name as a class method");
        }

        if ( he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name) )
            XPUSHs(HeVAL(he));
        else
            ST(0) = &PL_sv_undef;

void
package_name(self)
    SV *self
    PREINIT:
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call package_name as a class method");
        }

        if ( he = hv_fetch_ent((HV *)SvRV(self), key_package_name, 0, hash_package_name) )
            XPUSHs(HeVAL(he));
        else
            ST(0) = &PL_sv_undef;

void
body(self)
    SV *self
    PREINIT:
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call body as a class method");
        }

        if ( he = hv_fetch_ent((HV *)SvRV(self), key_body, 0, hash_body) )
            XPUSHs(HeVAL(he));
        else
            ST(0) = &PL_sv_undef;


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

void
get_method_map(self)
    SV* self
INIT:
    if ( !SvRV(self) ) {
        die("Cannot call get_method_map as a class method");
    }
CODE:
    HE* const he         = hv_fetch_ent((HV*)SvRV(self), key_package, TRUE, hash_package); /* $self->name() */
    SV* const class_name = HeVAL(he);
    HV* const stash      = gv_stashsv(class_name, TRUE);
    UV  const current    = check_package_cache_flag(stash);
    SV* const cache_flag = *hv_fetchs((HV*)SvRV(self), "_package_cache_flag", TRUE);
    SV* const map_ref    = *hv_fetchs((HV*)SvRV(self), "methods", TRUE);

    /* in  $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) ) {
        ENTER;
        SAVETMPS;

        mop_update_method_map(aTHX_ self, class_name, stash, (HV*)SvRV(map_ref));
        sv_setuv(cache_flag, check_package_cache_flag(stash)); /* update_cache_flag() */

        FREETMPS;
        LEAVE;
    }
    ST(0) = map_ref; /* map_ref is already mortal */
Commit	Line	Data
e0e4674a	1	#include "EXTERN.h"
	2	#include "perl.h"
	3	#include "XSUB.h"
15273f3c	4
599791aa	5	#define NEED_sv_2pv_flags
15273f3c	6	#define NEED_sv_2pv_nolen
b0e94057	7	#include "ppport.h"
e0e4674a	8
cc856b56	9	SV *key_name;
	10	U32 hash_name;
	11
	12	SV *key_package;
	13	U32 hash_package;
	14
da88f307	15	SV *key_package_name;
	16	U32 hash_package_name;
	17
cc856b56	18	SV *key_body;
	19	U32 hash_body;
	20
c94afdc4	21	SV* method_metaclass;
	22	SV* associated_metaclass;
	23	SV* wrap;
	24
	25
	26	#define check_package_cache_flag(stash) mop_check_package_cache_flag(aTHX_ stash)
	27	#ifdef HvMROMETA /* 5.10.0 */
	28
	29	#ifndef mro_meta_init
	30	#define mro_meta_init(stash) Perl_mro_meta_init(aTHX_ stash) /* used in HvMROMETA macro */
	31	#endif /* !mro_meta_init */
	32
	33	static UV
	34	mop_check_package_cache_flag(pTHX_ HV* stash) {
	35	assert(SvTYPE(stash) == SVt_PVHV);
	36
	37	return HvMROMETA(stash)->pkg_gen; /* mro::get_pkg_gen($pkg) */
	38	}
	39
	40	#else /* pre 5.10.0 */
	41
	42	static UV
	43	mop_check_package_cache_flag(pTHX_ HV* stash) {
	44	PERL_UNUSED_ARG(stash);
	45	assert(SvTYPE(stash) == SVt_PVHV);
	46
	47	return PL_sub_generation;
	48	}
	49	#endif
	50
	51	#define call0(s, m) mop_call0(aTHX_ s, m)
	52	static SV*
	53	mop_call0(pTHX_ SV* const self, SV* const method) {
	54	dSP;
	55	SV* ret;
	56
	57	PUSHMARK(SP);
	58	XPUSHs(self);
	59	PUTBACK;
	60
	61	call_sv(method, G_SCALAR \| G_METHOD);
	62
	63	SPAGAIN;
	64	ret = POPs;
	65	PUTBACK;
	66
	67	return ret;
	68	}
	69
	70	static void
	71	mop_update_method_map(pTHX_ SV* const self, SV* const class_name, HV* const stash, HV* const map) {
	72	const char* const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */
	73	SV* method_metaclass_name;
	74	char* method_name;
	75	I32 method_name_len;
	76	GV* gv;
	77	dSP;
	78
	79	hv_iterinit(stash);
a7f711e5	80	while ( gv = (GV*)hv_iternextsv(stash, &method_name, &method_name_len) ) {
c94afdc4	81	CV* cv;
	82	if ( SvROK(gv) ) {
	83	/* rafl says that this wastes memory savings that GvSVs have
	84	in 5.8.9 and 5.10.x. But without it some tests fail. rafl
	85	says the right thing to do is to handle GvSVs differently
	86	here. */
	87	gv_init((GV*)gv, stash, method_name, method_name_len, GV_ADDMULTI);
	88	}
	89
	90	if ( SvTYPE(gv) == SVt_PVGV && (cv = GvCVu(gv)) ) {
	91	GV* const cvgv = CvGV(cv);
	92	/* ($cvpkg_name, $cv_name) = get_code_info($cv) */
	93	const char* const cvpkg_name = HvNAME(GvSTASH(cvgv));
	94	const char* const cv_name = GvNAME(cvgv);
	95	SV* method_slot;
	96	SV* method_object;
	97
	98	/* this checks to see that the subroutine is actually from our package */
	99	if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
	100	if ( strNE(cvpkg_name, class_name_pv) ) {
	101	continue;
	102	}
	103	}
	104
	105	method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
	106	if ( SvOK(method_slot) ) {
	107	SV* const body = call0(method_slot, key_body); /* $method_object->body() */
	108	if ( SvROK(body) && ((CV*) SvRV(body)) == cv ) {
	109	continue;
	110	}
	111	}
	112
	113	method_metaclass_name = call0(self, method_metaclass); /* $self->method_metaclass() */
	114
	115	/*
	116	$method_object = $method_metaclass->wrap(
	117	$cv,
	118	associated_metaclass => $self,
	119	package_name => $class_name,
	120	name => $method_name
	121	);
	122	*/
	123	ENTER;
	124	SAVETMPS;
	125
	126	PUSHMARK(SP);
	127	EXTEND(SP, 8);
	128	PUSHs(method_metaclass_name); /* invocant */
	129	mPUSHs(newRV_inc((SV*)cv));
	130	PUSHs(associated_metaclass);
	131	PUSHs(self);
	132	PUSHs(key_package_name);
	133	PUSHs(class_name);
	134	PUSHs(key_name);
	135	mPUSHs(newSVpv(method_name, method_name_len));
	136	PUTBACK;
	137
	138	call_sv(wrap, G_SCALAR \| G_METHOD);
	139	SPAGAIN;
	140	method_object = POPs;
	141	PUTBACK;
	142	/* $map->{$method_name} = $method_object */
	143	sv_setsv(method_slot, method_object);
	144
145	FREETMPS;
146	LEAVE;
147	}
148	}
149	}
150
151
e0e4674a	152	/*
e0e4674a	153	get_code_info:
	154	Pass in a coderef, returns:
	155	[ $pkg_name, $coderef_name ] ie:
	156	[ 'Foo::Bar', 'new' ]
	157	*/
	158
	159	MODULE = Class::MOP PACKAGE = Class::MOP
	160
cc856b56	161	BOOT:
	162	key_name = newSVpvs("name");
	163	key_body = newSVpvs("body");
	164	key_package = newSVpvs("package");
da88f307	165	key_package_name = newSVpvs("package_name");
cc856b56	166
	167	PERL_HASH(hash_name, "name", 4);
	168	PERL_HASH(hash_body, "body", 4);
	169	PERL_HASH(hash_package, "package", 7);
da88f307	170	PERL_HASH(hash_package_name, "package_name", 12);
cc856b56	171
c94afdc4	172	method_metaclass = newSVpvs("method_metaclass");
	173	wrap = newSVpvs("wrap");
	174	associated_metaclass = newSVpvs("associated_metaclass");
	175
cc856b56	176
d7bf3478	177	PROTOTYPES: ENABLE
d7bf3478	178
cc856b56	179
e0e4674a	180	void
	181	get_code_info(coderef)
	182	SV* coderef
	183	PREINIT:
	184	char* name;
	185	char* pkg;
	186	PPCODE:
a7f711e5	187	if ( SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV ) {
e0e4674a	188	coderef = SvRV(coderef);
7b62d87f	189	/* I think this only gets triggered with a mangled coderef, but if
	190	we hit it without the guard, we segfault. The slightly odd return
	191	value strikes me as an improvement (mst)
	192	*/
a4f4221a	193	#ifdef isGV_with_GP
a7f711e5	194	if ( isGV_with_GP(CvGV(coderef)) ) {
a4f4221a	195	#endif
7b62d87f	196	pkg = HvNAME( GvSTASH(CvGV(coderef)) );
7b62d87f	197	name = GvNAME( CvGV(coderef) );
a4f4221a	198	#ifdef isGV_with_GP
	199	} else {
	200	pkg = "__UNKNOWN__";
	201	name = "__ANON__";
	202	}
	203	#endif
e0e4674a	204
	205	EXTEND(SP, 2);
	206	PUSHs(newSVpvn(pkg, strlen(pkg)));
	207	PUSHs(newSVpvn(name, strlen(name)));
	208	}
	209
15273f3c	210
	211	MODULE = Class::MOP PACKAGE = Class::MOP::Package
	212
	213	void
cc856b56	214	get_all_package_symbols(self, ...)
cc856b56	215	SV *self
15273f3c	216	PROTOTYPE: $;$
15273f3c	217	PREINIT:
cc856b56	218	HV *stash = NULL;
15273f3c	219	SV *type_filter = NULL;
75705e60	220	register HE *he;
15273f3c	221	PPCODE:
a7f711e5	222	if ( ! SvROK(self) ) {
988fb42e	223	die("Cannot call get_all_package_symbols as a class method");
988fb42e	224	}
15273f3c	225
a7f711e5	226	switch (GIMME_V) {
15273f3c	227	case G_VOID: return; break;
	228	case G_SCALAR: ST(0) = &PL_sv_undef; return; break;
	229	}
	230
	231	if ( items > 1 ) type_filter = ST(1);
	232
	233	PUTBACK;
	234
a7f711e5	235	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)) )
75705e60	236	stash = gv_stashsv(HeVAL(he),0);
15273f3c	237
a7f711e5	238	if (stash) {
15273f3c	239
	240	(void)hv_iterinit(stash);
	241
	242	if ( type_filter && SvPOK(type_filter) ) {
	243	const char *const type = SvPV_nolen(type_filter);
	244
a7f711e5	245	while ( (he = hv_iternext(stash)) ) {
75705e60	246	SV *const gv = HeVAL(he);
15273f3c	247	SV *sv;
75705e60	248	char *key;
75705e60	249	STRLEN keylen;
9457b596	250	char *package;
fd27f6e9	251	SV *fq;
15273f3c	252
15273f3c	253	switch( SvTYPE(gv) ) {
	254	case SVt_PVGV:
	255	switch (*type) {
	256	case 'C': sv = (SV )GvCVu(gv); break; / CODE */
	257	case 'A': sv = (SV )GvAV(gv); break; / ARRAY */
	258	case 'I': sv = (SV )GvIO(gv); break; / IO */
	259	case 'H': sv = (SV )GvHV(gv); break; / HASH */
	260	case 'S': sv = (SV )GvSV(gv); break; / SCALAR */
	261	default:
	262	croak("Unknown type %s\n", type);
	263	}
	264	break;
	265	case SVt_RV:
	266	/* BAH! constants are horrible */
fd27f6e9	267
a7f711e5	268	if ( ! SvROK(gv) ) {
fd8c46e5	269	continue;
	270	}
	271
fd27f6e9	272	/* we don't really care about the length,
fd27f6e9	273	but that's the API */
75705e60	274	key = HePV(he, keylen);
9457b596	275	package = HvNAME(stash);
fd27f6e9	276	fq = newSVpvf("%s::%s", package, key);
8babf00a	277	sv = (SV*)get_cv(SvPV_nolen(fq), 0);
15273f3c	278	break;
	279	default:
	280	continue;
	281	}
	282
a7f711e5	283	if (sv) {
75705e60	284	SV *key = hv_iterkeysv(he);
15273f3c	285	SPAGAIN;
	286	EXTEND(SP, 2);
	287	PUSHs(key);
66af67fe	288	PUSHs(sv_2mortal(newRV_inc(sv)));
15273f3c	289	PUTBACK;
	290	}
	291	}
	292	} else {
	293	EXTEND(SP, HvKEYS(stash) * 2);
	294
a7f711e5	295	while (he = hv_iternext(stash)) {
75705e60	296	SV *key = hv_iterkeysv(he);
599791aa	297	SV *sv = HeVAL(he);
15273f3c	298	SPAGAIN;
0eb2957d	299	PUSHs(key);
15273f3c	300	PUSHs(sv);
	301	PUTBACK;
	302	}
	303	}
	304
	305	}
	306
e2c189ae	307	void
cc856b56	308	name(self)
	309	SV *self
	310	PREINIT:
	311	register HE *he;
	312	PPCODE:
a7f711e5	313	if ( ! SvROK(self) ) {
988fb42e	314	die("Cannot call name as a class method");
	315	}
	316
a7f711e5	317	if ( he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package) )
cc856b56	318	XPUSHs(HeVAL(he));
	319	else
	320	ST(0) = &PL_sv_undef;
	321
dcbfe027	322	MODULE = Class::MOP PACKAGE = Class::MOP::Attribute
cc856b56	323
e2c189ae	324	void
cc856b56	325	name(self)
	326	SV *self
	327	PREINIT:
	328	register HE *he;
	329	PPCODE:
a7f711e5	330	if ( ! SvROK(self) ) {
988fb42e	331	die("Cannot call name as a class method");
	332	}
	333
a7f711e5	334	if ( he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name) )
cc856b56	335	XPUSHs(HeVAL(he));
	336	else
	337	ST(0) = &PL_sv_undef;
	338
dcbfe027	339	MODULE = Class::MOP PACKAGE = Class::MOP::Method
cc856b56	340
e2c189ae	341	void
da88f307	342	name(self)
	343	SV *self
	344	PREINIT:
	345	register HE *he;
	346	PPCODE:
a7f711e5	347	if ( ! SvROK(self) ) {
da88f307	348	die("Cannot call name as a class method");
	349	}
	350
a7f711e5	351	if ( he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name) )
da88f307	352	XPUSHs(HeVAL(he));
	353	else
	354	ST(0) = &PL_sv_undef;
	355
e2c189ae	356	void
da88f307	357	package_name(self)
	358	SV *self
	359	PREINIT:
	360	register HE *he;
	361	PPCODE:
a7f711e5	362	if ( ! SvROK(self) ) {
da88f307	363	die("Cannot call package_name as a class method");
	364	}
	365
a7f711e5	366	if ( he = hv_fetch_ent((HV *)SvRV(self), key_package_name, 0, hash_package_name) )
da88f307	367	XPUSHs(HeVAL(he));
	368	else
	369	ST(0) = &PL_sv_undef;
	370
e2c189ae	371	void
cc856b56	372	body(self)
	373	SV *self
	374	PREINIT:
	375	register HE *he;
	376	PPCODE:
a7f711e5	377	if ( ! SvROK(self) ) {
da88f307	378	die("Cannot call body as a class method");
	379	}
	380
a7f711e5	381	if ( he = hv_fetch_ent((HV *)SvRV(self), key_body, 0, hash_body) )
cc856b56	382	XPUSHs(HeVAL(he));
	383	else
	384	ST(0) = &PL_sv_undef;
c94afdc4	385
	386
	387	MODULE = Class::MOP PACKAGE = Class::MOP::Class
	388
	389	void
	390	get_method_map(self)
	391	SV* self
	392	INIT:
	393	if ( !SvRV(self) ) {
	394	die("Cannot call get_method_map as a class method");
	395	}
	396	CODE:
a7f711e5	397	HE* const he = hv_fetch_ent((HV)SvRV(self), key_package, TRUE, hash_package); / $self->name() */
	398	SV* const class_name = HeVAL(he);
	399	HV* const stash = gv_stashsv(class_name, TRUE);
	400	UV const current = check_package_cache_flag(stash);
	401	SV* const cache_flag = hv_fetchs((HV)SvRV(self), "_package_cache_flag", TRUE);
	402	SV* const map_ref = hv_fetchs((HV)SvRV(self), "methods", TRUE);
c94afdc4	403
	404	/* in $self->{methods} does not yet exist (or got deleted) */
	405	if ( ! (SvROK(map_ref) && SvTYPE(SvRV(map_ref)) == SVt_PVHV) ) {
	406	SV* new_map_ref = newRV_noinc((SV*)newHV());
	407	sv_2mortal(new_map_ref);
	408	sv_setsv(map_ref, new_map_ref);
	409	}
	410
	411	if ( ! (SvOK(cache_flag) && SvUV(cache_flag) == current) ) {
	412	ENTER;
	413	SAVETMPS;
	414
	415	mop_update_method_map(aTHX_ self, class_name, stash, (HV*)SvRV(map_ref));
	416	sv_setuv(cache_flag, check_package_cache_flag(stash)); /* update_cache_flag() */
	417
	418	FREETMPS;
	419	LEAVE;
	420	}
	421	ST(0) = map_ref; /* map_ref is already mortal */