[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;

    /* this function massivly overlaps with the xs version of
     * get_all_package_symbols. a common c function to walk the symbol table
     * should be factored out and used by both.  --rafl */

    hv_iterinit(stash);
    while ( (gv = (GV*)hv_iternextsv(stash, &method_name, &method_name_len)) ) {
        CV* cv;
        switch (SvTYPE (gv)) {
            case SVt_RV:
                if (!SvROK(gv)) {
                    break;
                }
                /* fall through */
            case SVt_IV:
            case SVt_PV:
                /* 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);
                /* fall through */
            default:
                break;
        }

        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 = NULL;
                    char *key;
                    STRLEN keylen;
                    char *package;
                    SV *fq;

                    switch( SvTYPE(gv) ) {
                        case SVt_PV:
                        case SVt_IV:
                            /* expand the gv into a real typeglob if it
                             * contains stub functions and we were asked to
                             * return CODE symbols */
                            if (*type == 'C') {
                                key = HePV(he, keylen);
                                gv_init((GV *)gv, stash, key, keylen, GV_ADDMULTI);
                            }
                            /* fall through */
                        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;
49bbf9e5	85
6bd19edb	86	/* this function massivly overlaps with the xs version of
	87	* get_all_package_symbols. a common c function to walk the symbol table
	88	* should be factored out and used by both. --rafl */
	89
c94afdc4	90	hv_iterinit(stash);
e7b69038	91	while ( (gv = (GV*)hv_iternextsv(stash, &method_name, &method_name_len)) ) {
c94afdc4	92	CV* cv;
6bd19edb	93	switch (SvTYPE (gv)) {
	94	case SVt_RV:
	95	if (!SvROK(gv)) {
	96	break;
	97	}
	98	/* fall through */
	99	case SVt_IV:
	100	case SVt_PV:
	101	/* rafl says that this wastes memory savings that GvSVs have
	102	in 5.8.9 and 5.10.x. But without it some tests fail. rafl
	103	says the right thing to do is to handle GvSVs differently
	104	here. */
	105	gv_init((GV*)gv, stash, method_name, method_name_len, GV_ADDMULTI);
	106	/* fall through */
733e8831	107	default:
733e8831	108	break;
c94afdc4	109	}
	110
	111	if ( SvTYPE(gv) == SVt_PVGV && (cv = GvCVu(gv)) ) {
	112	GV* const cvgv = CvGV(cv);
	113	/* ($cvpkg_name, $cv_name) = get_code_info($cv) */
	114	const char* const cvpkg_name = HvNAME(GvSTASH(cvgv));
	115	const char* const cv_name = GvNAME(cvgv);
	116	SV* method_slot;
	117	SV* method_object;
	118
	119	/* this checks to see that the subroutine is actually from our package */
	120	if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
	121	if ( strNE(cvpkg_name, class_name_pv) ) {
	122	continue;
	123	}
	124	}
	125
	126	method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
	127	if ( SvOK(method_slot) ) {
	128	SV* const body = call0(method_slot, key_body); /* $method_object->body() */
	129	if ( SvROK(body) && ((CV*) SvRV(body)) == cv ) {
	130	continue;
	131	}
	132	}
	133
	134	method_metaclass_name = call0(self, method_metaclass); /* $self->method_metaclass() */
	135
	136	/*
	137	$method_object = $method_metaclass->wrap(
	138	$cv,
	139	associated_metaclass => $self,
	140	package_name => $class_name,
	141	name => $method_name
	142	);
	143	*/
	144	ENTER;
	145	SAVETMPS;
	146
	147	PUSHMARK(SP);
	148	EXTEND(SP, 8);
	149	PUSHs(method_metaclass_name); /* invocant */
	150	mPUSHs(newRV_inc((SV*)cv));
	151	PUSHs(associated_metaclass);
	152	PUSHs(self);
	153	PUSHs(key_package_name);
	154	PUSHs(class_name);
	155	PUSHs(key_name);
	156	mPUSHs(newSVpv(method_name, method_name_len));
	157	PUTBACK;
	158
	159	call_sv(wrap, G_SCALAR \| G_METHOD);
	160	SPAGAIN;
	161	method_object = POPs;
	162	PUTBACK;
	163	/* $map->{$method_name} = $method_object */
	164	sv_setsv(method_slot, method_object);
	165
	166	FREETMPS;
	167	LEAVE;
	168	}
	169	}
	170	}
	171
	172
e0e4674a	173	/*
e0e4674a	174	get_code_info:
	175	Pass in a coderef, returns:
	176	[ $pkg_name, $coderef_name ] ie:
	177	[ 'Foo::Bar', 'new' ]
	178	*/
	179
	180	MODULE = Class::MOP PACKAGE = Class::MOP
	181
cc856b56	182	BOOT:
	183	key_name = newSVpvs("name");
	184	key_body = newSVpvs("body");
	185	key_package = newSVpvs("package");
da88f307	186	key_package_name = newSVpvs("package_name");
cc856b56	187
	188	PERL_HASH(hash_name, "name", 4);
	189	PERL_HASH(hash_body, "body", 4);
	190	PERL_HASH(hash_package, "package", 7);
da88f307	191	PERL_HASH(hash_package_name, "package_name", 12);
cc856b56	192
c94afdc4	193	method_metaclass = newSVpvs("method_metaclass");
	194	wrap = newSVpvs("wrap");
	195	associated_metaclass = newSVpvs("associated_metaclass");
	196
cc856b56	197
d7bf3478	198	PROTOTYPES: ENABLE
d7bf3478	199
cc856b56	200
e0e4674a	201	void
	202	get_code_info(coderef)
	203	SV* coderef
	204	PREINIT:
	205	char* name;
	206	char* pkg;
	207	PPCODE:
a7f711e5	208	if ( SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV ) {
e0e4674a	209	coderef = SvRV(coderef);
7b62d87f	210	/* I think this only gets triggered with a mangled coderef, but if
	211	we hit it without the guard, we segfault. The slightly odd return
	212	value strikes me as an improvement (mst)
	213	*/
a4f4221a	214	#ifdef isGV_with_GP
a7f711e5	215	if ( isGV_with_GP(CvGV(coderef)) ) {
a4f4221a	216	#endif
7b62d87f	217	pkg = HvNAME( GvSTASH(CvGV(coderef)) );
7b62d87f	218	name = GvNAME( CvGV(coderef) );
a4f4221a	219	#ifdef isGV_with_GP
	220	} else {
	221	pkg = "__UNKNOWN__";
	222	name = "__ANON__";
	223	}
	224	#endif
e0e4674a	225
	226	EXTEND(SP, 2);
	227	PUSHs(newSVpvn(pkg, strlen(pkg)));
	228	PUSHs(newSVpvn(name, strlen(name)));
	229	}
	230
15273f3c	231
	232	MODULE = Class::MOP PACKAGE = Class::MOP::Package
	233
	234	void
cc856b56	235	get_all_package_symbols(self, ...)
cc856b56	236	SV *self
15273f3c	237	PROTOTYPE: $;$
15273f3c	238	PREINIT:
cc856b56	239	HV *stash = NULL;
15273f3c	240	SV *type_filter = NULL;
75705e60	241	register HE *he;
15273f3c	242	PPCODE:
a7f711e5	243	if ( ! SvROK(self) ) {
988fb42e	244	die("Cannot call get_all_package_symbols as a class method");
988fb42e	245	}
15273f3c	246
a7f711e5	247	switch (GIMME_V) {
15273f3c	248	case G_VOID: return; break;
	249	case G_SCALAR: ST(0) = &PL_sv_undef; return; break;
	250	}
	251
	252	if ( items > 1 ) type_filter = ST(1);
	253
	254	PUTBACK;
	255
a7f711e5	256	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)) )
75705e60	257	stash = gv_stashsv(HeVAL(he),0);
15273f3c	258
a7f711e5	259	if (stash) {
15273f3c	260
	261	(void)hv_iterinit(stash);
	262
	263	if ( type_filter && SvPOK(type_filter) ) {
	264	const char *const type = SvPV_nolen(type_filter);
	265
a7f711e5	266	while ( (he = hv_iternext(stash)) ) {
75705e60	267	SV *const gv = HeVAL(he);
a88898eb	268	SV *sv = NULL;
75705e60	269	char *key;
75705e60	270	STRLEN keylen;
9457b596	271	char *package;
fd27f6e9	272	SV *fq;
15273f3c	273
15273f3c	274	switch( SvTYPE(gv) ) {
15b55537	275	case SVt_PV:
	276	case SVt_IV:
	277	/* expand the gv into a real typeglob if it
	278	* contains stub functions and we were asked to
	279	* return CODE symbols */
	280	if (*type == 'C') {
	281	key = HePV(he, keylen);
	282	gv_init((GV *)gv, stash, key, keylen, GV_ADDMULTI);
	283	}
	284	/* fall through */
15273f3c	285	case SVt_PVGV:
	286	switch (*type) {
	287	case 'C': sv = (SV )GvCVu(gv); break; / CODE */
	288	case 'A': sv = (SV )GvAV(gv); break; / ARRAY */
	289	case 'I': sv = (SV )GvIO(gv); break; / IO */
	290	case 'H': sv = (SV )GvHV(gv); break; / HASH */
	291	case 'S': sv = (SV )GvSV(gv); break; / SCALAR */
	292	default:
	293	croak("Unknown type %s\n", type);
	294	}
	295	break;
	296	case SVt_RV:
	297	/* BAH! constants are horrible */
fd27f6e9	298
a7f711e5	299	if ( ! SvROK(gv) ) {
fd8c46e5	300	continue;
	301	}
	302
fd27f6e9	303	/* we don't really care about the length,
fd27f6e9	304	but that's the API */
75705e60	305	key = HePV(he, keylen);
9457b596	306	package = HvNAME(stash);
fd27f6e9	307	fq = newSVpvf("%s::%s", package, key);
8babf00a	308	sv = (SV*)get_cv(SvPV_nolen(fq), 0);
15273f3c	309	break;
	310	default:
	311	continue;
	312	}
	313
a7f711e5	314	if (sv) {
75705e60	315	SV *key = hv_iterkeysv(he);
15273f3c	316	SPAGAIN;
	317	EXTEND(SP, 2);
	318	PUSHs(key);
66af67fe	319	PUSHs(sv_2mortal(newRV_inc(sv)));
15273f3c	320	PUTBACK;
	321	}
	322	}
	323	} else {
	324	EXTEND(SP, HvKEYS(stash) * 2);
	325
e7b69038	326	while ( (he = hv_iternext(stash)) ) {
75705e60	327	SV *key = hv_iterkeysv(he);
599791aa	328	SV *sv = HeVAL(he);
15273f3c	329	SPAGAIN;
0eb2957d	330	PUSHs(key);
15273f3c	331	PUSHs(sv);
	332	PUTBACK;
	333	}
	334	}
	335
	336	}
	337
