Commit | Line | Data |
982b6f24 |
1 | |
d846ade3 |
2 | #include "mop.h" |
3 | |
e2e116c2 |
4 | static void |
5 | mop_deconstruct_variable_name(pTHX_ SV* const variable, |
6 | const char** const var_name, STRLEN* const var_name_len, |
7 | svtype* const type, |
9742ab2a |
8 | const char** const type_name) { |
e2e116c2 |
9 | |
e170f134 |
10 | |
4beb9a9a |
11 | if(SvROK(variable) && SvTYPE(SvRV(variable)) == SVt_PVHV){ |
12 | /* e.g. variable = { type => "SCALAR", name => "foo" } */ |
13 | HV* const hv = (HV*)SvRV(variable); |
14 | SV** svp; |
15 | STRLEN len; |
16 | const char* pv; |
17 | |
18 | svp = hv_fetchs(hv, "name", FALSE); |
19 | if(!(svp && SvOK(*svp))){ |
20 | croak("You must pass a variable name"); |
21 | } |
22 | *var_name = SvPV_const(*svp, len); |
23 | *var_name_len = len; |
24 | if(len < 1){ |
25 | croak("You must pass a variable name"); |
26 | } |
27 | |
28 | svp = hv_fetchs(hv, "type", FALSE); |
29 | if(!(svp && SvOK(*svp))) { |
30 | croak("You must pass a variable type"); |
31 | } |
32 | pv = SvPV_nolen_const(*svp); |
33 | if(strEQ(pv, "SCALAR")){ |
34 | *type = SVt_PV; /* for all the type of scalars */ |
35 | } |
36 | else if(strEQ(pv, "ARRAY")){ |
37 | *type = SVt_PVAV; |
38 | } |
39 | else if(strEQ(pv, "HASH")){ |
40 | *type = SVt_PVHV; |
41 | } |
42 | else if(strEQ(pv, "CODE")){ |
43 | *type = SVt_PVCV; |
44 | } |
45 | else if(strEQ(pv, "GLOB")){ |
46 | *type = SVt_PVGV; |
47 | } |
48 | else if(strEQ(pv, "IO")){ |
49 | *type = SVt_PVIO; |
50 | } |
51 | else{ |
52 | croak("I do not recognize that type '%s'", pv); |
53 | } |
54 | *type_name = pv; |
55 | } |
56 | else { |
57 | STRLEN len; |
58 | const char* pv; |
59 | /* e.g. variable = '$foo' */ |
60 | if(!SvOK(variable)) { |
61 | croak("You must pass a variable name"); |
62 | } |
63 | pv = SvPV_const(variable, len); |
64 | if(len < 2){ |
65 | croak("You must pass a variable name including a sigil"); |
66 | } |
67 | |
68 | *var_name = pv + 1; |
69 | *var_name_len = len - 1; |
70 | |
71 | switch(pv[0]){ |
72 | case '$': |
73 | *type = SVt_PV; /* for all the types of scalars */ |
74 | *type_name = "SCALAR"; |
75 | break; |
76 | case '@': |
77 | *type = SVt_PVAV; |
78 | *type_name = "ARRAY"; |
79 | break; |
80 | case '%': |
81 | *type = SVt_PVHV; |
82 | *type_name = "HASH"; |
83 | break; |
84 | case '&': |
85 | *type = SVt_PVCV; |
86 | *type_name = "CODE"; |
87 | break; |
88 | case '*': |
89 | *type = SVt_PVGV; |
90 | *type_name = "GLOB"; |
91 | break; |
92 | default: |
93 | croak("I do not recognize that sigil '%c'", pv[0]); |
94 | } |
95 | } |
e170f134 |
96 | } |
97 | |
9742ab2a |
98 | static GV* |
99 | mop_get_gv(pTHX_ SV* const self, svtype const type, const char* const var_name, I32 const var_name_len, I32 const flags){ |
4beb9a9a |
100 | SV* package_name; |
101 | |
102 | if(!(flags & ~GV_NOADD_MASK)){ /* for shortcut fetching */ |
103 | SV* const ns = mop_call0(aTHX_ self, mop_namespace); |
104 | GV** gvp; |
105 | if(!(SvROK(ns) && SvTYPE(SvRV(ns)) == SVt_PVHV)){ |
106 | croak("namespace() did not return a hash reference"); |
107 | } |
108 | gvp = (GV**)hv_fetch((HV*)SvRV(ns), var_name, var_name_len, FALSE); |
109 | if(gvp && isGV_with_GP(*gvp)){ |
110 | return *gvp; |
111 | } |
112 | } |
113 | |
114 | package_name = mop_call0(aTHX_ self, KEY_FOR(name)); |
115 | |
116 | if(!SvOK(package_name)){ |
117 | croak("name() did not return a defined value"); |
118 | } |
119 | |
120 | return gv_fetchpv(Perl_form(aTHX_ "%"SVf"::%s", package_name, var_name), flags, type); |
9742ab2a |
121 | } |
122 | |
123 | static SV* |
124 | mop_gv_elem(pTHX_ GV* const gv, svtype const type, I32 const add){ |
4beb9a9a |
125 | SV* sv; |
126 | |
127 | if(!gv){ |
128 | return NULL; |
129 | } |
130 | |
131 | assert(isGV_with_GP(gv)); |
132 | |
133 | switch(type){ |
134 | case SVt_PVAV: |
135 | sv = (SV*)(add ? GvAVn(gv) : GvAV(gv)); |
136 | break; |
137 | case SVt_PVHV: |
138 | sv = (SV*)(add ? GvHVn(gv) : GvHV(gv)); |
139 | break; |
140 | case SVt_PVCV: |
141 | sv = (SV*)GvCV(gv); |
142 | break; |
143 | case SVt_PVIO: |
144 | sv = (SV*)(add ? GvIOn(gv) : GvIO(gv)); |
145 | break; |
146 | case SVt_PVGV: |
147 | sv = (SV*)gv; |
148 | break; |
149 | default: /* SCALAR */ |
150 | sv = add ? GvSVn(gv) : GvSV(gv); |
151 | break; |
152 | } |
153 | |
154 | return sv; |
9742ab2a |
155 | } |
156 | |
157 | |
c8fd7a1e |
158 | static void |
b1ff395f |
159 | mop_update_method_map(pTHX_ SV *const self, SV *const class_name, HV *const stash, HV *const map) |
160 | { |
161 | const char *const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */ |
162 | SV *method_metaclass_name; |
163 | char *method_name; |
164 | I32 method_name_len; |
165 | SV *coderef; |
166 | HV *symbols; |
167 | dSP; |
168 | |
169 | symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE); |
170 | sv_2mortal((SV*)symbols); |
171 | (void)hv_iterinit(symbols); |
172 | while ( (coderef = hv_iternextsv(symbols, &method_name, &method_name_len)) ) { |
173 | CV *cv = (CV *)SvRV(coderef); |
174 | char *cvpkg_name; |
175 | char *cv_name; |
176 | SV *method_slot; |
177 | SV *method_object; |
178 | |
179 | if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) { |
180 | continue; |
181 | } |
182 | |
183 | /* this checks to see that the subroutine is actually from our package */ |
184 | if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) { |
185 | if ( strNE(cvpkg_name, class_name_pv) ) { |
186 | continue; |
187 | } |
188 | } |
189 | |
190 | method_slot = *hv_fetch(map, method_name, method_name_len, TRUE); |
191 | if ( SvOK(method_slot) ) { |
192 | SV *const body = mop_call0(aTHX_ method_slot, KEY_FOR(body)); /* $method_object->body() */ |
193 | if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) { |
194 | continue; |
195 | } |
196 | } |
197 | |
198 | method_metaclass_name = mop_call0(aTHX_ self, mop_method_metaclass); /* $self->method_metaclass() */ |
199 | |
200 | /* |
201 | $method_object = $method_metaclass->wrap( |
202 | $cv, |
203 | associated_metaclass => $self, |
204 | package_name => $class_name, |
205 | name => $method_name |
206 | ); |
207 | */ |
208 | ENTER; |
209 | SAVETMPS; |
210 | |
211 | PUSHMARK(SP); |
212 | EXTEND(SP, 8); |
213 | PUSHs(method_metaclass_name); /* invocant */ |
214 | mPUSHs(newRV_inc((SV *)cv)); |
215 | PUSHs(mop_associated_metaclass); |
216 | PUSHs(self); |
217 | PUSHs(KEY_FOR(package_name)); |
218 | PUSHs(class_name); |
219 | PUSHs(KEY_FOR(name)); |
220 | mPUSHs(newSVpv(method_name, method_name_len)); |
221 | PUTBACK; |
222 | |
223 | call_sv(mop_wrap, G_SCALAR | G_METHOD); |
224 | SPAGAIN; |
225 | method_object = POPs; |
226 | PUTBACK; |
227 | /* $map->{$method_name} = $method_object */ |
228 | sv_setsv(method_slot, method_object); |
229 | |
230 | FREETMPS; |
231 | LEAVE; |
232 | } |
233 | } |
234 | |
d846ade3 |
235 | MODULE = Class::MOP::Package PACKAGE = Class::MOP::Package |
236 | |
237 | PROTOTYPES: DISABLE |
238 | |
239 | void |
240 | get_all_package_symbols(self, filter=TYPE_FILTER_NONE) |
241 | SV *self |
242 | type_filter_t filter |
243 | PREINIT: |
244 | HV *stash = NULL; |
245 | HV *symbols = NULL; |
246 | register HE *he; |
247 | PPCODE: |
248 | if ( ! SvROK(self) ) { |
249 | die("Cannot call get_all_package_symbols as a class method"); |
250 | } |
251 | |
252 | if (GIMME_V == G_VOID) { |
253 | XSRETURN_EMPTY; |
254 | } |
255 | |
256 | PUTBACK; |
257 | |
22932438 |
258 | if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) { |
d846ade3 |
259 | stash = gv_stashsv(HeVAL(he), 0); |
260 | } |
261 | |
262 | |
263 | if (!stash) { |
264 | XSRETURN_UNDEF; |
265 | } |
266 | |
e1f52a8a |
267 | symbols = mop_get_all_package_symbols(stash, filter); |
d846ade3 |
268 | PUSHs(sv_2mortal(newRV_noinc((SV *)symbols))); |
269 | |
b1ff395f |
270 | void |
271 | get_method_map(self) |
272 | SV *self |
273 | PREINIT: |
274 | HV *const obj = (HV *)SvRV(self); |
275 | SV *const class_name = HeVAL( hv_fetch_ent(obj, KEY_FOR(package), 0, HASH_FOR(package)) ); |
276 | HV *const stash = gv_stashsv(class_name, 0); |
277 | UV current; |
278 | SV *cache_flag; |
279 | SV *map_ref; |
280 | PPCODE: |
281 | if (!stash) { |
282 | mXPUSHs(newRV_noinc((SV *)newHV())); |
283 | return; |
284 | } |
285 | |
286 | current = mop_check_package_cache_flag(aTHX_ stash); |
287 | cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag))); |
288 | map_ref = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods))); |
289 | |
290 | /* $self->{methods} does not yet exist (or got deleted) */ |
291 | if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) { |
292 | SV *new_map_ref = newRV_noinc((SV *)newHV()); |
293 | sv_2mortal(new_map_ref); |
294 | sv_setsv(map_ref, new_map_ref); |
295 | } |
296 | |
297 | if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) { |
298 | mop_update_method_map(aTHX_ self, class_name, stash, (HV *)SvRV(map_ref)); |
299 | sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */ |
300 | } |
301 | |
302 | XPUSHs(map_ref); |
303 | |
7ec7b950 |
304 | BOOT: |
305 | INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package); |
e170f134 |
306 | |
e2e116c2 |
307 | |
e170f134 |
308 | SV* |
309 | add_package_symbol(SV* self, SV* variable, SV* ref = &PL_sv_undef) |
310 | PREINIT: |
4beb9a9a |
311 | svtype type; |
312 | const char* type_name; |
313 | const char* var_name; |
314 | STRLEN var_name_len; |
315 | GV* gv; |
e170f134 |
316 | CODE: |
4beb9a9a |
317 | mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name); |
318 | gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, GV_ADDMULTI); |
319 | |
320 | if(SvOK(ref)){ /* add_package_symbol with a value */ |
321 | if(type == SVt_PV){ |
322 | if(!SvROK(ref)){ |
323 | ref = newRV_noinc(newSVsv(ref)); |
324 | sv_2mortal(ref); |
325 | } |
326 | } |
327 | else if(!(SvROK(ref) && SvTYPE(SvRV(ref)) == type)){ |
328 | croak("You must pass a reference of %s for the value of %s", type_name, GvNAME(CvGV(cv))); |
329 | } |
330 | |
331 | if(type == SVt_PVCV && GvCV(gv)){ |
332 | /* XXX: clear it before redefinition */ |
333 | SvREFCNT_dec(GvCV(gv)); |
334 | GvCV(gv) = NULL; |
335 | } |
336 | sv_setsv_mg((SV*)gv, ref); /* magical assignment into type glob (*glob = $ref) */ |
337 | |
338 | if(type == SVt_PVCV){ /* name a subroutine */ |
339 | CV* const subr = (CV*)SvRV(ref); |
340 | if(CvANON(subr) |
341 | && CvGV(subr) |
342 | && isGV(CvGV(subr)) |
343 | && strEQ(GvNAME(CvGV(subr)), "__ANON__")){ |
344 | |
345 | CvGV(subr) = gv; |
346 | CvANON_off(subr); |
347 | } |
348 | } |
349 | RETVAL = ref; |
350 | SvREFCNT_inc_simple_void_NN(ref); |
351 | } |
352 | else{ |
353 | SV* const sv = mop_gv_elem(aTHX_ gv, type, GV_ADDMULTI); |
354 | RETVAL = (sv && GIMME_V != G_VOID) ? newRV_inc(sv) : &PL_sv_undef; |
355 | } |
9742ab2a |
356 | OUTPUT: |
4beb9a9a |
357 | RETVAL |
982b6f24 |
358 | |
9742ab2a |
359 | bool |
360 | has_package_symbol(SV* self, SV* variable) |
361 | PREINIT: |
4beb9a9a |
362 | svtype type; |
363 | const char* type_name; |
364 | const char* var_name; |
365 | STRLEN var_name_len; |
366 | GV* gv; |
9742ab2a |
367 | CODE: |
4beb9a9a |
368 | mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name); |
369 | gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, 0); |
370 | RETVAL = mop_gv_elem(aTHX_ gv, type, FALSE) ? TRUE : FALSE; |
9742ab2a |
371 | OUTPUT: |
4beb9a9a |
372 | RETVAL |
e170f134 |
373 | |
9742ab2a |
374 | SV* |
375 | get_package_symbol(SV* self, SV* variable, ...) |
376 | PREINIT: |
4beb9a9a |
377 | svtype type; |
378 | const char* type_name; |
379 | const char* var_name; |
380 | STRLEN var_name_len; |
381 | I32 flags = 0; |
382 | GV* gv; |
383 | SV* sv; |
9742ab2a |
384 | CODE: |
b1f957d2 |
385 | if(items > 2){ /* parse options */ |
4beb9a9a |
386 | I32 i; |
387 | if((items % 2) != 0){ |
388 | croak("Odd number of arguments for get_package_symbol()"); |
389 | } |
390 | for(i = 2; i < items; i += 2){ |
391 | SV* const opt = ST(i); |
392 | SV* const val = ST(i+1); |
393 | if(strEQ(SvPV_nolen_const(opt), "create")){ |
394 | if(SvTRUE(val)){ |
395 | flags |= GV_ADDMULTI; |
396 | } |
397 | else{ |
398 | flags &= ~GV_ADDMULTI; |
399 | } |
400 | } |
401 | else{ |
402 | warn("Unknown option \"%"SVf"\" for get_package_symbol()", opt); |
403 | } |
404 | } |
405 | } |
406 | mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name); |
407 | gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, flags); |
408 | sv = mop_gv_elem(aTHX_ gv, type, FALSE); |
409 | |
410 | RETVAL = sv ? newRV_inc(sv) : &PL_sv_undef; |
9742ab2a |
411 | OUTPUT: |
4beb9a9a |
412 | RETVAL |