Commit | Line | Data |
d846ade3 |
1 | #include "mop.h" |
2 | |
3 | static bool |
4 | find_method (const char *key, STRLEN keylen, SV *val, void *ud) |
5 | { |
6 | bool *found_method = (bool *)ud; |
7 | *found_method = TRUE; |
8 | return FALSE; |
9 | } |
10 | |
11 | DECLARE_KEY(name); |
12 | DECLARE_KEY(package); |
13 | DECLARE_KEY(package_name); |
14 | DECLARE_KEY(body); |
15 | DECLARE_KEY(package_cache_flag); |
16 | DECLARE_KEY(methods); |
17 | DECLARE_KEY(VERSION); |
18 | DECLARE_KEY(ISA); |
19 | |
e1f52a8a |
20 | SV *mop_method_metaclass; |
21 | SV *mop_associated_metaclass; |
22 | SV *mop_wrap; |
d846ade3 |
23 | |
24 | MODULE = Class::MOP PACKAGE = Class::MOP |
25 | |
26 | PROTOTYPES: DISABLE |
27 | |
28 | BOOT: |
29 | PREHASH_KEY(name); |
30 | PREHASH_KEY(body); |
31 | PREHASH_KEY(package); |
32 | PREHASH_KEY(package_name); |
33 | PREHASH_KEY(methods); |
34 | PREHASH_KEY(ISA); |
35 | PREHASH_KEY(VERSION); |
36 | PREHASH_KEY_WITH_VALUE(package_cache_flag, "_package_cache_flag"); |
37 | |
e1f52a8a |
38 | mop_method_metaclass = newSVpvs("method_metaclass"); |
39 | mop_wrap = newSVpvs("wrap"); |
40 | mop_associated_metaclass = newSVpvs("associated_metaclass"); |
d846ade3 |
41 | |
e3dcef7f |
42 | MOP_CALL_BOOT (boot_Class__MOP__Package); |
43 | MOP_CALL_BOOT (boot_Class__MOP__Class); |
44 | MOP_CALL_BOOT (boot_Class__MOP__Attribute); |
45 | MOP_CALL_BOOT (boot_Class__MOP__Method); |
d846ade3 |
46 | |
47 | # use prototype here to be compatible with get_code_info from Sub::Identify |
48 | void |
49 | get_code_info(coderef) |
50 | SV *coderef |
51 | PROTOTYPE: $ |
52 | PREINIT: |
53 | char *pkg = NULL; |
54 | char *name = NULL; |
55 | PPCODE: |
e1f52a8a |
56 | if (mop_get_code_info(coderef, &pkg, &name)) { |
d846ade3 |
57 | EXTEND(SP, 2); |
58 | PUSHs(newSVpv(pkg, 0)); |
59 | PUSHs(newSVpv(name, 0)); |
60 | } |
61 | |
62 | # This is some pretty grotty logic. It _should_ be parallel to the |
63 | # pure Perl version in lib/Class/MOP.pm, so if you want to understand |
64 | # it we suggest you start there. |
65 | void |
66 | is_class_loaded(klass=&PL_sv_undef) |
67 | SV *klass |
68 | PREINIT: |
69 | HV *stash; |
70 | bool found_method = FALSE; |
71 | PPCODE: |
72 | if (!SvPOK(klass) || !SvCUR(klass)) { |
73 | XSRETURN_NO; |
74 | } |
75 | |
76 | stash = gv_stashsv(klass, 0); |
77 | if (!stash) { |
78 | XSRETURN_NO; |
79 | } |
80 | |
81 | if (hv_exists_ent (stash, key_VERSION, hash_VERSION)) { |
82 | HE *version = hv_fetch_ent(stash, key_VERSION, 0, hash_VERSION); |
83 | SV *version_sv; |
84 | if (version && HeVAL(version) && (version_sv = GvSV(HeVAL(version)))) { |
85 | if (SvROK(version_sv)) { |
86 | SV *version_sv_ref = SvRV(version_sv); |
87 | |
88 | if (SvOK(version_sv_ref)) { |
89 | XSRETURN_YES; |
90 | } |
91 | } |
92 | else if (SvOK(version_sv)) { |
93 | XSRETURN_YES; |
94 | } |
95 | } |
96 | } |
97 | |
98 | if (hv_exists_ent (stash, key_ISA, hash_ISA)) { |
99 | HE *isa = hv_fetch_ent(stash, key_ISA, 0, hash_ISA); |
100 | if (isa && HeVAL(isa) && GvAV(HeVAL(isa))) { |
101 | XSRETURN_YES; |
102 | } |
103 | } |
104 | |
e1f52a8a |
105 | mop_get_package_symbols(stash, TYPE_FILTER_CODE, find_method, &found_method); |
d846ade3 |
106 | if (found_method) { |
107 | XSRETURN_YES; |
108 | } |
109 | |
110 | XSRETURN_NO; |