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