xs/Package.xs

   1 #include "mop.h"
   2
   3 static void
   4 mop_update_method_map(pTHX_ SV *const self, SV *const class_name, HV *const stash, HV *const map)
   5 {
   6     const char *const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */
   7     SV   *method_metaclass_name;
   8     char *method_name;
   9     I32   method_name_len;
  10     SV   *coderef;
  11     HV   *symbols;
  12     dSP;
  13
  14     symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE);
  15     sv_2mortal((SV*)symbols);
  16     (void)hv_iterinit(symbols);
  17     while ( (coderef = hv_iternextsv(symbols, &method_name, &method_name_len)) ) {
  18         CV *cv = (CV *)SvRV(coderef);
  19         char *cvpkg_name;
  20         char *cv_name;
  21         SV *method_slot;
  22         SV *method_object;
  23
  24         if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) {
  25             continue;
  26         }
  27
  28         /* this checks to see that the subroutine is actually from our package  */
  29         if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
  30             if ( strNE(cvpkg_name, class_name_pv) ) {
  31                 continue;
  32             }
  33         }
  34
  35         method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
  36         if ( SvOK(method_slot) ) {
  37             SV *body;
  38
  39             if ( sv_isobject(method_slot) ) {
  40                 body = mop_call0(aTHX_ method_slot, KEY_FOR(body)); /* $method_object->body() */
  41             }
  42             else {
  43                 body = method_slot;
  44             }
  45
  46             if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) {
  47                 continue;
  48             }
  49         }
  50
  51         method_metaclass_name = mop_call0(aTHX_ self, mop_method_metaclass); /* $self->method_metaclass() */
  52
  53         /*
  54             $method_object = $method_metaclass->wrap(
  55                 $cv,
  56                 associated_metaclass => $self,
  57                 package_name         => $class_name,
  58                 name                 => $method_name
  59             );
  60         */
  61         ENTER;
  62         SAVETMPS;
  63
  64         PUSHMARK(SP);
  65         EXTEND(SP, 8);
  66         PUSHs(method_metaclass_name); /* invocant */
  67         mPUSHs(newRV_inc((SV *)cv));
  68         PUSHs(mop_associated_metaclass);
  69         PUSHs(self);
  70         PUSHs(KEY_FOR(package_name));
  71         PUSHs(class_name);
  72         PUSHs(KEY_FOR(name));
  73         mPUSHs(newSVpv(method_name, method_name_len));
  74         PUTBACK;
  75
  76         call_sv(mop_wrap, G_SCALAR | G_METHOD);
  77         SPAGAIN;
  78         method_object = POPs;
  79         PUTBACK;
  80         /* $map->{$method_name} = $method_object */
  81         sv_setsv(method_slot, method_object);
  82
  83         FREETMPS;
  84         LEAVE;
  85     }
  86 }
  87
  88 MODULE = Class::MOP::Package   PACKAGE = Class::MOP::Package
  89
  90 PROTOTYPES: DISABLE
  91
  92 void
  93 get_all_package_symbols(self, filter=TYPE_FILTER_NONE)
  94     SV *self
  95     type_filter_t filter
  96     PREINIT:
  97         HV *stash = NULL;
  98         HV *symbols = NULL;
  99         register HE *he;
 100     PPCODE:
 101         if ( ! SvROK(self) ) {
 102             die("Cannot call get_all_package_symbols as a class method");
 103         }
 104
 105         if (GIMME_V == G_VOID) {
 106             XSRETURN_EMPTY;
 107         }
 108
 109         PUTBACK;
 110
 111         if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) {
 112             stash = gv_stashsv(HeVAL(he), 0);
 113         }
 114
 115
 116         if (!stash) {
 117             XSRETURN_UNDEF;
 118         }
 119
 120         symbols = mop_get_all_package_symbols(stash, filter);
 121         PUSHs(sv_2mortal(newRV_noinc((SV *)symbols)));
 122
 123 void
 124 _full_method_map(self)
 125     SV *self
 126     PREINIT:
 127         HV *const obj        = (HV *)SvRV(self);
 128         SV *const class_name = HeVAL( hv_fetch_ent(obj, KEY_FOR(package), 0, HASH_FOR(package)) );
 129         HV *const stash      = gv_stashsv(class_name, 0);
 130         UV current;
 131         SV *cache_flag;
 132         SV *map_ref;
 133     PPCODE:
 134         if (!stash) {
 135              mXPUSHs(newRV_noinc((SV *)newHV()));
 136              return;
 137         }
 138
 139         current    = mop_check_package_cache_flag(aTHX_ stash);
 140         cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag)));
 141         map_ref    = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods)));
 142
 143         /* $self->{methods} does not yet exist (or got deleted) */
 144         if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) {
 145             SV *new_map_ref = newRV_noinc((SV *)newHV());
 146             sv_2mortal(new_map_ref);
 147             sv_setsv(map_ref, new_map_ref);
 148         }
 149
 150         if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) {
 151             mop_update_method_map(aTHX_ self, class_name, stash, (HV *)SvRV(map_ref));
 152             sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */
 153         }
 154
 155         XPUSHs(map_ref);
 156
 157 BOOT:
 158     INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package);