XS constructor
[gitmo/Mouse.git] / xs-src / MouseUtil.xs
1 #include "mouse.h"
2
3 #define ISA_CACHE "::LINEALIZED_ISA_CACHE::"
4
5 #ifdef no_mro_get_linear_isa
6 AV*
7 mouse_mro_get_linear_isa(pTHX_ HV* const stash){
8     GV* const cachegv = *(GV**)hv_fetchs(stash, ISA_CACHE, TRUE);
9     AV* isa;
10     SV* gen;
11     CV* get_linear_isa;
12
13     if(!isGV(cachegv))
14         gv_init(cachegv, stash, ISA_CACHE, sizeof(ISA_CACHE)-1, TRUE);
15
16     isa = GvAVn(cachegv);
17     gen = GvSVn(cachegv);
18
19
20     if(SvIOK(gen) && SvIVX(gen) == (IV)mro_get_pkg_gen(stash)){
21         return isa; /* returns the cache if available */
22     }
23     else{
24         SvREFCNT_dec(isa);
25         GvAV(cachegv) = isa = newAV();
26     }
27
28     get_linear_isa = get_cv("Mouse::Util::get_linear_isa", TRUE);
29
30     {
31         SV* avref;
32         dSP;
33
34         ENTER;
35         SAVETMPS;
36
37         PUSHMARK(SP);
38         mXPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash));
39         PUTBACK;
40
41         call_sv((SV*)get_linear_isa, G_SCALAR);
42
43         SPAGAIN;
44         avref = POPs;
45         PUTBACK;
46
47         if(IsArrayRef(avref)){
48             AV* const av  = (AV*)SvRV(avref);
49             I32 const len = AvFILLp(av) + 1;
50             I32 i;
51
52             for(i = 0; i < len; i++){
53                 HV* const stash = gv_stashsv(AvARRAY(av)[i], FALSE);
54                 if(stash)
55                     av_push(isa, newSVpv(HvNAME(stash), 0));
56             }
57             SvREADONLY_on(isa);
58         }
59         else{
60             Perl_croak(aTHX_ "Mouse:Util::get_linear_isa() didn't return an ARRAY reference");
61         }
62
63         FREETMPS;
64         LEAVE;
65     }
66
67     sv_setiv(gen, (IV)mro_get_pkg_gen(stash));
68     return isa;
69 }
70 #endif /* !no_mor_get_linear_isa */
71
72 #ifdef DEBUGGING
73 SV**
74 mouse_av_at_safe(pTHX_ AV* const av, I32 const ix){
75     assert(av);
76     assert(SvTYPE(av) == SVt_PVAV);
77     assert(AvMAX(av) >= ix);
78     return &AvARRAY(av)[ix];
79 }
80 #endif
81
82 void
83 mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const char* const fmt, ...){
84     dTHX;
85     va_list args;
86     SV* message;
87
88     PERL_UNUSED_ARG(data); /* for moose-compat */
89
90     assert(metaobject);
91     assert(fmt);
92
93     va_start(args, fmt);
94     message = vnewSVpvf(fmt, &args);
95     va_end(args);
96
97     {
98         dSP;
99         PUSHMARK(SP);
100         EXTEND(SP, 4);
101
102         PUSHs(metaobject);
103         mPUSHs(message);
104
105         mPUSHs(newSVpvs("depth"));
106         mPUSHi(-1);
107
108         PUTBACK;
109
110         call_method("throw_error", G_VOID);
111         croak("throw_error() did not throw the error (%"SVf")", message);
112     }
113 }
114
115 bool
116 mouse_is_class_loaded(pTHX_ SV * const klass){
117     HV *stash;
118     GV** gvp;
119     HE* he;
120
121     if (!(SvPOKp(klass) && SvCUR(klass))) { /* XXX: SvPOK does not work with magical scalars */
122         return FALSE;
123     }
124
125     stash = gv_stashsv(klass, FALSE);
126     if (!stash) {
127         return FALSE;
128     }
129
130     if (( gvp = (GV**)hv_fetchs(stash, "VERSION", FALSE) )) {
131         if(isGV(*gvp) && GvSV(*gvp) && SvOK(GvSV(*gvp))){
132             return TRUE;
133         }
134     }
135
136     if (( gvp = (GV**)hv_fetchs(stash, "ISA", FALSE) )) {
137         if(isGV(*gvp) && GvAV(*gvp) && av_len(GvAV(*gvp)) != -1){
138             return TRUE;
139         }
140     }
141
142     hv_iterinit(stash);
143     while(( he = hv_iternext(stash) )){
144         GV* const gv = (GV*)HeVAL(he);
145
146         if(isGV(gv)){
147             if(GvCVu(gv)){
148                 return TRUE;
149             }
150         }
151         else if(SvOK(gv)){
152             return TRUE;
153         }
154     }
155     return FALSE;
156 }
157
158
159 SV *
160 mouse_call0 (pTHX_ SV *const self, SV *const method)
161 {
162     dSP;
163     SV *ret;
164
165     PUSHMARK(SP);
166     XPUSHs(self);
167     PUTBACK;
168
169     call_sv(method, G_SCALAR | G_METHOD);
170
171     SPAGAIN;
172     ret = POPs;
173     PUTBACK;
174
175     return ret;
176 }
177
178 SV *
179 mouse_call1 (pTHX_ SV *const self, SV *const method, SV* const arg1)
180 {
181     dSP;
182     SV *ret;
183
184     PUSHMARK(SP);
185     EXTEND(SP, 2);
186     PUSHs(self);
187     PUSHs(arg1);
188     PUTBACK;
189
190     call_sv(method, G_SCALAR | G_METHOD);
191
192     SPAGAIN;
193     ret = POPs;
194     PUTBACK;
195
196     return ret;
197 }
198
199 SV*
200 mouse_get_metaclass(pTHX_ SV* metaclass_name){
201     CV* const get_metaclass  = get_cvs("Mouse::Util::get_metaclass_by_name", TRUE);
202     SV* metaclass;
203     dSP;
204
205     assert(metaclass_name);
206     if(IsObject(metaclass_name)){
207         HV* const stash = SvSTASH(metaclass_name);
208
209         metaclass_name = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
210         sv_2mortal(metaclass_name);
211     }
212
213     PUSHMARK(SP);
214     XPUSHs(metaclass_name);
215     PUTBACK;
216
217     call_sv((SV*)get_metaclass, G_SCALAR);
218
219     SPAGAIN;
220     metaclass = POPs;
221     PUTBACK;
222
223     return metaclass;
224 }
225
226 MAGIC*
227 mouse_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl, I32 const flags){
228     MAGIC* mg;
229
230     assert(sv != NULL);
231     for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){
232         if(mg->mg_virtual == vtbl){
233             return mg;
234         }
235     }
236
237     if(flags & MOUSEf_DIE_ON_FAIL){
238         croak("mouse_mg_find: no MAGIC found for %"SVf, sv_2mortal(newRV_inc(sv)));
239     }
240     return NULL;
241 }
242
243 GV*
244 mouse_stash_fetch(pTHX_ HV* const stash, const char* const name, I32 const namelen, I32 const create) {
245     GV** const gvp = (GV**)hv_fetch(stash, name, namelen, create);
246
247     if(gvp){
248         if(!isGV(*gvp)){
249             gv_init(*gvp, stash, name, namelen, GV_ADDMULTI);
250         }
251         return *gvp;
252     }
253     else{
254         return NULL;
255     }
256 }
257
258 MODULE = Mouse::Util  PACKAGE = Mouse::Util
259
260 PROTOTYPES:   DISABLE
261 VERSIONCHECK: DISABLE
262
263 bool
264 is_class_loaded(SV* sv)
265
266 void
267 get_code_info(CV* code)
268 PREINIT:
269     GV* gv;
270     HV* stash;
271 PPCODE:
272     if((gv = CvGV(code)) && isGV(gv) && (stash = GvSTASH(gv))){
273         EXTEND(SP, 2);
274         mPUSHs(newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U));
275         mPUSHs(newSVpvn_share(GvNAME_get(gv), GvNAMELEN_get(gv), 0U));
276     }
277
278 SV*
279 get_code_package(CV* code)
280 PREINIT:
281     HV* stash;
282 CODE:
283     if(CvGV(code) && isGV(CvGV(code)) && (stash = GvSTASH(CvGV(code)))){
284         RETVAL = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
285     }
286     else{
287         RETVAL = &PL_sv_no;
288     }
289 OUTPUT:
290     RETVAL
291
292 CV*
293 get_code_ref(SV* package, SV* name)
294 CODE:
295 {
296     HV* stash;
297     STRLEN name_len;
298     const char* name_pv;
299     GV* gv;
300
301     if(!SvOK(package)){
302         croak("You must define a package name");
303     }
304     if(!SvOK(name)){
305         croak("You must define a subroutine name");
306     }
307
308     stash = gv_stashsv(package, FALSE);
309     if(!stash){
310         XSRETURN_UNDEF;
311     }
312
313     name_pv = SvPV_const(name, name_len);
314     gv = stash_fetch(stash, name_pv, name_len, FALSE);
315     RETVAL = gv ? GvCVu(gv) : NULL;
316
317     if(!RETVAL){
318         XSRETURN_UNDEF;
319     }
320 }
321 OUTPUT:
322     RETVAL
323
324 void
325 generate_isa_predicate_for(SV* klass, SV* predicate_name = NULL)
326 PPCODE:
327 {
328     const char* name_pv = NULL;
329     CV* xsub;
330
331     SvGETMAGIC(klass);
332
333     if(!SvOK(klass)){
334         croak("You must define a class name");
335     }
336
337     if(predicate_name){
338         SvGETMAGIC(predicate_name);
339         if(!SvOK(predicate_name)){
340             croak("You must define a predicate_name");
341         }
342         name_pv = SvPV_nolen_const(predicate_name);
343     }
344
345     xsub = mouse_generate_isa_predicate_for(aTHX_ klass, name_pv);
346
347     if(predicate_name == NULL){ /* anonymous predicate */
348         XPUSHs( newRV_noinc((SV*)xsub) );
349     }
350 }