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