Commit | Line | Data |
d846ade3 |
1 | #include "mop.h" |
2 | |
7ec7b950 |
3 | SV *mop_method_metaclass; |
4 | SV *mop_associated_metaclass; |
ffec3ec3 |
5 | SV *mop_associated_attribute; |
7ec7b950 |
6 | SV *mop_wrap; |
8a2e4cdb |
7 | SV *mop_methods; |
8 | SV *mop_name; |
9 | SV *mop_body; |
10 | SV *mop_package; |
11 | SV *mop_package_name; |
12 | SV *mop_package_cache_flag; |
13 | |
14 | SV *mop_VERSION; |
15 | SV *mop_ISA; |
7ec7b950 |
16 | |
d846ade3 |
17 | static bool |
18 | find_method (const char *key, STRLEN keylen, SV *val, void *ud) |
19 | { |
20 | bool *found_method = (bool *)ud; |
2dba318b |
21 | PERL_UNUSED_ARG(key); |
22 | PERL_UNUSED_ARG(keylen); |
23 | PERL_UNUSED_ARG(val); |
d846ade3 |
24 | *found_method = TRUE; |
25 | return FALSE; |
26 | } |
27 | |
25bcd95c |
28 | EXTERN_C XS(boot_Class__MOP__Package); |
29 | EXTERN_C XS(boot_Class__MOP__Class); |
30 | EXTERN_C XS(boot_Class__MOP__Attribute); |
31 | EXTERN_C XS(boot_Class__MOP__Method); |
8a2e4cdb |
32 | EXTERN_C XS(boot_Class__MOP__Instance); |
a69b9501 |
33 | EXTERN_C XS(boot_Class__MOP__Method__Accessor); |
25bcd95c |
34 | |
d846ade3 |
35 | MODULE = Class::MOP PACKAGE = Class::MOP |
36 | |
37 | PROTOTYPES: DISABLE |
38 | |
39 | BOOT: |
8a2e4cdb |
40 | mop_method_metaclass = MAKE_KEYSV(method_metaclass); |
41 | mop_wrap = MAKE_KEYSV(wrap); |
42 | mop_associated_metaclass = MAKE_KEYSV(associated_metaclass); |
ffec3ec3 |
43 | mop_associated_attribute = MAKE_KEYSV(associated_attribute); |
8a2e4cdb |
44 | mop_methods = MAKE_KEYSV(methods); |
45 | mop_name = MAKE_KEYSV(name); |
46 | mop_body = MAKE_KEYSV(body); |
47 | mop_package = MAKE_KEYSV(package); |
48 | mop_package_name = MAKE_KEYSV(package_name); |
49 | mop_package_cache_flag = MAKE_KEYSV(_package_cache_flag); |
50 | mop_VERSION = MAKE_KEYSV(VERSION); |
51 | mop_ISA = MAKE_KEYSV(ISA); |
d846ade3 |
52 | |
e3dcef7f |
53 | MOP_CALL_BOOT (boot_Class__MOP__Package); |
54 | MOP_CALL_BOOT (boot_Class__MOP__Class); |
55 | MOP_CALL_BOOT (boot_Class__MOP__Attribute); |
56 | MOP_CALL_BOOT (boot_Class__MOP__Method); |
8a2e4cdb |
57 | MOP_CALL_BOOT (boot_Class__MOP__Instance); |
a69b9501 |
58 | MOP_CALL_BOOT (boot_Class__MOP__Method__Accessor); |
d846ade3 |
59 | |
60 | # use prototype here to be compatible with get_code_info from Sub::Identify |
61 | void |
62 | get_code_info(coderef) |
63 | SV *coderef |
64 | PROTOTYPE: $ |
65 | PREINIT: |
66 | char *pkg = NULL; |
67 | char *name = NULL; |
68 | PPCODE: |
704f58f9 |
69 | SvGETMAGIC(coderef); |
e1f52a8a |
70 | if (mop_get_code_info(coderef, &pkg, &name)) { |
d846ade3 |
71 | EXTEND(SP, 2); |
efc98200 |
72 | mPUSHs(newSVpv(pkg, 0)); |
73 | mPUSHs(newSVpv(name, 0)); |
d846ade3 |
74 | } |
75 | |
76 | # This is some pretty grotty logic. It _should_ be parallel to the |
77 | # pure Perl version in lib/Class/MOP.pm, so if you want to understand |
78 | # it we suggest you start there. |
79 | void |
80 | is_class_loaded(klass=&PL_sv_undef) |
81 | SV *klass |
82 | PREINIT: |
83 | HV *stash; |
84 | bool found_method = FALSE; |
85 | PPCODE: |
704f58f9 |
86 | SvGETMAGIC(klass); |
87 | if (!(SvPOKp(klass) && SvCUR(klass))) { /* XXX: SvPOK does not work with magical scalars */ |
d846ade3 |
88 | XSRETURN_NO; |
89 | } |
90 | |
91 | stash = gv_stashsv(klass, 0); |
92 | if (!stash) { |
93 | XSRETURN_NO; |
94 | } |
95 | |
8a2e4cdb |
96 | if (hv_exists_ent (stash, mop_VERSION, 0U)) { |
97 | HE *version = hv_fetch_ent(stash, mop_VERSION, 0, 0U); |
d846ade3 |
98 | SV *version_sv; |
99 | if (version && HeVAL(version) && (version_sv = GvSV(HeVAL(version)))) { |
100 | if (SvROK(version_sv)) { |
101 | SV *version_sv_ref = SvRV(version_sv); |
102 | |
103 | if (SvOK(version_sv_ref)) { |
104 | XSRETURN_YES; |
105 | } |
106 | } |
107 | else if (SvOK(version_sv)) { |
108 | XSRETURN_YES; |
109 | } |
110 | } |
111 | } |
112 | |
8a2e4cdb |
113 | if (hv_exists_ent (stash, mop_ISA, 0U)) { |
114 | HE *isa = hv_fetch_ent(stash, mop_ISA, 0, 0U); |
d9d8a21b |
115 | if (isa && HeVAL(isa) && GvAV(HeVAL(isa)) && av_len(GvAV(HeVAL(isa))) != -1) { |
d846ade3 |
116 | XSRETURN_YES; |
117 | } |
118 | } |
119 | |
e1f52a8a |
120 | mop_get_package_symbols(stash, TYPE_FILTER_CODE, find_method, &found_method); |
d846ade3 |
121 | if (found_method) { |
122 | XSRETURN_YES; |
123 | } |
124 | |
125 | XSRETURN_NO; |