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