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