xs/Moose.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4 #include "ppport.h"
   5 #include "mop.h"
   6
   7 #ifndef MGf_COPY
   8 # define MGf_COPY 0
   9 #endif
  10
  11 #ifndef MGf_DUP
  12 # define MGf_DUP 0
  13 #endif
  14
  15 #ifndef MGf_LOCAL
  16 # define MGf_LOCAL 0
  17 #endif
  18
  19 STATIC int unset_export_flag (pTHX_ SV *sv, MAGIC *mg);
  20
  21 STATIC MGVTBL export_flag_vtbl = {
  22     NULL, /* get */
  23     unset_export_flag, /* set */
  24     NULL, /* len */
  25     NULL, /* clear */
  26     NULL, /* free */
  27 #if MGf_COPY
  28     NULL, /* copy */
  29 #endif
  30 #if MGf_DUP
  31     NULL, /* dup */
  32 #endif
  33 #if MGf_LOCAL
  34     NULL, /* local */
  35 #endif
  36 };
  37
  38 STATIC bool
  39 export_flag_is_set (pTHX_ SV *sv)
  40 {
  41     MAGIC *mg, *moremagic;
  42
  43     if (SvTYPE(SvRV(sv)) != SVt_PVGV) {
  44         return 0;
  45     }
  46
  47     for (mg = SvMAGIC(SvRV(sv)); mg; mg = moremagic) {
  48         moremagic = mg->mg_moremagic;
  49
  50         if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &export_flag_vtbl) {
  51             break;
  52         }
  53     }
  54
  55     return !!mg;
  56 }
  57
  58 STATIC int
  59 unset_export_flag (pTHX_ SV *sv, MAGIC *mymg)
  60 {
  61     MAGIC *mg, *prevmagic = NULL, *moremagic = NULL;
  62
  63     for (mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) {
  64         moremagic = mg->mg_moremagic;
  65
  66         if (mg == mymg) {
  67             break;
  68         }
  69     }
  70
  71     if (!mg) {
  72         return 0;
  73     }
  74
  75     if (prevmagic) {
  76         prevmagic->mg_moremagic = moremagic;
  77     }
  78     else {
  79         SvMAGIC_set(sv, moremagic);
  80     }
  81
  82     mg->mg_moremagic = NULL;
  83
  84     Safefree (mg);
  85
  86     return 0;
  87 }
  88
  89 EXTERN_C XS(boot_Class__MOP);
  90 EXTERN_C XS(boot_Class__MOP__Mixin__HasAttributes);
  91 EXTERN_C XS(boot_Class__MOP__Mixin__HasMethods);
  92 EXTERN_C XS(boot_Class__MOP__Package);
  93 EXTERN_C XS(boot_Class__MOP__Mixin__AttributeCore);
  94 EXTERN_C XS(boot_Class__MOP__Method);
  95 EXTERN_C XS(boot_Class__MOP__Method__Inlined);
  96 EXTERN_C XS(boot_Class__MOP__Method__Generated);
  97 EXTERN_C XS(boot_Class__MOP__Class);
  98 EXTERN_C XS(boot_Class__MOP__Attribute);
  99 EXTERN_C XS(boot_Class__MOP__Instance);
 100
 101 MODULE = Moose  PACKAGE = Moose::Exporter
 102
 103 BOOT:
 104     mop_prehash_keys();
 105
 106     MOP_CALL_BOOT (boot_Class__MOP);
 107     MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasAttributes);
 108     MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasMethods);
 109     MOP_CALL_BOOT (boot_Class__MOP__Package);
 110     MOP_CALL_BOOT (boot_Class__MOP__Mixin__AttributeCore);
 111     MOP_CALL_BOOT (boot_Class__MOP__Method);
 112     MOP_CALL_BOOT (boot_Class__MOP__Method__Inlined);
 113     MOP_CALL_BOOT (boot_Class__MOP__Method__Generated);
 114     MOP_CALL_BOOT (boot_Class__MOP__Class);
 115     MOP_CALL_BOOT (boot_Class__MOP__Attribute);
 116     MOP_CALL_BOOT (boot_Class__MOP__Instance);
 117
 118 void
 119 _flag_as_reexport (SV *sv)
 120     CODE:
 121         sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0);
 122
 123 bool
 124 _export_is_flagged (SV *sv)
 125     CODE:
 126         RETVAL = export_flag_is_set(aTHX_ sv);
 127     OUTPUT:
 128         RETVAL