Moose.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4 #include "ppport.h"
   5
   6 STATIC int unset_export_flag (pTHX_ SV *sv, MAGIC *mg);
   7
   8 STATIC MGVTBL export_flag_vtbl = {
   9     NULL, /* get */
  10     unset_export_flag, /* set */
  11     NULL, /* len */
  12     NULL, /* clear */
  13     NULL, /* free */
  14     NULL, /* copy */
  15     NULL, /* dup */
  16     NULL, /* local */
  17 };
  18
  19 STATIC bool
  20 export_flag_is_set (pTHX_ SV *sv)
  21 {
  22     MAGIC *mg, *moremagic;
  23
  24     if (SvTYPE(SvRV(sv)) != SVt_PVGV) {
  25         return 0;
  26     }
  27
  28     for (mg = SvMAGIC(SvRV(sv)); mg; mg = moremagic) {
  29         moremagic = mg->mg_moremagic;
  30
  31         if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &export_flag_vtbl) {
  32             break;
  33         }
  34     }
  35
  36     return !!mg;
  37 }
  38
  39 STATIC int
  40 unset_export_flag (pTHX_ SV *sv, MAGIC *mymg)
  41 {
  42     MAGIC *mg, *prevmagic = NULL, *moremagic = NULL;
  43
  44     for (mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) {
  45         moremagic = mg->mg_moremagic;
  46
  47         if (mg == mymg) {
  48             break;
  49         }
  50     }
  51
  52     if (!mg) {
  53         return 0;
  54     }
  55
  56     if (prevmagic) {
  57         prevmagic->mg_moremagic = moremagic;
  58     }
  59     else {
  60         SvMAGIC_set(sv, moremagic);
  61     }
  62
  63     mg->mg_moremagic = NULL;
  64
  65     Safefree (mg);
  66
  67     return 0;
  68 }
  69
  70 MODULE = Moose  PACKAGE = Moose::Exporter
  71
  72 void
  73 _flag_as_reexport (SV *sv)
  74     PROTOTYPE: \*
  75     CODE:
  76         sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0);
  77
  78 bool
  79 _export_is_flagged (SV *sv)
  80     PROTOTYPE: \*
  81     CODE:
  82         RETVAL = export_flag_is_set(aTHX_ sv);
  83     OUTPUT:
  84         RETVAL