e2c189ae	338	void
cc856b56	339	name(self)
	340	SV *self
	341	PREINIT:
	342	register HE *he;
	343	PPCODE:
a7f711e5	344	if ( ! SvROK(self) ) {
988fb42e	345	die("Cannot call name as a class method");
	346	}
	347
e7b69038	348	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)) )
cc856b56	349	XPUSHs(HeVAL(he));
	350	else
	351	ST(0) = &PL_sv_undef;
	352
dcbfe027	353	MODULE = Class::MOP PACKAGE = Class::MOP::Attribute
cc856b56	354
e2c189ae	355	void
cc856b56	356	name(self)
	357	SV *self
	358	PREINIT:
	359	register HE *he;
	360	PPCODE:
a7f711e5	361	if ( ! SvROK(self) ) {
988fb42e	362	die("Cannot call name as a class method");
	363	}
	364
e7b69038	365	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)) )
cc856b56	366	XPUSHs(HeVAL(he));
	367	else
	368	ST(0) = &PL_sv_undef;
	369
dcbfe027	370	MODULE = Class::MOP PACKAGE = Class::MOP::Method
cc856b56	371
e2c189ae	372	void
da88f307	373	name(self)
	374	SV *self
	375	PREINIT:
	376	register HE *he;
	377	PPCODE:
