xs-src/MouseUtil.xs

   1 #include "mouse.h"
   2
   3 #define MY_CXT_KEY "Mouse::Util::_guts" XS_VERSION
   4 typedef struct {
   5     HV* metas;
   6 } my_cxt_t;
   7 START_MY_CXT
   8
   9 #define ISA_CACHE "::LINEALIZED_ISA_CACHE::"
  10
  11 #ifdef no_mro_get_linear_isa
  12 AV*
  13 mouse_mro_get_linear_isa(pTHX_ HV* const stash){
  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{
  30         SvREFCNT_dec(isa);
  31         GvAV(cachegv) = isa = newAV();
  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
  53         if(IsArrayRef(avref)){
  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));
  74     return isa;
  75 }
  76 #endif /* !no_mor_get_linear_isa */
  77
  78 #ifdef DEBUGGING
  79 SV**
  80 mouse_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
  88 void
  89 mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const char* const fmt, ...){
  90     dTHX;
  91     va_list args;
  92     SV* message;
  93
  94     PERL_UNUSED_ARG(data); /* for moose-compat */
  95
  96     assert(metaobject);
  97     assert(fmt);
  98
  99     va_start(args, fmt);
 100     message = vnewSVpvf(fmt, &args);
 101     va_end(args);
 102
 103     {
 104         dSP;
 105         PUSHMARK(SP);
 106         EXTEND(SP, 4);
 107
 108         PUSHs(metaobject);
 109         mPUSHs(message);
 110
 111         mPUSHs(newSVpvs("depth"));
 112         mPUSHi(-1);
 113
 114         PUTBACK;
 115
 116         call_method("throw_error", G_VOID);
 117         croak("throw_error() did not throw the error (%"SVf")", message);
 118     }
 119 }
 120
 121 bool
 122 mouse_is_class_loaded(pTHX_ SV * const klass){
 123     HV *stash;
 124     GV** gvp;
 125     HE* he;
 126
 127     if (!(SvPOKp(klass) && SvCUR(klass))) { /* XXX: SvPOK does not work with magical scalars */
 128         return FALSE;
 129     }
 130
 131     stash = gv_stashsv(klass, FALSE);
 132     if (!stash) {
 133         return FALSE;
 134     }
 135
 136     if (( gvp = (GV**)hv_fetchs(stash, "VERSION", FALSE) )) {
 137         if(isGV(*gvp) && GvSV(*gvp) && SvOK(GvSV(*gvp))){
 138             return TRUE;
 139         }
 140     }
 141
 142     if (( gvp = (GV**)hv_fetchs(stash, "ISA", FALSE) )) {
 143         if(isGV(*gvp) && GvAV(*gvp) && av_len(GvAV(*gvp)) != -1){
 144             return TRUE;
 145         }
 146     }
 147
 148     hv_iterinit(stash);
 149     while(( he = hv_iternext(stash) )){
 150         GV* const gv = (GV*)HeVAL(he);
 151
 152         if(isGV(gv)){
 153             if(GvCVu(gv)){
 154                 return TRUE;
 155             }
 156         }
 157         else if(SvOK(gv)){
 158             return TRUE;
 159         }
 160     }
 161     return FALSE;
 162 }
 163
 164
 165 SV*
 166 mouse_call0 (pTHX_ SV* const self, SV* const method) {
 167     dSP;
 168     SV *ret;
 169
 170     PUSHMARK(SP);
 171     XPUSHs(self);
 172     PUTBACK;
 173
 174     call_sv(method, G_SCALAR | G_METHOD);
 175
 176     SPAGAIN;
 177     ret = POPs;
 178     PUTBACK;
 179
 180     return ret;
 181 }
 182
 183 SV*
 184 mouse_call1 (pTHX_ SV* const self, SV* const method, SV* const arg1) {
 185     dSP;
 186     SV *ret;
 187
 188     PUSHMARK(SP);
 189     EXTEND(SP, 2);
 190     PUSHs(self);
 191     PUSHs(arg1);
 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 int
 204 mouse_predicate_call(pTHX_ SV* const self, SV* const method) {
 205     return sv_true( mcall0(self, method) );
 206 }
 207
 208 SV*
 209 mouse_get_metaclass(pTHX_ SV* metaclass_name){
 210     dMY_CXT;
 211     HE* he;
 212
 213     assert(metaclass_name);
 214     assert(MY_CXT.metas);
 215
 216     if(IsObject(metaclass_name)){
 217         HV* const stash = SvSTASH(SvRV(metaclass_name));
 218
 219         metaclass_name = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
 220         sv_2mortal(metaclass_name);
 221     }
 222
 223     he = hv_fetch_ent(MY_CXT.metas, metaclass_name, FALSE, 0U);
 224
 225     return he ? HeVAL(he) : &PL_sv_undef;
 226 }
 227
 228 MAGIC*
 229 mouse_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl, I32 const flags){
 230     MAGIC* mg;
 231
 232     assert(sv != NULL);
 233     for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){
 234         if(mg->mg_virtual == vtbl){
 235             return mg;
 236         }
 237     }
 238
 239     if(flags & MOUSEf_DIE_ON_FAIL){
 240         croak("mouse_mg_find: no MAGIC found for %"SVf, sv_2mortal(newRV_inc(sv)));
 241     }
 242     return NULL;
 243 }
 244
 245 GV*
 246 mouse_stash_fetch(pTHX_ HV* const stash, const char* const name, I32 const namelen, I32 const create) {
 247     GV** const gvp = (GV**)hv_fetch(stash, name, namelen, create);
 248
 249     if(gvp){
 250         if(!isGV(*gvp)){
 251             gv_init(*gvp, stash, name, namelen, GV_ADDMULTI);
 252         }
 253         return *gvp;
 254     }
 255     else{
 256         return NULL;
 257     }
 258 }
 259
 260 MODULE = Mouse::Util  PACKAGE = Mouse::Util
 261
 262 PROTOTYPES:   DISABLE
 263 VERSIONCHECK: DISABLE
 264
 265 BOOT:
 266 {
 267     MY_CXT_INIT;
 268     MY_CXT.metas = NULL;
 269 }
 270
 271 void
 272 __register_metaclass_storage(HV* metas, bool cloning)
 273 CODE:
 274 {
 275     if(cloning){
 276         MY_CXT_CLONE;
 277         MY_CXT.metas = NULL;
 278     }
 279     {
 280         dMY_CXT;
 281         if(MY_CXT.metas) croak("Cannot set metaclass storage more than once");
 282         MY_CXT.metas = metas;
 283         SvREFCNT_inc_simple_void_NN(metas);
 284     }
 285 }
 286
 287 bool
 288 is_class_loaded(SV* sv)
 289
 290 void
 291 get_code_info(CV* code)
 292 PREINIT:
 293     GV* gv;
 294     HV* stash;
 295 PPCODE:
 296     if((gv = CvGV(code)) && isGV(gv) && (stash = GvSTASH(gv))){
 297         EXTEND(SP, 2);
 298         mPUSHs(newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U));
 299         mPUSHs(newSVpvn_share(GvNAME_get(gv), GvNAMELEN_get(gv), 0U));
 300     }
 301
 302 SV*
 303 get_code_package(CV* code)
 304 PREINIT:
 305     HV* stash;
 306 CODE:
 307     if(CvGV(code) && isGV(CvGV(code)) && (stash = GvSTASH(CvGV(code)))){
 308         RETVAL = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
 309     }
 310     else{
 311         RETVAL = &PL_sv_no;
 312     }
 313 OUTPUT:
 314     RETVAL
 315
 316 CV*
 317 get_code_ref(SV* package, SV* name)
 318 CODE:
 319 {
 320     HV* stash;
 321     STRLEN name_len;
 322     const char* name_pv;
 323     GV* gv;
 324
 325     if(!SvOK(package)){
 326         croak("You must define a package name");
 327     }
 328     if(!SvOK(name)){
 329         croak("You must define a subroutine name");
 330     }
 331
 332     stash = gv_stashsv(package, FALSE);
 333     if(!stash){
 334         XSRETURN_UNDEF;
 335     }
 336
 337     name_pv = SvPV_const(name, name_len);
 338     gv = stash_fetch(stash, name_pv, name_len, FALSE);
 339     RETVAL = gv ? GvCVu(gv) : NULL;
 340
 341     if(!RETVAL){
 342         XSRETURN_UNDEF;
 343     }
 344 }
 345 OUTPUT:
 346     RETVAL
 347
 348 void
 349 generate_isa_predicate_for(SV* arg, SV* predicate_name = NULL)
 350 ALIAS:
 351     generate_isa_predicate_for = 0
 352     generate_can_predicate_for = 1
 353 PPCODE:
 354 {
 355     const char* name_pv = NULL;
 356     CV* xsub;
 357
 358     SvGETMAGIC(arg);
 359
 360     if(!SvOK(arg)){
 361         croak("You must define %s", ix == 0 ? "a class name" : "method names");
 362     }
 363
 364     if(predicate_name){
 365         SvGETMAGIC(predicate_name);
 366         if(!SvOK(predicate_name)){
 367             croak("You must define %s", "a predicate name");
 368         }
 369         name_pv = SvPV_nolen_const(predicate_name);
 370     }
 371
 372     if(ix == 0){
 373         xsub = mouse_generate_isa_predicate_for(aTHX_ arg, name_pv);
 374     }
 375     else{
 376         xsub = mouse_generate_can_predicate_for(aTHX_ arg, name_pv);
 377     }
 378
 379     if(predicate_name == NULL){ /* anonymous predicate */
 380         XPUSHs( newRV_noinc((SV*)xsub) );
 381     }
 382 }