Simplify error check routines in XS
[gitmo/Mouse.git] / xs-src / MouseUtil.xs
CommitLineData
646c0371 1#include "mouse.h"
2
fd168725 3#define MY_CXT_KEY "Mouse::Util::_guts" XS_VERSION
4typedef struct {
5 HV* metas;
6} my_cxt_t;
7START_MY_CXT
8
646c0371 9#define ISA_CACHE "::LINEALIZED_ISA_CACHE::"
10
11#ifdef no_mro_get_linear_isa
12AV*
13mouse_mro_get_linear_isa(pTHX_ HV* const stash){
6582d0e3 14 GV* const cachegv = *(GV**)hv_fetchs(stash, ISA_CACHE, TRUE);
15 AV* isa;
16 SV* gen;
17 CV* get_linear_isa;
18
19 if(!isGV(cachegv))
20 gv_init(cachegv, stash, ISA_CACHE, sizeof(ISA_CACHE)-1, TRUE);
21
22 isa = GvAVn(cachegv);
23 gen = GvSVn(cachegv);
24
25
26 if(SvIOK(gen) && SvIVX(gen) == (IV)mro_get_pkg_gen(stash)){
27 return isa; /* returns the cache if available */
28 }
29 else{
cd658d1f 30 SvREFCNT_dec(isa);
31 GvAV(cachegv) = isa = newAV();
6582d0e3 32 }
33
34 get_linear_isa = get_cv("Mouse::Util::get_linear_isa", TRUE);
35
36 {
37 SV* avref;
38 dSP;
39
40 ENTER;
41 SAVETMPS;
42
43 PUSHMARK(SP);
44 mXPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash));
45 PUTBACK;
46
47 call_sv((SV*)get_linear_isa, G_SCALAR);
48
49 SPAGAIN;
50 avref = POPs;
51 PUTBACK;
52
80aa5731 53 if(IsArrayRef(avref)){
6582d0e3 54 AV* const av = (AV*)SvRV(avref);
55 I32 const len = AvFILLp(av) + 1;
56 I32 i;
57
58 for(i = 0; i < len; i++){
59 HV* const stash = gv_stashsv(AvARRAY(av)[i], FALSE);
60 if(stash)
61 av_push(isa, newSVpv(HvNAME(stash), 0));
62 }
63 SvREADONLY_on(isa);
64 }
65 else{
66 Perl_croak(aTHX_ "Mouse:Util::get_linear_isa() didn't return an ARRAY reference");
67 }
68
69 FREETMPS;
70 LEAVE;
71 }
72
73 sv_setiv(gen, (IV)mro_get_pkg_gen(stash));
cd658d1f 74 return isa;
646c0371 75}
76#endif /* !no_mor_get_linear_isa */
77
78#ifdef DEBUGGING
79SV**
80mouse_av_at_safe(pTHX_ AV* const av, I32 const ix){
81 assert(av);
82 assert(SvTYPE(av) == SVt_PVAV);
83 assert(AvMAX(av) >= ix);
84 return &AvARRAY(av)[ix];
85}
86#endif
87
88void
89mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const char* const fmt, ...){
90 dTHX;
91 va_list args;
92 SV* message;
93
646c0371 94 assert(metaobject);
95 assert(fmt);
96
97 va_start(args, fmt);
98 message = vnewSVpvf(fmt, &args);
99 va_end(args);
100
101 {
102 dSP;
103 PUSHMARK(SP);
077f2efd 104 EXTEND(SP, 6);
646c0371 105
106 PUSHs(metaobject);
107 mPUSHs(message);
108
431e4817 109 if(data){ /* extra arg, might be useful for debugging */
077f2efd 110 mPUSHs(newSVpvs("data"));
431e4817 111 PUSHs(data);
112 mPUSHs(newSVpvs("depth"));
113 mPUSHi(-1);
114 }
646c0371 115
116 PUTBACK;
117
118 call_method("throw_error", G_VOID);
119 croak("throw_error() did not throw the error (%"SVf")", message);
120 }
121}
122
d06d9266 123void
124mouse_must_defined(pTHX_ SV* const value, const char* const name) {
125 assert(value);
126 assert(name);
127
128 SvGETMAGIC(value);
129 if(!SvOK(value)){
130 croak("You must define %s", name);
131 }
132}
133
134void
135mouse_must_ref(pTHX_ SV* const value, const char* const name, svtype const t) {
136 assert(value);
137 assert(name);
138
139 SvGETMAGIC(value);
140 if(!(SvROK(value) && (t == SVt_NULL || SvTYPE(SvRV(value)) == t))) {
141 croak("You must pass %s, not %s",
142 name, SvOK(value) ? SvPV_nolen(value) : "undef");
143 }
144}
145
146
646c0371 147bool
148mouse_is_class_loaded(pTHX_ SV * const klass){
149 HV *stash;
150 GV** gvp;
151 HE* he;
152
153 if (!(SvPOKp(klass) && SvCUR(klass))) { /* XXX: SvPOK does not work with magical scalars */
154 return FALSE;
155 }
156
157 stash = gv_stashsv(klass, FALSE);
158 if (!stash) {
159 return FALSE;
160 }
161
162 if (( gvp = (GV**)hv_fetchs(stash, "VERSION", FALSE) )) {
163 if(isGV(*gvp) && GvSV(*gvp) && SvOK(GvSV(*gvp))){
164 return TRUE;
165 }
166 }
167
168 if (( gvp = (GV**)hv_fetchs(stash, "ISA", FALSE) )) {
169 if(isGV(*gvp) && GvAV(*gvp) && av_len(GvAV(*gvp)) != -1){
170 return TRUE;
171 }
172 }
173
174 hv_iterinit(stash);
175 while(( he = hv_iternext(stash) )){
176 GV* const gv = (GV*)HeVAL(he);
177
178 if(isGV(gv)){
179 if(GvCVu(gv)){
180 return TRUE;
181 }
182 }
183 else if(SvOK(gv)){
184 return TRUE;
185 }
186 }
187 return FALSE;
188}
189
190
0aad0266 191SV*
192mouse_call0 (pTHX_ SV* const self, SV* const method) {
646c0371 193 dSP;
194 SV *ret;
195
196 PUSHMARK(SP);
197 XPUSHs(self);
198 PUTBACK;
199
200 call_sv(method, G_SCALAR | G_METHOD);
201
202 SPAGAIN;
203 ret = POPs;
204 PUTBACK;
205
206 return ret;
207}
208
0aad0266 209SV*
210mouse_call1 (pTHX_ SV* const self, SV* const method, SV* const arg1) {
646c0371 211 dSP;
212 SV *ret;
213
214 PUSHMARK(SP);
215 EXTEND(SP, 2);
216 PUSHs(self);
217 PUSHs(arg1);
218 PUTBACK;
219
220 call_sv(method, G_SCALAR | G_METHOD);
221
222 SPAGAIN;
223 ret = POPs;
224 PUTBACK;
225
226 return ret;
227}
228
0aad0266 229int
230mouse_predicate_call(pTHX_ SV* const self, SV* const method) {
6ad77996 231 return sv_true( mcall0(self, method) );
0aad0266 232}
233
a39e9541 234SV*
aa2d2e2c 235mouse_get_metaclass(pTHX_ SV* metaclass_name){
fd168725 236 dMY_CXT;
237 HE* he;
a39e9541 238
aa2d2e2c 239 assert(metaclass_name);
fd168725 240 assert(MY_CXT.metas);
241
aa2d2e2c 242 if(IsObject(metaclass_name)){
a5c683f6 243 HV* const stash = SvSTASH(SvRV(metaclass_name));
aa2d2e2c 244
245 metaclass_name = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
246 sv_2mortal(metaclass_name);
247 }
248
fd168725 249 he = hv_fetch_ent(MY_CXT.metas, metaclass_name, FALSE, 0U);
a39e9541 250
fd168725 251 return he ? HeVAL(he) : &PL_sv_undef;
a39e9541 252}
253
646c0371 254MAGIC*
255mouse_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl, I32 const flags){
256 MAGIC* mg;
257
258 assert(sv != NULL);
259 for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){
260 if(mg->mg_virtual == vtbl){
261 return mg;
262 }
263 }
264
265 if(flags & MOUSEf_DIE_ON_FAIL){
266 croak("mouse_mg_find: no MAGIC found for %"SVf, sv_2mortal(newRV_inc(sv)));
267 }
268 return NULL;
269}
270
a39e9541 271GV*
272mouse_stash_fetch(pTHX_ HV* const stash, const char* const name, I32 const namelen, I32 const create) {
273 GV** const gvp = (GV**)hv_fetch(stash, name, namelen, create);
274
275 if(gvp){
276 if(!isGV(*gvp)){
277 gv_init(*gvp, stash, name, namelen, GV_ADDMULTI);
278 }
279 return *gvp;
280 }
281 else{
282 return NULL;
283 }
284}
285
d67f600d 286void
287mouse_install_sub(pTHX_ GV* const gv, SV* const code_ref) {
288 CV* cv;
289
290 assert(gv != NULL);
291 assert(code_ref != NULL);
292 assert(isGV(gv));
293 assert(IsCodeRef(code_ref));
294
295 if(GvCVu(gv)){ /* delete *slot{gv} to work around "redefine" warning */
296 SvREFCNT_dec(GvCV(gv));
297 GvCV(gv) = NULL;
298 }
d06d9266 299
d67f600d 300 sv_setsv_mg((SV*)gv, code_ref); /* *gv = $code_ref */
301
302 /* name the CODE ref if it's anonymous */
303 cv = (CV*)SvRV(code_ref);
304 if(CvANON(cv)
305 && CvGV(cv) /* a cv under construction has no gv */ ){
306 HV* dbsub;
307
308 /* update %DB::sub to make NYTProf happy */
309 if((PL_perldb & (PERLDBf_SUBLINE|PERLDB_NAMEANON))
310 && PL_DBsub && (dbsub = GvHV(PL_DBsub))
311 ){
312 /* see Perl_newATTRSUB() in op.c */
313 SV* const subname = sv_newmortal();
314 HE* orig;
315
316 gv_efullname3(subname, CvGV(cv), NULL);
317 orig = hv_fetch_ent(dbsub, subname, FALSE, 0U);
318 if(orig){
319 gv_efullname3(subname, gv, NULL);
320 (void)hv_store_ent(dbsub, subname, HeVAL(orig), 0U);
321 SvREFCNT_inc_simple_void_NN(HeVAL(orig));
322 }
323 }
324
325 CvGV(cv) = gv;
326 CvANON_off(cv);
327 }
328}
329
646c0371 330MODULE = Mouse::Util PACKAGE = Mouse::Util
331
332PROTOTYPES: DISABLE
333VERSIONCHECK: DISABLE
334
fd168725 335BOOT:
336{
337 MY_CXT_INIT;
338 MY_CXT.metas = NULL;
339}
340
341void
342__register_metaclass_storage(HV* metas, bool cloning)
343CODE:
344{
345 if(cloning){
346 MY_CXT_CLONE;
347 MY_CXT.metas = NULL;
348 }
349 {
350 dMY_CXT;
351 if(MY_CXT.metas) croak("Cannot set metaclass storage more than once");
352 MY_CXT.metas = metas;
353 SvREFCNT_inc_simple_void_NN(metas);
354 }
355}
356
646c0371 357bool
0ffc4183 358is_valid_class_name(SV* sv)
359CODE:
360{
361 SvGETMAGIC(sv);
362 if(SvPOKp(sv) && SvCUR(sv) > 0){
363 UV i;
364 RETVAL = TRUE;
365 for(i = 0; i < SvCUR(sv); i++){
366 char const c = SvPVX(sv)[i];
367 if(!(isALNUM(c) || c == ':')){
368 RETVAL = FALSE;
369 break;
370 }
371 }
372 }
373 else{
374 RETVAL = SvNIOKp(sv) ? TRUE : FALSE;
375 }
376}
377OUTPUT:
378 RETVAL
379
380bool
646c0371 381is_class_loaded(SV* sv)
382
383void
384get_code_info(CV* code)
385PREINIT:
386 GV* gv;
387 HV* stash;
388PPCODE:
389 if((gv = CvGV(code)) && isGV(gv) && (stash = GvSTASH(gv))){
390 EXTEND(SP, 2);
391 mPUSHs(newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U));
392 mPUSHs(newSVpvn_share(GvNAME_get(gv), GvNAMELEN_get(gv), 0U));
393 }
394
395SV*
396get_code_package(CV* code)
397PREINIT:
398 HV* stash;
399CODE:
400 if(CvGV(code) && isGV(CvGV(code)) && (stash = GvSTASH(CvGV(code)))){
401 RETVAL = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
402 }
403 else{
404 RETVAL = &PL_sv_no;
405 }
406OUTPUT:
407 RETVAL
408
409CV*
410get_code_ref(SV* package, SV* name)
411CODE:
412{
413 HV* stash;
a39e9541 414 STRLEN name_len;
415 const char* name_pv;
416 GV* gv;
646c0371 417
d06d9266 418 must_defined(package, "a package name");
419 must_defined(name, "a subroutine name");
646c0371 420
421 stash = gv_stashsv(package, FALSE);
422 if(!stash){
423 XSRETURN_UNDEF;
424 }
a39e9541 425
426 name_pv = SvPV_const(name, name_len);
427 gv = stash_fetch(stash, name_pv, name_len, FALSE);
428 RETVAL = gv ? GvCVu(gv) : NULL;
646c0371 429
430 if(!RETVAL){
431 XSRETURN_UNDEF;
432 }
433}
434OUTPUT:
435 RETVAL
436
437void
ebe91068 438generate_isa_predicate_for(SV* arg, SV* predicate_name = NULL)
439ALIAS:
440 generate_isa_predicate_for = 0
441 generate_can_predicate_for = 1
646c0371 442PPCODE:
443{
441964ce 444 const char* name_pv = NULL;
646c0371 445 CV* xsub;
446
d06d9266 447 must_defined(arg, ix == 0 ? "a class_name" : "method names");
646c0371 448
441964ce 449 if(predicate_name){
d06d9266 450 must_defined(predicate_name, "a predicate name");
441964ce 451 name_pv = SvPV_nolen_const(predicate_name);
646c0371 452 }
453
ebe91068 454 if(ix == 0){
455 xsub = mouse_generate_isa_predicate_for(aTHX_ arg, name_pv);
456 }
457 else{
458 xsub = mouse_generate_can_predicate_for(aTHX_ arg, name_pv);
459 }
441964ce 460
646c0371 461 if(predicate_name == NULL){ /* anonymous predicate */
73337709 462 mXPUSHs( newRV_inc((SV*)xsub) );
646c0371 463 }
464}
d67f600d 465
466# This xsub will redefine &Mouse::Util::install_subroutines()
467void
468install_subroutines(SV* into, ...)
469CODE:
470{
471 HV* stash;
472 I32 i;
473
d06d9266 474 must_defined(into, "a package name");
d67f600d 475 stash = gv_stashsv(into, TRUE);
476
477 if( ((items-1) % 2) != 0 ){
478 croak_xs_usage(cv, "into, name => coderef [, other_name, other_coderef ...]");
479 }
480
481 for(i = 1; i < items; i += 2) {
482 SV* const name = ST(i);
483 SV* const code = ST(i+1);
484 STRLEN len;
485 const char* pv;
486 GV* gv;
487
d06d9266 488 must_defined(name, "a subroutine name");
489 must_ref(code, "a CODE reference", SVt_PVCV);
d67f600d 490
491 pv = SvPV_const(name, len);
492 gv = stash_fetch(stash, pv, len, TRUE);
493
494 mouse_install_sub(aTHX_ gv, code);
495 }
496}