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 #ifndef SvRXOK
  90 /* SvRXOK appeared before SVt_REGEXP did, so this implementation assumes magic
  91  * based qr//. Note re::is_regexp isn't in 5.8, hence the need for this XS.
  92  */
  93 #define SvRXOK(sv) is_regexp(aTHX_ sv)
  94
  95 STATIC int
  96 is_regexp (pTHX_ SV* sv) {
  97     SV* tmpsv;
  98
  99     if (SvMAGICAL(sv)) {
 100         mg_get(sv);
 101     }
 102
 103     if (SvROK(sv) &&
 104         (tmpsv = (SV*) SvRV(sv)) &&
 105         SvTYPE(tmpsv) == SVt_PVMG &&
 106         (mg_find(tmpsv, PERL_MAGIC_qr))) {
 107         return TRUE;
 108     }
 109
 110     return FALSE;
 111 }
 112 #endif
 113
 114 XS_EXTERNAL(boot_Class__MOP);
 115 XS_EXTERNAL(boot_Class__MOP__Mixin__HasAttributes);
 116 XS_EXTERNAL(boot_Class__MOP__Mixin__HasMethods);
 117 XS_EXTERNAL(boot_Class__MOP__Package);
 118 XS_EXTERNAL(boot_Class__MOP__Mixin__AttributeCore);
 119 XS_EXTERNAL(boot_Class__MOP__Method);
 120 XS_EXTERNAL(boot_Class__MOP__Method__Inlined);
 121 XS_EXTERNAL(boot_Class__MOP__Method__Generated);
 122 XS_EXTERNAL(boot_Class__MOP__Method__Overload);
 123 XS_EXTERNAL(boot_Class__MOP__Class);
 124 XS_EXTERNAL(boot_Class__MOP__Attribute);
 125 XS_EXTERNAL(boot_Class__MOP__Instance);
 126
 127 MODULE = Moose  PACKAGE = Moose::Exporter
 128
 129 PROTOTYPES: DISABLE
 130
 131 BOOT:
 132     mop_prehash_keys();
 133
 134     MOP_CALL_BOOT (boot_Class__MOP);
 135     MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasAttributes);
 136     MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasMethods);
 137     MOP_CALL_BOOT (boot_Class__MOP__Package);
 138     MOP_CALL_BOOT (boot_Class__MOP__Mixin__AttributeCore);
 139     MOP_CALL_BOOT (boot_Class__MOP__Method);
 140     MOP_CALL_BOOT (boot_Class__MOP__Method__Inlined);
 141     MOP_CALL_BOOT (boot_Class__MOP__Method__Generated);
 142     MOP_CALL_BOOT (boot_Class__MOP__Method__Overload);
 143     MOP_CALL_BOOT (boot_Class__MOP__Class);
 144     MOP_CALL_BOOT (boot_Class__MOP__Attribute);
 145     MOP_CALL_BOOT (boot_Class__MOP__Instance);
 146
 147 void
 148 _flag_as_reexport (SV *sv)
 149     CODE:
 150         sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0);
 151
 152 bool
 153 _export_is_flagged (SV *sv)
 154     CODE:
 155         RETVAL = export_flag_is_set(aTHX_ sv);
 156     OUTPUT:
 157         RETVAL
 158
 159 MODULE = Moose  PACKAGE = Moose::Util::TypeConstraints::Builtins
 160
 161 bool
 162 _RegexpRef (SV *sv=NULL)
 163     INIT:
 164         if (!items) {
 165             sv = DEFSV;
 166         }
 167     CODE:
 168         RETVAL = SvRXOK(sv);
 169     OUTPUT:
 170         RETVAL