a7f711e5	378	if ( ! SvROK(self) ) {
da88f307	379	die("Cannot call name as a class method");
	380	}
	381
e7b69038	382	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)) )
da88f307	383	XPUSHs(HeVAL(he));
	384	else
	385	ST(0) = &PL_sv_undef;
	386
e2c189ae	387	void
da88f307	388	package_name(self)
	389	SV *self
	390	PREINIT:
	391	register HE *he;
	392	PPCODE:
a7f711e5	393	if ( ! SvROK(self) ) {
da88f307	394	die("Cannot call package_name as a class method");
	395	}
	396
e7b69038	397	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_package_name, 0, hash_package_name)) )
da88f307	398	XPUSHs(HeVAL(he));
	399	else
	400	ST(0) = &PL_sv_undef;
	401
e2c189ae	402	void
cc856b56	403	body(self)
	404	SV *self
	405	PREINIT:
	406	register HE *he;
	407	PPCODE:
a7f711e5	408	if ( ! SvROK(self) ) {
da88f307	409	die("Cannot call body as a class method");
	410	}
	411
e7b69038	412	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_body, 0, hash_body)) )
cc856b56	413	XPUSHs(HeVAL(he));
	414	else
	415	ST(0) = &PL_sv_undef;
c94afdc4	416
	417
	418	MODULE = Class::MOP PACKAGE = Class::MOP::Class
	419
	420	void
	421	get_method_map(self)
	422	SV* self
