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