Add missing =over and =back
[gitmo/Moose.git] / mop.c
1 #include "mop.h"
2
3 void
4 mop_call_xs (pTHX_ XSPROTO(subaddr), CV *cv, SV **mark)
5 {
6     dSP;
7     PUSHMARK(mark);
8     (*subaddr)(aTHX_ cv);
9     PUTBACK;
10 }
11
12 #if PERL_VERSION >= 10
13 UV
14 mop_check_package_cache_flag (pTHX_ HV *stash)
15 {
16     assert(SvTYPE(stash) == SVt_PVHV);
17
18     /* here we're trying to implement a c version of mro::get_pkg_gen($stash),
19      * however the perl core doesn't make it easy for us. It doesn't provide an
20      * api that just does what we want.
21      *
22      * However, we know that the information we want is, inside the core,
23      * available using HvMROMETA(stash)->pkg_gen. Unfortunately, although the
24      * HvMROMETA macro is public, it is implemented using Perl_mro_meta_init,
25      * which is not public and only available inside the core, as the mro
26      * interface as well as the structure returned by mro_meta_init isn't
27      * considered to be stable yet.
28      *
29      * Perl_mro_meta_init isn't declared static, so we could just define it
30      * ourselfs if perls headers don't do that for us, except that won't work
31      * on platforms where symbols need to be explicitly exported when linking
32      * shared libraries.
33      *
34      * So our, hopefully temporary, solution is to be even more evil and
35      * basically reimplement HvMROMETA in a very fragile way that'll blow up
36      * when the relevant parts of the mro implementation in core change.
37      *
38      * :-(
39      *
40      */
41
42     return HvAUX(stash)->xhv_mro_meta
43          ? HvAUX(stash)->xhv_mro_meta->pkg_gen
44          : 0;
45 }
46
47 #else /* pre 5.10.0 */
48
49 UV
50 mop_check_package_cache_flag (pTHX_ HV *stash)
51 {
52     PERL_UNUSED_ARG(stash);
53     assert(SvTYPE(stash) == SVt_PVHV);
54
55     return PL_sub_generation;
56 }
57 #endif
58
59 SV *
60 mop_call0 (pTHX_ SV *const self, SV *const method)
61 {
62     dSP;
63     SV *ret;
64
65     PUSHMARK(SP);
66     XPUSHs(self);
67     PUTBACK;
68
69     call_sv(method, G_SCALAR | G_METHOD);
70
71     SPAGAIN;
72     ret = POPs;
73     PUTBACK;
74
75     return ret;
76 }
77
78 int
79 mop_get_code_info (SV *coderef, char **pkg, char **name)
80 {
81     if (!SvOK(coderef) || !SvROK(coderef) || SvTYPE(SvRV(coderef)) != SVt_PVCV) {
82         return 0;
83     }
84
85     coderef = SvRV(coderef);
86
87     /* sub is still being compiled */
88     if (!CvGV(coderef)) {
89         return 0;
90     }
91
92     /* I think this only gets triggered with a mangled coderef, but if
93        we hit it without the guard, we segfault. The slightly odd return
94        value strikes me as an improvement (mst)
95     */
96
97     if ( isGV_with_GP(CvGV(coderef)) ) {
98         GV *gv   = CvGV(coderef);
99         *pkg     = HvNAME( GvSTASH(gv) ? GvSTASH(gv) : CvSTASH(coderef) );
100         *name    = GvNAME( CvGV(coderef) );
101     } else {
102         *pkg     = "__UNKNOWN__";
103         *name    = "__ANON__";
104     }
105
106     return 1;
107 }
108
109 /* XXX: eventually this should just use the implementation in Package::Stash */
110 void
111 mop_get_package_symbols (HV *stash, type_filter_t filter, get_package_symbols_cb_t cb, void *ud)
112 {
113     HE *he;
114
115     (void)hv_iterinit(stash);
116
117     if (filter == TYPE_FILTER_NONE) {
118         while ( (he = hv_iternext(stash)) ) {
119             STRLEN keylen;
120             const char *key = HePV(he, keylen);
121             if (!cb(key, keylen, HeVAL(he), ud)) {
122                 return;
123             }
124         }
125         return;
126     }
127
128     while ( (he = hv_iternext(stash)) ) {
129         GV * const gv          = (GV*)HeVAL(he);
130         STRLEN keylen;
131         const char * const key = HePV(he, keylen);
132         SV *sv = NULL;
133
134         if(isGV(gv)){
135             switch (filter) {
136                 case TYPE_FILTER_CODE:   sv = (SV *)GvCVu(gv); break;
137                 case TYPE_FILTER_ARRAY:  sv = (SV *)GvAV(gv);  break;
138                 case TYPE_FILTER_IO:     sv = (SV *)GvIO(gv);  break;
139                 case TYPE_FILTER_HASH:   sv = (SV *)GvHV(gv);  break;
140                 case TYPE_FILTER_SCALAR: sv = (SV *)GvSV(gv);  break;
141                 default:
142                     croak("Unknown type");
143             }
144         }
145         /* expand the gv into a real typeglob if it
146         * contains stub functions or constants and we
147         * were asked to return CODE references */
148         else if (filter == TYPE_FILTER_CODE) {
149             gv_init(gv, stash, key, keylen, GV_ADDMULTI);
150             sv = (SV *)GvCV(gv);
151         }
152
153         if (sv) {
154             if (!cb(key, keylen, sv, ud)) {
155                 return;
156             }
157         }
158     }
159 }
160
161 static bool
162 collect_all_symbols (const char *key, STRLEN keylen, SV *val, void *ud)
163 {
164     HV *hash = (HV *)ud;
165
166     if (!hv_store (hash, key, keylen, newRV_inc(val), 0)) {
167         croak("failed to store symbol ref");
168     }
169
170     return TRUE;
171 }
172
173 HV *
174 mop_get_all_package_symbols (HV *stash, type_filter_t filter)
175 {
176     HV *ret = newHV ();
177     mop_get_package_symbols (stash, filter, collect_all_symbols, ret);
178     return ret;
179 }
180
181 #define DECLARE_KEY(name)                    { #name, #name, NULL, 0 }
182 #define DECLARE_KEY_WITH_VALUE(name, value)  { #name, value, NULL, 0 }
183
184 /* the order of these has to match with those in mop.h */
185 static struct {
186     const char *name;
187     const char *value;
188     SV *key;
189     U32 hash;
190 } prehashed_keys[key_last] = {
191     DECLARE_KEY(_expected_method_class),
192     DECLARE_KEY(ISA),
193     DECLARE_KEY(VERSION),
194     DECLARE_KEY(accessor),
195     DECLARE_KEY(associated_class),
196     DECLARE_KEY(associated_metaclass),
197     DECLARE_KEY(associated_methods),
198     DECLARE_KEY(attribute_metaclass),
199     DECLARE_KEY(attributes),
200     DECLARE_KEY(body),
201     DECLARE_KEY(builder),
202     DECLARE_KEY(clearer),
203     DECLARE_KEY(constructor_class),
204     DECLARE_KEY(constructor_name),
205     DECLARE_KEY(definition_context),
206     DECLARE_KEY(destructor_class),
207     DECLARE_KEY(immutable_trait),
208     DECLARE_KEY(init_arg),
209     DECLARE_KEY(initializer),
210     DECLARE_KEY(insertion_order),
211     DECLARE_KEY(instance_metaclass),
212     DECLARE_KEY(is_inline),
213     DECLARE_KEY(method_metaclass),
214     DECLARE_KEY(methods),
215     DECLARE_KEY(name),
216     DECLARE_KEY(package),
217     DECLARE_KEY(package_name),
218     DECLARE_KEY(predicate),
219     DECLARE_KEY(reader),
220     DECLARE_KEY(wrapped_method_metaclass),
221     DECLARE_KEY(writer),
222     DECLARE_KEY_WITH_VALUE(package_cache_flag, "_package_cache_flag"),
223     DECLARE_KEY_WITH_VALUE(_version, "-version")
224 };
225
226 SV *
227 mop_prehashed_key_for (mop_prehashed_key_t key)
228 {
229     return prehashed_keys[key].key;
230 }
231
232 U32
233 mop_prehashed_hash_for (mop_prehashed_key_t key)
234 {
235     return prehashed_keys[key].hash;
236 }
237
238 void
239 mop_prehash_keys ()
240 {
241     int i;
242     for (i = 0; i < key_last; i++) {
243         const char *value = prehashed_keys[i].value;
244         prehashed_keys[i].key = newSVpv(value, strlen(value));
245         PERL_HASH(prehashed_keys[i].hash, value, strlen(value));
246     }
247 }
248
249 XS_EXTERNAL(mop_xs_simple_reader)
250 {
251 #ifdef dVAR
252     dVAR; dXSARGS;
253 #else
254     dXSARGS;
255 #endif
256     register HE *he;
257     mop_prehashed_key_t key = (mop_prehashed_key_t)CvXSUBANY(cv).any_i32;
258     SV *self;
259
260     if (items != 1) {
261         croak("expected exactly one argument");
262     }
263
264     self = ST(0);
265
266     if (!SvROK(self)) {
267         croak("can't call %s as a class method", prehashed_keys[key].name);
268     }
269
270     if (SvTYPE(SvRV(self)) != SVt_PVHV) {
271         croak("object is not a hashref");
272     }
273
274     if ((he = hv_fetch_ent((HV *)SvRV(self), prehashed_keys[key].key, 0, prehashed_keys[key].hash))) {
275         ST(0) = HeVAL(he);
276     }
277     else {
278         ST(0) = &PL_sv_undef;
279     }
280
281     XSRETURN(1);
282 }
283