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

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