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     if (SvROK(sv) &&
 102       (tmpsv = (SV*) SvRV(sv)) &&
 103       SvTYPE(tmpsv) == SVt_PVMG &&
 104       (mg_find(tmpsv, PERL_MAGIC_qr)))
 105         return TRUE;
 106     return FALSE;
 107 }
 108 #endif
 109
 110 EXTERN_C XS(boot_Class__MOP);
 111 EXTERN_C XS(boot_Class__MOP__Mixin__HasAttributes);
 112 EXTERN_C XS(boot_Class__MOP__Mixin__HasMethods);
 113 EXTERN_C XS(boot_Class__MOP__Package);
 114 EXTERN_C XS(boot_Class__MOP__Mixin__AttributeCore);
 115 EXTERN_C XS(boot_Class__MOP__Method);
 116 EXTERN_C XS(boot_Class__MOP__Method__Inlined);
 117 EXTERN_C XS(boot_Class__MOP__Method__Generated);
 118 EXTERN_C XS(boot_Class__MOP__Class);
 119 EXTERN_C XS(boot_Class__MOP__Attribute);
 120 EXTERN_C XS(boot_Class__MOP__Instance);
 121
 122 MODULE = Moose  PACKAGE = Moose::Exporter
 123
 124 PROTOTYPES: DISABLE
 125
 126 BOOT:
 127     mop_prehash_keys();
 128
 129     MOP_CALL_BOOT (boot_Class__MOP);
 130     MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasAttributes);
 131     MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasMethods);
 132     MOP_CALL_BOOT (boot_Class__MOP__Package);
 133     MOP_CALL_BOOT (boot_Class__MOP__Mixin__AttributeCore);
 134     MOP_CALL_BOOT (boot_Class__MOP__Method);
 135     MOP_CALL_BOOT (boot_Class__MOP__Method__Inlined);
 136     MOP_CALL_BOOT (boot_Class__MOP__Method__Generated);
 137     MOP_CALL_BOOT (boot_Class__MOP__Class);
 138     MOP_CALL_BOOT (boot_Class__MOP__Attribute);
 139     MOP_CALL_BOOT (boot_Class__MOP__Instance);
 140
 141 void
 142 _flag_as_reexport (SV *sv)
 143     CODE:
 144         sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0);
 145
 146 bool
 147 _export_is_flagged (SV *sv)
 148     CODE:
 149         RETVAL = export_flag_is_set(aTHX_ sv);
 150     OUTPUT:
 151         RETVAL
 152
 153 MODULE = Moose  PACKAGE = Moose::Util::TypeConstraints::OptimizedConstraints
 154
 155 bool
 156 RegexpRef (SV *sv=NULL)
 157     INIT:
 158         if (!items)
 159             sv = DEFSV;
 160     CODE:
 161         RETVAL = SvRXOK(sv);
 162     OUTPUT:
 163         RETVAL