i think the changes i made to _method_map could make this work?
[gitmo/Class-MOP.git] / xs / HasMethods.xs
CommitLineData
9b871d79 1#include "mop.h"
2
3SV *mop_method_metaclass;
4SV *mop_associated_metaclass;
5SV *mop_wrap;
6
7static void
8mop_update_method_map(pTHX_ SV *const self, SV *const class_name, HV *const stash, HV *const map)
9{
10 const char *const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */
9b871d79 11 char *method_name;
12 I32 method_name_len;
13 SV *coderef;
14 HV *symbols;
9b871d79 15
16 symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE);
17 sv_2mortal((SV*)symbols);
18 (void)hv_iterinit(symbols);
19 while ( (coderef = hv_iternextsv(symbols, &method_name, &method_name_len)) ) {
20 CV *cv = (CV *)SvRV(coderef);
21 char *cvpkg_name;
22 char *cv_name;
23 SV *method_slot;
9b871d79 24
25 if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) {
26 continue;
27 }
28
29 /* this checks to see that the subroutine is actually from our package */
30 if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
31 if ( strNE(cvpkg_name, class_name_pv) ) {
32 continue;
33 }
34 }
35
36 method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
37 if ( SvOK(method_slot) ) {
38 SV *body;
39
40 if ( sv_isobject(method_slot) ) {
41 body = mop_call0(aTHX_ method_slot, KEY_FOR(body)); /* $method_object->body() */
42 }
43 else {
44 body = method_slot;
45 }
46
47 if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) {
48 continue;
49 }
38bcde3f 50 else {
51 /* $map->{$method_name} = undef */
52 sv_setsv(method_slot, &PL_sv_undef);
53 }
9b871d79 54 }
9b871d79 55 }
56}
57
58MODULE = Class::MOP::Mixin::HasMethods PACKAGE = Class::MOP::Mixin::HasMethods
59
60PROTOTYPES: DISABLE
61
62void
38bcde3f 63_method_map(self)
9b871d79 64 SV *self
65 PREINIT:
66 HV *const obj = (HV *)SvRV(self);
67 SV *const class_name = HeVAL( hv_fetch_ent(obj, KEY_FOR(package), 0, HASH_FOR(package)) );
68 HV *const stash = gv_stashsv(class_name, 0);
69 UV current;
70 SV *cache_flag;
71 SV *map_ref;
72 PPCODE:
73 if (!stash) {
74 mXPUSHs(newRV_noinc((SV *)newHV()));
75 return;
76 }
77
78 current = mop_check_package_cache_flag(aTHX_ stash);
79 cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag)));
80 map_ref = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods)));
81
82 /* $self->{methods} does not yet exist (or got deleted) */
83 if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) {
84 SV *new_map_ref = newRV_noinc((SV *)newHV());
85 sv_2mortal(new_map_ref);
86 sv_setsv(map_ref, new_map_ref);
87 }
88
89 if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) {
90 mop_update_method_map(aTHX_ self, class_name, stash, (HV *)SvRV(map_ref));
91 sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */
92 }
93
94 XPUSHs(map_ref);
95
96BOOT:
97 mop_method_metaclass = newSVpvs("method_metaclass");
98 mop_associated_metaclass = newSVpvs("associated_metaclass");
99 mop_wrap = newSVpvs("wrap");