xs/Class.xs

   1 #include "mop.h"
   2
   3 NEEDS_KEY(name);
   4 NEEDS_KEY(body);
   5 NEEDS_KEY(methods);
   6 NEEDS_KEY(package);
   7 NEEDS_KEY(package_name);
   8 NEEDS_KEY(package_cache_flag);
   9
  10 static void
  11 mop_update_method_map(pTHX_ SV *const self, SV *const class_name, HV *const stash, HV *const map)
  12 {
  13     const char *const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */
  14     SV   *method_metaclass_name;
  15     char *method_name;
  16     I32   method_name_len;
  17     SV   *coderef;
  18     HV   *symbols;
  19     dSP;
  20
  21     symbols = get_all_package_symbols(stash, TYPE_FILTER_CODE);
  22
  23     (void)hv_iterinit(symbols);
  24     while ( (coderef = hv_iternextsv(symbols, &method_name, &method_name_len)) ) {
  25         CV *cv = (CV *)SvRV(coderef);
  26         char *cvpkg_name;
  27         char *cv_name;
  28         SV *method_slot;
  29         SV *method_object;
  30
  31         if (!get_code_info(coderef, &cvpkg_name, &cv_name)) {
  32             continue;
  33         }
  34
  35         /* this checks to see that the subroutine is actually from our package  */
  36         if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
  37             if ( strNE(cvpkg_name, class_name_pv) ) {
  38                 continue;
  39             }
  40         }
  41
  42         method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
  43         if ( SvOK(method_slot) ) {
  44             SV *const body = mop_call0(aTHX_ method_slot, key_body); /* $method_object->body() */
  45             if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) {
  46                 continue;
  47             }
  48         }
  49
  50         method_metaclass_name = mop_call0(aTHX_ self, method_metaclass); /* $self->method_metaclass() */
  51
  52         /*
  53             $method_object = $method_metaclass->wrap(
  54                 $cv,
  55                 associated_metaclass => $self,
  56                 package_name         => $class_name,
  57                 name                 => $method_name
  58             );
  59         */
  60         ENTER;
  61         SAVETMPS;
  62
  63         PUSHMARK(SP);
  64         EXTEND(SP, 8);
  65         PUSHs(method_metaclass_name); /* invocant */
  66         mPUSHs(newRV_inc((SV *)cv));
  67         PUSHs(associated_metaclass);
  68         PUSHs(self);
  69         PUSHs(key_package_name);
  70         PUSHs(class_name);
  71         PUSHs(key_name);
  72         mPUSHs(newSVpv(method_name, method_name_len));
  73         PUTBACK;
  74
  75         call_sv(wrap, G_SCALAR | G_METHOD);
  76         SPAGAIN;
  77         method_object = POPs;
  78         PUTBACK;
  79         /* $map->{$method_name} = $method_object */
  80         sv_setsv(method_slot, method_object);
  81
  82         FREETMPS;
  83         LEAVE;
  84     }
  85 }
  86
  87 MODULE = Class::MOP::Class    PACKAGE = Class::MOP::Class
  88
  89 PROTOTYPES: DISABLE
  90
  91 void
  92 get_method_map(self)
  93     SV *self
  94     PREINIT:
  95         HV *const obj        = (HV *)SvRV(self);
  96         SV *const class_name = HeVAL( hv_fetch_ent(obj, key_package, 0, hash_package) );
  97         HV *const stash      = gv_stashsv(class_name, 0);
  98         UV  const current    = mop_check_package_cache_flag(aTHX_ stash);
  99         SV *const cache_flag = HeVAL( hv_fetch_ent(obj, key_package_cache_flag, TRUE, hash_package_cache_flag));
 100         SV *const map_ref    = HeVAL( hv_fetch_ent(obj, key_methods, TRUE, hash_methods));
 101     PPCODE:
 102         /* in  $self->{methods} does not yet exist (or got deleted) */
 103         if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) {
 104             SV *new_map_ref = newRV_noinc((SV *)newHV());
 105             sv_2mortal(new_map_ref);
 106             sv_setsv(map_ref, new_map_ref);
 107         }
 108
 109         if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) {
 110             mop_update_method_map(aTHX_ self, class_name, stash, (HV *)SvRV(map_ref));
 111             sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */
 112         }
 113
 114         XPUSHs(map_ref);