xs/HasMethods.xs

   1 #include "mop.h"
   2
   3 SV *mop_method_metaclass;
   4 SV *mop_associated_metaclass;
   5 SV *mop_wrap;
   6
   7 static void
   8 mop_update_method_map(pTHX_ SV *const self, SV *const class_name, HV *const stash, HV *const map)
   9 {
  10     const char *const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */
  11     char *method_name;
  12     I32   method_name_len;
  13     SV   *coderef;
  14     HV   *symbols;
  15
  16     symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE);
  17     sv_2mortal((SV*)symbols);
  18     (void)hv_iterinit(symbols);
  19     while ( (coderef = hv_iternextsv(symbols, &method_name, &method_name_len)) ) {
  20         CV *cv = (CV *)SvRV(coderef);
  21         char *cvpkg_name;
  22         char *cv_name;
  23         SV *method_slot;
  24
  25         if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) {
  26             continue;
  27         }
  28
  29         /* this checks to see that the subroutine is actually from our package  */
  30         if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
  31             if ( strNE(cvpkg_name, class_name_pv) ) {
  32                 continue;
  33             }
  34         }
  35
  36         method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
  37         if ( SvOK(method_slot) ) {
  38             SV *body;
  39
  40             if ( sv_isobject(method_slot) ) {
  41                 body = mop_call0(aTHX_ method_slot, KEY_FOR(body)); /* $method_object->body() */
  42             }
  43             else {
  44                 body = method_slot;
  45             }
  46
  47             if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) {
  48                 continue;
  49             }
  50             else {
  51                 /* $map->{$method_name} = undef */
  52                 sv_setsv(method_slot, &PL_sv_undef);
  53             }
  54         }
  55     }
  56 }
  57
  58 MODULE = Class::MOP::Mixin::HasMethods   PACKAGE = Class::MOP::Mixin::HasMethods
  59
  60 PROTOTYPES: DISABLE
  61
  62 void
  63 _method_map(self)
  64     SV *self
  65     PREINIT:
  66         HV *const obj        = (HV *)SvRV(self);
  67         SV *const class_name = HeVAL( hv_fetch_ent(obj, KEY_FOR(package), 0, HASH_FOR(package)) );
  68         HV *const stash      = gv_stashsv(class_name, 0);
  69         UV current;
  70         SV *cache_flag;
  71         SV *map_ref;
  72     PPCODE:
  73         if (!stash) {
  74              mXPUSHs(newRV_noinc((SV *)newHV()));
  75              return;
  76         }
  77
  78         current    = mop_check_package_cache_flag(aTHX_ stash);
  79         cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag)));
  80         map_ref    = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods)));
  81
  82         /* $self->{methods} does not yet exist (or got deleted) */
  83         if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) {
  84             SV *new_map_ref = newRV_noinc((SV *)newHV());
  85             sv_2mortal(new_map_ref);
  86             sv_setsv(map_ref, new_map_ref);
  87         }
  88
  89         if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) {
  90             mop_update_method_map(aTHX_ self, class_name, stash, (HV *)SvRV(map_ref));
  91             sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */
  92         }
  93
  94         XPUSHs(map_ref);
  95
  96 BOOT:
  97     mop_method_metaclass     = newSVpvs("method_metaclass");
  98     mop_associated_metaclass = newSVpvs("associated_metaclass");
  99     mop_wrap                 = newSVpvs("wrap");