xs/MOP.xs

   1 #include "mop.h"
   2
   3 SV *mop_method_metaclass;
   4 SV *mop_associated_metaclass;
   5 SV *mop_wrap;
   6
   7 static bool
   8 find_method (const char *key, STRLEN keylen, SV *val, void *ud)
   9 {
  10     bool *found_method = (bool *)ud;
  11     PERL_UNUSED_ARG(key);
  12     PERL_UNUSED_ARG(keylen);
  13     PERL_UNUSED_ARG(val);
  14     *found_method = TRUE;
  15     return FALSE;
  16 }
  17
  18 EXTERN_C XS(boot_Class__MOP__Package);
  19 EXTERN_C XS(boot_Class__MOP__Class);
  20 EXTERN_C XS(boot_Class__MOP__Attribute);
  21 EXTERN_C XS(boot_Class__MOP__Method);
  22
  23 MODULE = Class::MOP   PACKAGE = Class::MOP
  24
  25 PROTOTYPES: DISABLE
  26
  27 BOOT:
  28     mop_prehash_keys();
  29
  30     mop_method_metaclass     = newSVpvs("method_metaclass");
  31     mop_wrap                 = newSVpvs("wrap");
  32     mop_associated_metaclass = newSVpvs("associated_metaclass");
  33
  34     MOP_CALL_BOOT (boot_Class__MOP__Package);
  35     MOP_CALL_BOOT (boot_Class__MOP__Class);
  36     MOP_CALL_BOOT (boot_Class__MOP__Attribute);
  37     MOP_CALL_BOOT (boot_Class__MOP__Method);
  38
  39 # use prototype here to be compatible with get_code_info from Sub::Identify
  40 void
  41 get_code_info(coderef)
  42     SV *coderef
  43     PROTOTYPE: $
  44     PREINIT:
  45         char *pkg  = NULL;
  46         char *name = NULL;
  47     PPCODE:
  48         if (mop_get_code_info(coderef, &pkg, &name)) {
  49             EXTEND(SP, 2);
  50             PUSHs(newSVpv(pkg, 0));
  51             PUSHs(newSVpv(name, 0));
  52         }
  53
  54 # This is some pretty grotty logic. It _should_ be parallel to the
  55 # pure Perl version in lib/Class/MOP.pm, so if you want to understand
  56 # it we suggest you start there.
  57 void
  58 is_class_loaded(klass=&PL_sv_undef)
  59     SV *klass
  60     PREINIT:
  61         HV *stash;
  62         bool found_method = FALSE;
  63     PPCODE:
  64         if (!SvPOK(klass) || !SvCUR(klass)) {
  65             XSRETURN_NO;
  66         }
  67
  68         stash = gv_stashsv(klass, 0);
  69         if (!stash) {
  70             XSRETURN_NO;
  71         }
  72
  73         if (hv_exists_ent (stash, KEY_FOR(VERSION), HASH_FOR(VERSION))) {
  74             HE *version = hv_fetch_ent(stash, KEY_FOR(VERSION), 0, HASH_FOR(VERSION));
  75             SV *version_sv;
  76             if (version && HeVAL(version) && (version_sv = GvSV(HeVAL(version)))) {
  77                 if (SvROK(version_sv)) {
  78                     SV *version_sv_ref = SvRV(version_sv);
  79
  80                     if (SvOK(version_sv_ref)) {
  81                         XSRETURN_YES;
  82                     }
  83                 }
  84                 else if (SvOK(version_sv)) {
  85                     XSRETURN_YES;
  86                 }
  87             }
  88         }
  89
  90         if (hv_exists_ent (stash, KEY_FOR(ISA), HASH_FOR(ISA))) {
  91             HE *isa = hv_fetch_ent(stash, KEY_FOR(ISA), 0, HASH_FOR(ISA));
  92             if (isa && HeVAL(isa) && GvAV(HeVAL(isa)) && av_len(GvAV(HeVAL(isa))) != -1) {
  93                 XSRETURN_YES;
  94             }
  95         }
  96
  97         mop_get_package_symbols(stash, TYPE_FILTER_CODE, find_method, &found_method);
  98         if (found_method) {
  99             XSRETURN_YES;
 100         }
 101
 102         XSRETURN_NO;