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 DECLARE_KEY(name);
  12 DECLARE_KEY(package);
  13 DECLARE_KEY(package_name);
  14 DECLARE_KEY(body);
  15 DECLARE_KEY(package_cache_flag);
  16 DECLARE_KEY(methods);
  17 DECLARE_KEY(VERSION);
  18 DECLARE_KEY(ISA);
  19
  20 SV *method_metaclass;
  21 SV *associated_metaclass;
  22 SV *wrap;
  23
  24 MODULE = Class::MOP   PACKAGE = Class::MOP
  25
  26 PROTOTYPES: DISABLE
  27
  28 BOOT:
  29     PREHASH_KEY(name);
  30     PREHASH_KEY(body);
  31     PREHASH_KEY(package);
  32     PREHASH_KEY(package_name);
  33     PREHASH_KEY(methods);
  34     PREHASH_KEY(ISA);
  35     PREHASH_KEY(VERSION);
  36     PREHASH_KEY_WITH_VALUE(package_cache_flag, "_package_cache_flag");
  37
  38     method_metaclass     = newSVpvs("method_metaclass");
  39     wrap                 = newSVpvs("wrap");
  40     associated_metaclass = newSVpvs("associated_metaclass");
  41
  42         MOP_CALL_BOOT (boot_Class__MOP__Package);
  43         MOP_CALL_BOOT (boot_Class__MOP__Class);
  44         MOP_CALL_BOOT (boot_Class__MOP__Attribute);
  45         MOP_CALL_BOOT (boot_Class__MOP__Method);
  46
  47 # use prototype here to be compatible with get_code_info from Sub::Identify
  48 void
  49 get_code_info(coderef)
  50     SV *coderef
  51     PROTOTYPE: $
  52     PREINIT:
  53         char *pkg  = NULL;
  54         char *name = NULL;
  55     PPCODE:
  56         if (get_code_info(coderef, &pkg, &name)) {
  57             EXTEND(SP, 2);
  58             PUSHs(newSVpv(pkg, 0));
  59             PUSHs(newSVpv(name, 0));
  60         }
  61
  62 # This is some pretty grotty logic. It _should_ be parallel to the
  63 # pure Perl version in lib/Class/MOP.pm, so if you want to understand
  64 # it we suggest you start there.
  65 void
  66 is_class_loaded(klass=&PL_sv_undef)
  67     SV *klass
  68     PREINIT:
  69         HV *stash;
  70         bool found_method = FALSE;
  71     PPCODE:
  72         if (!SvPOK(klass) || !SvCUR(klass)) {
  73             XSRETURN_NO;
  74         }
  75
  76         stash = gv_stashsv(klass, 0);
  77         if (!stash) {
  78             XSRETURN_NO;
  79         }
  80
  81         if (hv_exists_ent (stash, key_VERSION, hash_VERSION)) {
  82             HE *version = hv_fetch_ent(stash, key_VERSION, 0, hash_VERSION);
  83             SV *version_sv;
  84             if (version && HeVAL(version) && (version_sv = GvSV(HeVAL(version)))) {
  85                 if (SvROK(version_sv)) {
  86                     SV *version_sv_ref = SvRV(version_sv);
  87
  88                     if (SvOK(version_sv_ref)) {
  89                         XSRETURN_YES;
  90                     }
  91                 }
  92                 else if (SvOK(version_sv)) {
  93                     XSRETURN_YES;
  94                 }
  95             }
  96         }
  97
  98         if (hv_exists_ent (stash, key_ISA, hash_ISA)) {
  99             HE *isa = hv_fetch_ent(stash, key_ISA, 0, hash_ISA);
 100             if (isa && HeVAL(isa) && GvAV(HeVAL(isa))) {
 101                 XSRETURN_YES;
 102             }
 103         }
 104
 105         get_package_symbols(stash, TYPE_FILTER_CODE, find_method, &found_method);
 106         if (found_method) {
 107             XSRETURN_YES;
 108         }
 109
 110         XSRETURN_NO;