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

/* There's a lot of cases of doubled parens in here like this:

  while ( (he = ...) ) {

This shuts up warnings from gcc -Wall
*/

#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
    PREINIT:
        SV* const class_name = HeVAL( hv_fetch_ent((HV*)SvRV(self), key_package, TRUE, hash_package));
        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);
    PPCODE:
        if ( ! SvRV(self) ) {
            die("Cannot call get_method_map as a class method");
        }

        /* 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;
        }

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