1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #define NEED_SvRX
6 #include "ppport.h"
7
8 #include "mop.h"
9
10 #ifndef MGf_COPY
11 # define MGf_COPY 0
12 #endif
13
14 #ifndef MGf_DUP
15 # define MGf_DUP 0
16 #endif
17
18 #ifndef MGf_LOCAL
19 # define MGf_LOCAL 0
20 #endif
21
22 STATIC int unset_export_flag (pTHX_ SV *sv, MAGIC *mg);
23
24 STATIC MGVTBL export_flag_vtbl = {
25 NULL, /* get */
26 unset_export_flag, /* set */
27 NULL, /* len */
28 NULL, /* clear */
29 NULL, /* free */
30 #if MGf_COPY
31 NULL, /* copy */
32 #endif
33 #if MGf_DUP
34 NULL, /* dup */
35 #endif
36 #if MGf_LOCAL
37 NULL, /* local */
38 #endif
39 };
40
41 STATIC bool
export_flag_is_set(pTHX_ SV * sv)42 export_flag_is_set (pTHX_ SV *sv)
43 {
44 MAGIC *mg, *moremagic;
45
46 if (SvTYPE(SvRV(sv)) != SVt_PVGV) {
47 return 0;
48 }
49
50 for (mg = SvMAGIC(SvRV(sv)); mg; mg = moremagic) {
51 moremagic = mg->mg_moremagic;
52
53 if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &export_flag_vtbl) {
54 break;
55 }
56 }
57
58 return !!mg;
59 }
60
61 STATIC int
unset_export_flag(pTHX_ SV * sv,MAGIC * mymg)62 unset_export_flag (pTHX_ SV *sv, MAGIC *mymg)
63 {
64 MAGIC *mg, *prevmagic = NULL, *moremagic = NULL;
65
66 for (mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) {
67 moremagic = mg->mg_moremagic;
68
69 if (mg == mymg) {
70 break;
71 }
72 }
73
74 if (!mg) {
75 return 0;
76 }
77
78 if (prevmagic) {
79 prevmagic->mg_moremagic = moremagic;
80 }
81 else {
82 SvMAGIC_set(sv, moremagic);
83 }
84
85 mg->mg_moremagic = NULL;
86
87 Safefree (mg);
88
89 return 0;
90 }
91
92 XS_EXTERNAL(boot_Class__MOP);
93 XS_EXTERNAL(boot_Class__MOP__Mixin__HasAttributes);
94 XS_EXTERNAL(boot_Class__MOP__Mixin__HasMethods);
95 XS_EXTERNAL(boot_Class__MOP__Package);
96 XS_EXTERNAL(boot_Class__MOP__Mixin__AttributeCore);
97 XS_EXTERNAL(boot_Class__MOP__Method);
98 XS_EXTERNAL(boot_Class__MOP__Method__Inlined);
99 XS_EXTERNAL(boot_Class__MOP__Method__Generated);
100 XS_EXTERNAL(boot_Class__MOP__Class);
101 XS_EXTERNAL(boot_Class__MOP__Attribute);
102 XS_EXTERNAL(boot_Class__MOP__Instance);
103 XS_EXTERNAL(boot_Moose__Meta__Role__Application__ToInstance);
104
105 MODULE = Moose PACKAGE = Moose::Exporter
106
107 PROTOTYPES: DISABLE
108
109 BOOT:
110 mop_prehash_keys();
111
112 MOP_CALL_BOOT (boot_Class__MOP);
113 MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasAttributes);
114 MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasMethods);
115 MOP_CALL_BOOT (boot_Class__MOP__Package);
116 MOP_CALL_BOOT (boot_Class__MOP__Mixin__AttributeCore);
117 MOP_CALL_BOOT (boot_Class__MOP__Method);
118 MOP_CALL_BOOT (boot_Class__MOP__Method__Inlined);
119 MOP_CALL_BOOT (boot_Class__MOP__Method__Generated);
120 MOP_CALL_BOOT (boot_Class__MOP__Class);
121 MOP_CALL_BOOT (boot_Class__MOP__Attribute);
122 MOP_CALL_BOOT (boot_Class__MOP__Instance);
123 MOP_CALL_BOOT (boot_Moose__Meta__Role__Application__ToInstance);
124
125 void
126 _flag_as_reexport (SV *sv)
127 CODE:
128 sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0);
129
130 bool
131 _export_is_flagged (SV *sv)
132 CODE:
133 RETVAL = export_flag_is_set(aTHX_ sv);
134 OUTPUT:
135 RETVAL
136
137 MODULE = Moose PACKAGE = Moose::Util::TypeConstraints::Builtins
138
139 bool
140 _RegexpRef (SV *sv=NULL)
141 INIT:
142 if (!items) {
143 sv = DEFSV;
144 }
145 CODE:
146 RETVAL = SvRXOK(sv);
147 OUTPUT:
148 RETVAL
149