c200a770	423	PREINIT:
b69838b1	424	SV* const class_name = HeVAL( hv_fetch_ent((HV*)SvRV(self), key_package, TRUE, hash_package) );
c200a770	425	HV* const stash = gv_stashsv(class_name, TRUE);
	426	UV const current = check_package_cache_flag(stash);
	427	SV* const cache_flag = hv_fetchs((HV)SvRV(self), "_package_cache_flag", TRUE);
	428	SV* const map_ref = hv_fetchs((HV)SvRV(self), "methods", TRUE);
	429	PPCODE:
	430	if ( ! SvRV(self) ) {
	431	die("Cannot call get_method_map as a class method");
	432	}
c94afdc4	433
c200a770	434	/* in $self->{methods} does not yet exist (or got deleted) */
	435	if ( ! (SvROK(map_ref) && SvTYPE(SvRV(map_ref)) == SVt_PVHV) ) {
	436	SV* new_map_ref = newRV_noinc((SV*)newHV());
	437	sv_2mortal(new_map_ref);
	438	sv_setsv(map_ref, new_map_ref);
	439	}
c94afdc4	440
c200a770	441	if ( ! (SvOK(cache_flag) && SvUV(cache_flag) == current) ) {
	442	ENTER;
	443	SAVETMPS;
	444
	445	mop_update_method_map(aTHX_ self, class_name, stash, (HV*)SvRV(map_ref));
	446	sv_setuv(cache_flag, check_package_cache_flag(stash)); /* update_cache_flag() */
	447
	448	FREETMPS;
	449	LEAVE;
	450	}
	451
	452	XPUSHs(map_ref);
c94afdc4	453