xs/MOP.xs

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