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                 SvREADONLY_off(isa);
  25                 av_clear(isa);
  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(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV){
  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 GvAV(cachegv);
  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
 116 /* equivalent to "blessed($x) && $x->isa($klass)" */
 117 bool
 118 mouse_is_instance_of(pTHX_ SV* const sv, SV* const klass){
 119     assert(sv);
 120     assert(klass);
 121
 122     if(IsObject(sv) && SvOK(klass)){
 123         bool ok;
 124
 125         ENTER;
 126         SAVETMPS;
 127
 128         ok = SvTRUEx(mcall1s(sv, "isa", klass));
 129
 130         FREETMPS;
 131         LEAVE;
 132
 133         return ok;
 134     }
 135
 136     return FALSE;
 137 }
 138
 139
 140 bool
 141 mouse_is_class_loaded(pTHX_ SV * const klass){
 142     HV *stash;
 143     GV** gvp;
 144     HE* he;
 145
 146     if (!(SvPOKp(klass) && SvCUR(klass))) { /* XXX: SvPOK does not work with magical scalars */
 147         return FALSE;
 148     }
 149
 150     stash = gv_stashsv(klass, FALSE);
 151     if (!stash) {
 152         return FALSE;
 153     }
 154
 155     if (( gvp = (GV**)hv_fetchs(stash, "VERSION", FALSE) )) {
 156         if(isGV(*gvp) && GvSV(*gvp) && SvOK(GvSV(*gvp))){
 157             return TRUE;
 158         }
 159     }
 160
 161     if (( gvp = (GV**)hv_fetchs(stash, "ISA", FALSE) )) {
 162         if(isGV(*gvp) && GvAV(*gvp) && av_len(GvAV(*gvp)) != -1){
 163             return TRUE;
 164         }
 165     }
 166
 167     hv_iterinit(stash);
 168     while(( he = hv_iternext(stash) )){
 169         GV* const gv = (GV*)HeVAL(he);
 170
 171         if(isGV(gv)){
 172             if(GvCVu(gv)){
 173                 return TRUE;
 174             }
 175         }
 176         else if(SvOK(gv)){
 177             return TRUE;
 178         }
 179     }
 180     return FALSE;
 181 }
 182
 183
 184 SV *
 185 mouse_call0 (pTHX_ SV *const self, SV *const method)
 186 {
 187     dSP;
 188     SV *ret;
 189
 190     PUSHMARK(SP);
 191     XPUSHs(self);
 192     PUTBACK;
 193
 194     call_sv(method, G_SCALAR | G_METHOD);
 195
 196     SPAGAIN;
 197     ret = POPs;
 198     PUTBACK;
 199
 200     return ret;
 201 }
 202
 203 SV *
 204 mouse_call1 (pTHX_ SV *const self, SV *const method, SV* const arg1)
 205 {
 206     dSP;
 207     SV *ret;
 208
 209     PUSHMARK(SP);
 210     EXTEND(SP, 2);
 211     PUSHs(self);
 212     PUSHs(arg1);
 213     PUTBACK;
 214
 215     call_sv(method, G_SCALAR | G_METHOD);
 216
 217     SPAGAIN;
 218     ret = POPs;
 219     PUTBACK;
 220
 221     return ret;
 222 }
 223
 224 MAGIC*
 225 mouse_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl, I32 const flags){
 226     MAGIC* mg;
 227
 228     assert(sv != NULL);
 229     for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){
 230         if(mg->mg_virtual == vtbl){
 231             return mg;
 232         }
 233     }
 234
 235     if(flags & MOUSEf_DIE_ON_FAIL){
 236         croak("mouse_mg_find: no MAGIC found for %"SVf, sv_2mortal(newRV_inc(sv)));
 237     }
 238     return NULL;
 239 }
 240
 241 MODULE = Mouse::Util  PACKAGE = Mouse::Util
 242
 243 PROTOTYPES:   DISABLE
 244 VERSIONCHECK: DISABLE
 245
 246 bool
 247 is_class_loaded(SV* sv)
 248
 249 void
 250 get_code_info(CV* code)
 251 PREINIT:
 252     GV* gv;
 253     HV* stash;
 254 PPCODE:
 255     if((gv = CvGV(code)) && isGV(gv) && (stash = GvSTASH(gv))){
 256         EXTEND(SP, 2);
 257         mPUSHs(newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U));
 258         mPUSHs(newSVpvn_share(GvNAME_get(gv), GvNAMELEN_get(gv), 0U));
 259     }
 260
 261 SV*
 262 get_code_package(CV* code)
 263 PREINIT:
 264     HV* stash;
 265 CODE:
 266     if(CvGV(code) && isGV(CvGV(code)) && (stash = GvSTASH(CvGV(code)))){
 267         RETVAL = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
 268     }
 269     else{
 270         RETVAL = &PL_sv_no;
 271     }
 272 OUTPUT:
 273     RETVAL
 274
 275 CV*
 276 get_code_ref(SV* package, SV* name)
 277 CODE:
 278 {
 279     HV* stash;
 280     HE* he;
 281
 282     if(!SvOK(package)){
 283         croak("You must define a package name");
 284     }
 285     if(!SvOK(name)){
 286         croak("You must define a subroutine name");
 287     }
 288
 289     stash = gv_stashsv(package, FALSE);
 290     if(!stash){
 291         XSRETURN_UNDEF;
 292     }
 293     he = hv_fetch_ent(stash, name, FALSE, 0U);
 294     if(he){
 295         GV* const gv = (GV*)hv_iterval(stash, he);
 296         if(!isGV(gv)){ /* special constant or stub */
 297             STRLEN len;
 298             const char* const pv = SvPV_const(name, len);
 299             gv_init(gv, stash, pv, len, GV_ADDMULTI);
 300         }
 301         RETVAL = GvCVu(gv);
 302     }
 303     else{
 304         RETVAL = NULL;
 305     }
 306
 307     if(!RETVAL){
 308         XSRETURN_UNDEF;
 309     }
 310 }
 311 OUTPUT:
 312     RETVAL
 313
 314 void
 315 generate_isa_predicate_for(SV* klass, const char* predicate_name = NULL)
 316 PPCODE:
 317 {
 318     STRLEN klass_len;
 319     const char* klass_pv;
 320     HV* stash;
 321     CV* xsub;
 322
 323     if(!SvOK(klass)){
 324         croak("You must define a class name for generate_for");
 325     }
 326     klass_pv = SvPV_const(klass, klass_len);
 327     klass_pv = mouse_canonicalize_package_name(klass_pv);
 328
 329     if(strNE(klass_pv, "UNIVERSAL")){
 330         static MGVTBL mouse_util_type_constraints_vtbl; /* not used, only for identity */
 331
 332         xsub = newXS(predicate_name, XS_isa_check, __FILE__);
 333
 334         stash = gv_stashpvn(klass_pv, klass_len, GV_ADD);
 335
 336         CvXSUBANY(xsub).any_ptr = sv_magicext(
 337             (SV*)xsub,
 338             (SV*)stash, /* mg_obj */
 339             PERL_MAGIC_ext,
 340             &mouse_util_type_constraints_vtbl,
 341             klass_pv,   /* mg_ptr */
 342             klass_len   /* mg_len */
 343         );
 344     }
 345     else{
 346         xsub = newXS(predicate_name, XS_isa_check_for_universal, __FILE__);
 347     }
 348
 349     if(predicate_name == NULL){ /* anonymous predicate */
 350         XPUSHs( newRV_noinc((SV*)xsub) );
 351     }
 352 }