xs/MOP.xs

   1 #include "mop.h"
   2
   3 SV *mop_method_metaclass;
   4 SV *mop_associated_metaclass;
   5 SV *mop_wrap;
   6 SV *mop_methods;
   7 SV *mop_name;
   8 SV *mop_body;
   9 SV *mop_package;
  10 SV *mop_package_name;
  11 SV *mop_package_cache_flag;
  12
  13 SV *mop_VERSION;
  14 SV *mop_ISA;
  15 SV *mop_isa;
  16
  17 /* equivalent to "blessed($x) && $x->isa($klass)" */
  18 bool
  19 mop_is_instance_of(pTHX_ SV* const sv, SV* const klass){
  20     assert(sv);
  21     assert(klass);
  22
  23     if(SvROK(sv) && SvOBJECT(SvRV(sv)) && SvOK(klass)){
  24         bool ok;
  25
  26         ENTER;
  27         SAVETMPS;
  28
  29         ok = SvTRUEx(mop_call1(aTHX_ sv, mop_isa, klass));
  30
  31         FREETMPS;
  32         LEAVE;
  33
  34         return FALSE;
  35     }
  36
  37     return FALSE;
  38 }
  39
  40 static bool
  41 find_method (const char *key, STRLEN keylen, SV *val, void *ud)
  42 {
  43     bool * const found_method = (bool *)ud;
  44     PERL_UNUSED_ARG(key);
  45     PERL_UNUSED_ARG(keylen);
  46     PERL_UNUSED_ARG(val);
  47     *found_method = TRUE;
  48     return FALSE;
  49 }
  50
  51
  52 bool
  53 mop_is_class_loaded(pTHX_ SV * const klass){
  54     HV *stash;
  55
  56     if (!(SvPOKp(klass) && SvCUR(klass))) { /* XXX: SvPOK does not work with magical scalars */
  57         return FALSE;
  58     }
  59
  60     stash = gv_stashsv(klass, 0);
  61     if (!stash) {
  62         return FALSE;
  63     }
  64
  65     if (hv_exists_ent (stash, mop_VERSION, 0U)) {
  66         HE *version = hv_fetch_ent(stash, mop_VERSION, 0, 0U);
  67         SV *version_sv;
  68         if (version && HeVAL(version) && (version_sv = GvSV(HeVAL(version)))) {
  69             if (SvROK(version_sv)) {
  70                 SV *version_sv_ref = SvRV(version_sv);
  71
  72                 if (SvOK(version_sv_ref)) {
  73                     return TRUE;
  74                 }
  75             }
  76             else if (SvOK(version_sv)) {
  77                 return TRUE;
  78             }
  79         }
  80     }
  81
  82     if (hv_exists_ent (stash, mop_ISA, 0U)) {
  83         HE *isa = hv_fetch_ent(stash, mop_ISA, 0, 0U);
  84         if (isa && HeVAL(isa) && GvAV(HeVAL(isa)) && av_len(GvAV(HeVAL(isa))) != -1) {
  85             return TRUE;;
  86         }
  87     }
  88
  89     {
  90         bool found_method = FALSE;
  91         mop_get_package_symbols(stash, TYPE_FILTER_CODE, find_method, &found_method);
  92        return found_method;
  93     }
  94 }
  95
  96 EXTERN_C XS(boot_Class__MOP__Package);
  97 EXTERN_C XS(boot_Class__MOP__Attribute);
  98 EXTERN_C XS(boot_Class__MOP__Method);
  99 EXTERN_C XS(boot_Class__MOP__Instance);
 100 EXTERN_C XS(boot_Class__MOP__Method__Accessor);
 101
 102 MODULE = Class::MOP   PACKAGE = Class::MOP
 103
 104 PROTOTYPES: DISABLE
 105
 106 BOOT:
 107     mop_method_metaclass     = MAKE_KEYSV(method_metaclass);
 108     mop_wrap                 = MAKE_KEYSV(wrap);
 109     mop_associated_metaclass = MAKE_KEYSV(associated_metaclass);
 110     mop_methods              = MAKE_KEYSV(methods);
 111     mop_name                 = MAKE_KEYSV(name);
 112     mop_body                 = MAKE_KEYSV(body);
 113     mop_package              = MAKE_KEYSV(package);
 114     mop_package_name         = MAKE_KEYSV(package_name);
 115     mop_package_cache_flag   = MAKE_KEYSV(_package_cache_flag);
 116     mop_VERSION              = MAKE_KEYSV(VERSION);
 117     mop_ISA                  = MAKE_KEYSV(ISA);
 118     mop_isa                  = MAKE_KEYSV(isa);
 119
 120     MOP_CALL_BOOT (boot_Class__MOP__Package);
 121     MOP_CALL_BOOT (boot_Class__MOP__Attribute);
 122     MOP_CALL_BOOT (boot_Class__MOP__Method);
 123     MOP_CALL_BOOT (boot_Class__MOP__Instance);
 124     MOP_CALL_BOOT (boot_Class__MOP__Method__Accessor);
 125
 126 # use prototype here to be compatible with get_code_info from Sub::Identify
 127 void
 128 get_code_info(coderef)
 129     SV *coderef
 130     PROTOTYPE: $
 131     PREINIT:
 132         char *pkg  = NULL;
 133         char *name = NULL;
 134     PPCODE:
 135         SvGETMAGIC(coderef);
 136         if (mop_get_code_info(coderef, &pkg, &name)) {
 137             EXTEND(SP, 2);
 138             mPUSHs(newSVpv(pkg, 0));
 139             mPUSHs(newSVpv(name, 0));
 140         }
 141
 142
 143 bool
 144 is_class_loaded(SV* klass = &PL_sv_undef)
 145 INIT:
 146     SvGETMAGIC(klass);
 147
 148
 149
 150 #bool
 151 #is_instance_of(SV* sv, SV* klass)
 152 #INIT:
 153 #    SvGETMAGIC(sv);
 154 #    SvGETMAGIC(klass);
 155 #