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