Store the role which first defines an attribute, and pass that along when cloning.
[gitmo/Moose.git] / 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 PROTOTYPES: DISABLE
104
105 BOOT:
106     mop_prehash_keys();
107
108     MOP_CALL_BOOT (boot_Class__MOP);
109     MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasAttributes);
110     MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasMethods);
111     MOP_CALL_BOOT (boot_Class__MOP__Package);
112     MOP_CALL_BOOT (boot_Class__MOP__Mixin__AttributeCore);
113     MOP_CALL_BOOT (boot_Class__MOP__Method);
114     MOP_CALL_BOOT (boot_Class__MOP__Method__Inlined);
115     MOP_CALL_BOOT (boot_Class__MOP__Method__Generated);
116     MOP_CALL_BOOT (boot_Class__MOP__Class);
117     MOP_CALL_BOOT (boot_Class__MOP__Attribute);
118     MOP_CALL_BOOT (boot_Class__MOP__Instance);
119
120 void
121 _flag_as_reexport (SV *sv)
122     CODE:
123         sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0);
124
125 bool
126 _export_is_flagged (SV *sv)
127     CODE:
128         RETVAL = export_flag_is_set(aTHX_ sv);
129     OUTPUT:
130         RETVAL