Commit | Line | Data |
982b6f24 |
1 | |
d846ade3 |
2 | #include "mop.h" |
3 | |
982b6f24 |
4 | #define GLOB_CREATE 0x01 |
5 | #define VARIABLE_CREATE 0x02 |
6 | |
7 | |
e2e116c2 |
8 | static void |
9 | mop_deconstruct_variable_name(pTHX_ SV* const variable, |
10 | const char** const var_name, STRLEN* const var_name_len, |
11 | svtype* const type, |
12 | const char** const type_name, |
13 | I32* const flags) { |
14 | |
e170f134 |
15 | |
16 | if(SvROK(variable) && SvTYPE(SvRV(variable)) == SVt_PVHV){ |
17 | /* e.g. variable = { type => "SCALAR", name => "foo" } */ |
18 | HV* const hv = (HV*)SvRV(variable); |
19 | SV** svp; |
20 | STRLEN len; |
21 | const char* pv; |
22 | |
23 | svp = hv_fetchs(hv, "name", FALSE); |
24 | if(!(svp && SvOK(*svp))){ |
25 | croak("You must pass a variable name"); |
26 | } |
e2e116c2 |
27 | *var_name = SvPV_const(*svp, len); |
28 | *var_name_len = len; |
e170f134 |
29 | if(len < 1){ |
30 | croak("You must pass a variable name"); |
31 | } |
32 | |
33 | svp = hv_fetchs(hv, "type", FALSE); |
34 | if(!(svp && SvOK(*svp))) { |
35 | croak("You must pass a variable type"); |
36 | } |
37 | pv = SvPV_nolen_const(*svp); |
38 | if(strEQ(pv, "SCALAR")){ |
39 | *type = SVt_PV; /* for all the type of scalars */ |
40 | } |
41 | else if(strEQ(pv, "ARRAY")){ |
42 | *type = SVt_PVAV; |
43 | } |
44 | else if(strEQ(pv, "HASH")){ |
45 | *type = SVt_PVHV; |
46 | } |
47 | else if(strEQ(pv, "CODE")){ |
48 | *type = SVt_PVCV; |
49 | } |
50 | else if(strEQ(pv, "GLOB")){ |
51 | *type = SVt_PVGV; |
52 | } |
53 | else if(strEQ(pv, "IO")){ |
54 | *type = SVt_PVIO; |
55 | } |
56 | else{ |
57 | croak("I do not recognize that type '%s'", pv); |
58 | } |
59 | *type_name = pv; |
982b6f24 |
60 | |
61 | svp = hv_fetchs(hv, "create", FALSE); |
62 | if(svp && SvTRUE(*svp)){ |
63 | *flags = VARIABLE_CREATE | GLOB_CREATE; |
64 | } |
e170f134 |
65 | } |
66 | else { |
67 | STRLEN len; |
68 | const char* pv; |
69 | /* e.g. variable = '$foo' */ |
70 | if(!SvOK(variable)) { |
71 | croak("You must pass a variable name"); |
72 | } |
73 | pv = SvPV_const(variable, len); |
74 | if(len < 2){ |
75 | croak("You must pass a variable name including a sigil"); |
76 | } |
77 | |
e2e116c2 |
78 | *var_name = pv + 1; |
79 | *var_name_len = len - 1; |
80 | |
e170f134 |
81 | switch(pv[0]){ |
82 | case '$': |
83 | *type = SVt_PV; /* for all the types of scalars */ |
84 | *type_name = "SCALAR"; |
85 | break; |
86 | case '@': |
87 | *type = SVt_PVAV; |
88 | *type_name = "ARRAY"; |
89 | break; |
90 | case '%': |
91 | *type = SVt_PVHV; |
92 | *type_name = "HASH"; |
93 | break; |
94 | case '&': |
95 | *type = SVt_PVCV; |
96 | *type_name = "CODE"; |
97 | break; |
98 | case '*': |
99 | *type = SVt_PVGV; |
100 | *type_name = "GLOB"; |
101 | break; |
102 | default: |
103 | croak("I do not recognize that sigil '%c'", pv[0]); |
104 | } |
e170f134 |
105 | } |
e170f134 |
106 | } |
107 | |
d846ade3 |
108 | MODULE = Class::MOP::Package PACKAGE = Class::MOP::Package |
109 | |
110 | PROTOTYPES: DISABLE |
111 | |
112 | void |
113 | get_all_package_symbols(self, filter=TYPE_FILTER_NONE) |
114 | SV *self |
115 | type_filter_t filter |
116 | PREINIT: |
117 | HV *stash = NULL; |
118 | HV *symbols = NULL; |
119 | register HE *he; |
120 | PPCODE: |
121 | if ( ! SvROK(self) ) { |
122 | die("Cannot call get_all_package_symbols as a class method"); |
123 | } |
124 | |
125 | if (GIMME_V == G_VOID) { |
126 | XSRETURN_EMPTY; |
127 | } |
128 | |
129 | PUTBACK; |
130 | |
22932438 |
131 | if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) { |
d846ade3 |
132 | stash = gv_stashsv(HeVAL(he), 0); |
133 | } |
134 | |
135 | |
136 | if (!stash) { |
137 | XSRETURN_UNDEF; |
138 | } |
139 | |
e1f52a8a |
140 | symbols = mop_get_all_package_symbols(stash, filter); |
d846ade3 |
141 | PUSHs(sv_2mortal(newRV_noinc((SV *)symbols))); |
142 | |
7ec7b950 |
143 | BOOT: |
144 | INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package); |
e170f134 |
145 | |
982b6f24 |
146 | #define S_HAS GV_NOADD_NOINIT |
147 | #define S_GET 0 |
148 | #define S_ADD GV_ADDMULTI |
149 | |
e2e116c2 |
150 | |
e170f134 |
151 | SV* |
152 | add_package_symbol(SV* self, SV* variable, SV* ref = &PL_sv_undef) |
982b6f24 |
153 | ALIAS: |
154 | has_package_symbol = S_HAS |
155 | get_package_symbol = S_GET |
156 | add_package_symbol = S_ADD |
e170f134 |
157 | PREINIT: |
158 | svtype type; |
159 | const char* type_name; |
982b6f24 |
160 | const char* var_name; |
e2e116c2 |
161 | STRLEN var_name_len; |
162 | I32 flags = 0; |
163 | GV** gvp; |
164 | GV* gv; |
e170f134 |
165 | CODE: |
e2e116c2 |
166 | if(items == 3 && ix != S_ADD){ |
167 | croak("Too many arguments for %s", GvNAME(CvGV(cv))); |
168 | } |
169 | |
170 | mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name, &flags); |
e170f134 |
171 | |
e2e116c2 |
172 | |
173 | if(ix != S_ADD){ /* for shortcut fetching */ |
174 | SV* const ns = mop_call0(aTHX_ self, mop_namespace); |
175 | HV* stash; |
176 | if(!(SvROK(ns) && SvTYPE(SvRV(ns)) == SVt_PVHV)){ |
177 | croak("namespace() did not return a hash reference"); |
178 | } |
179 | stash = (HV*)SvRV(ns); |
180 | gvp = (GV**)hv_fetch(stash, var_name, var_name_len, FALSE); |
181 | } |
182 | else{ |
183 | gvp = NULL; |
e170f134 |
184 | } |
982b6f24 |
185 | |
e2e116c2 |
186 | if(gvp && isGV(*gvp)){ |
187 | gv = *gvp; |
982b6f24 |
188 | } |
e2e116c2 |
189 | else{ |
190 | SV* const package_name = mop_call0(aTHX_ self, KEY_FOR(name)); |
191 | const char* fq_name; |
e170f134 |
192 | |
e2e116c2 |
193 | if(!SvOK(package_name)){ |
194 | croak("name() did not return a defined value"); |
195 | } |
196 | fq_name = Perl_form(aTHX_ "%"SVf"::%s", package_name, var_name); |
982b6f24 |
197 | |
e2e116c2 |
198 | gv = gv_fetchpv(fq_name, ix | (flags & GLOB_CREATE ? GV_ADDMULTI : 0), type); |
199 | } |
200 | |
201 | |
202 | |
203 | if(SvOK(ref)){ /* add_package_symbol with a value */ |
e170f134 |
204 | if(type == SVt_PV){ |
205 | if(!SvROK(ref)){ |
206 | ref = newRV_noinc(newSVsv(ref)); |
207 | sv_2mortal(ref); |
208 | } |
209 | } |
210 | else if(!(SvROK(ref) && SvTYPE(SvRV(ref)) == type)){ |
211 | croak("You must pass a reference of %s for the value of %s", type_name, GvNAME(CvGV(cv))); |
212 | } |
e170f134 |
213 | |
214 | if(type == SVt_PVCV && GvCV(gv)){ |
215 | /* XXX: should introduce an option { redefine => 1 } ? */ |
216 | SvREFCNT_dec(GvCV(gv)); |
217 | GvCV(gv) = NULL; |
218 | } |
219 | sv_setsv_mg((SV*)gv, ref); /* *glob = $ref */ |
220 | RETVAL = ref; |
221 | } |
982b6f24 |
222 | else { /* no values */ |
e170f134 |
223 | SV* sv; |
224 | |
982b6f24 |
225 | if(!gv){ |
226 | if(ix == S_HAS){ |
227 | XSRETURN_NO; |
228 | } |
229 | else{ |
230 | XSRETURN_UNDEF; |
231 | } |
232 | } |
233 | |
234 | if(!isGV(gv)){ /* In has_package_symbol, the stash entry is a stub or constant */ |
235 | assert(ix == S_HAS); |
236 | if(type == SVt_PVCV){ |
237 | XSRETURN_YES; |
238 | } |
239 | else{ |
240 | XSRETURN_NO; |
241 | } |
242 | } |
243 | |
e170f134 |
244 | switch(type){ |
e170f134 |
245 | case SVt_PVAV: |
982b6f24 |
246 | sv = (SV*)((flags & VARIABLE_CREATE) ? GvAVn(gv) : GvAV(gv)); |
e170f134 |
247 | break; |
248 | case SVt_PVHV: |
982b6f24 |
249 | sv = (SV*)((flags & VARIABLE_CREATE) ? GvHVn(gv) : GvHV(gv)); |
e170f134 |
250 | break; |
251 | case SVt_PVCV: |
252 | sv = (SV*)GvCV(gv); |
253 | break; |
982b6f24 |
254 | case SVt_PVIO: |
255 | sv = (SV*)((flags & VARIABLE_CREATE) ? GvIOn(gv) : GvIO(gv)); |
256 | break; |
e170f134 |
257 | case SVt_PVGV: |
258 | sv = (SV*)gv; |
259 | break; |
982b6f24 |
260 | default: /* SCALAR */ |
261 | sv = (flags & VARIABLE_CREATE) ? GvSVn(gv) : GvSV(gv); |
e170f134 |
262 | break; |
263 | } |
264 | |
982b6f24 |
265 | if(ix == S_HAS){ |
266 | RETVAL = boolSV(sv); |
e170f134 |
267 | } |
268 | else{ |
982b6f24 |
269 | if(sv){ |
270 | RETVAL = sv_2mortal(newRV_inc(sv)); |
271 | } |
272 | else{ |
273 | RETVAL = &PL_sv_undef; |
274 | } |
e170f134 |
275 | } |
276 | } |
277 | ST(0) = RETVAL; |
278 | |