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     SV   *method_metaclass_name;
  12     char *method_name;
  13     I32   method_name_len;
  14     SV   *coderef;
  15     HV   *symbols;
  16     dSP;
  17
  18     symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE);
  19     sv_2mortal((SV*)symbols);
  20     (void)hv_iterinit(symbols);
  21     while ( (coderef = hv_iternextsv(symbols, &method_name, &method_name_len)) ) {
  22         CV *cv = (CV *)SvRV(coderef);
  23         char *cvpkg_name;
  24         char *cv_name;
  25         SV *method_slot;
  26         SV *method_object;
  27
  28         if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) {
  29             continue;
  30         }
  31
  32         /* this checks to see that the subroutine is actually from our package  */
  33         if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
  34             if ( strNE(cvpkg_name, class_name_pv) ) {
  35                 continue;
  36             }
  37         }
  38
  39         method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
  40         if ( SvOK(method_slot) ) {
  41             SV *body;
  42
  43             if ( sv_isobject(method_slot) ) {
  44                 body = mop_call0(aTHX_ method_slot, KEY_FOR(body)); /* $method_object->body() */
  45             }
  46             else {
  47                 body = method_slot;
  48             }
  49
  50             if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) {
  51                 continue;
  52             }
  53         }
  54
  55         method_metaclass_name = mop_call0(aTHX_ self, mop_method_metaclass); /* $self->method_metaclass() */
  56
  57         /*
  58             $method_object = $method_metaclass->wrap(
  59                 $cv,
  60                 associated_metaclass => $self,
  61                 package_name         => $class_name,
  62                 name                 => $method_name
  63             );
  64         */
  65         ENTER;
  66         SAVETMPS;
  67
  68         PUSHMARK(SP);
  69         EXTEND(SP, 8);
  70         PUSHs(method_metaclass_name); /* invocant */
  71         mPUSHs(newRV_inc((SV *)cv));
  72         PUSHs(mop_associated_metaclass);
  73         PUSHs(self);
  74         PUSHs(KEY_FOR(package_name));
  75         PUSHs(class_name);
  76         PUSHs(KEY_FOR(name));
  77         mPUSHs(newSVpv(method_name, method_name_len));
  78         PUTBACK;
  79
  80         call_sv(mop_wrap, G_SCALAR | G_METHOD);
  81         SPAGAIN;
  82         method_object = POPs;
  83         PUTBACK;
  84         /* $map->{$method_name} = $method_object */
  85         sv_setsv(method_slot, method_object);
  86
  87         FREETMPS;
  88         LEAVE;
  89     }
  90 }
  91
  92 MODULE = Class::MOP::Mixin::HasMethods   PACKAGE = Class::MOP::Mixin::HasMethods
  93
  94 PROTOTYPES: DISABLE
  95
  96 void
  97 _full_method_map(self)
  98     SV *self
  99     PREINIT:
 100         HV *const obj        = (HV *)SvRV(self);
 101         SV *const class_name = HeVAL( hv_fetch_ent(obj, KEY_FOR(package), 0, HASH_FOR(package)) );
 102         HV *const stash      = gv_stashsv(class_name, 0);
 103         UV current;
 104         SV *cache_flag;
 105         SV *map_ref;
 106     PPCODE:
 107         if (!stash) {
 108              mXPUSHs(newRV_noinc((SV *)newHV()));
 109              return;
 110         }
 111
 112         current    = mop_check_package_cache_flag(aTHX_ stash);
 113         cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag)));
 114         map_ref    = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods)));
 115
 116         /* $self->{methods} does not yet exist (or got deleted) */
 117         if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) {
 118             SV *new_map_ref = newRV_noinc((SV *)newHV());
 119             sv_2mortal(new_map_ref);
 120             sv_setsv(map_ref, new_map_ref);
 121         }
 122
 123         if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) {
 124             mop_update_method_map(aTHX_ self, class_name, stash, (HV *)SvRV(map_ref));
 125             sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */
 126         }
 127
 128         XPUSHs(map_ref);
 129
 130 BOOT:
 131     mop_method_metaclass     = newSVpvs("method_metaclass");
 132     mop_associated_metaclass = newSVpvs("associated_metaclass");
 133     mop_wrap                 = newSVpvs("wrap");