Commit | Line | Data |
59017825 |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
4 | |
dfabcbae |
5 | #define NEED_newRV_noinc |
6 | #define NEED_sv_2pv_flags |
7 | #include "ppport.h" |
8 | |
13f8a7b7 |
9 | #ifndef gv_fetchsv |
10 | #define gv_fetchsv(n,f,t) gv_fetchpv(SvPV_nolen(n), f, t) |
11 | #endif |
12 | |
13 | #ifndef mro_method_changed_in |
14 | #define mro_method_changed_in(x) PL_sub_generation++ |
15 | #endif |
16 | |
17 | #ifdef newSVhek |
18 | #define newSVhe(he) newSVhek(HeKEY_hek(he)) |
19 | #else |
3e37e315 |
20 | #define newSVhe(he) newSVpv(HePV(he, PL_na), 0) |
13f8a7b7 |
21 | #endif |
22 | |
23 | #ifndef savesvpv |
24 | #define savesvpv(s) savepv(SvPV_nolen(s)) |
25 | #endif |
26 | |
d551a208 |
27 | /* HACK: scalar slots are always populated on perl < 5.10, so treat undef |
28 | * as nonexistent. this is consistent with the previous behavior of the pure |
29 | * perl version of this module (since this is the behavior that perl sees |
30 | * in all versions */ |
31 | #if PERL_VERSION < 10 |
32 | #define GvSVOK(g) (GvSV(g) && SvTYPE(GvSV(g)) != SVt_NULL) |
33 | #else |
34 | #define GvSVOK(g) GvSV(g) |
35 | #endif |
36 | |
37 | #define GvAVOK(g) GvAV(g) |
38 | #define GvHVOK(g) GvHV(g) |
39 | #define GvCVOK(g) GvCVu(g) /* XXX: should this really be GvCVu? or GvCV? */ |
40 | #define GvIOOK(g) GvIO(g) |
41 | |
9aa6fe4f |
42 | /* see above - don't let scalar slots become unpopulated, this breaks |
43 | * assumptions in core */ |
3720d1a1 |
44 | #if PERL_VERSION < 10 |
45 | #define GvSetSV(g,v) do { \ |
46 | SV *_v = (SV*)(v); \ |
47 | SvREFCNT_dec(GvSV(g)); \ |
48 | if ((GvSV(g) = _v ? _v : newSV(0))) \ |
49 | GvIMPORTED_SV_on(g); \ |
50 | } while (0) |
51 | #else |
d551a208 |
52 | #define GvSetSV(g,v) do { \ |
53 | SvREFCNT_dec(GvSV(g)); \ |
54 | if ((GvSV(g) = (SV*)(v))) \ |
55 | GvIMPORTED_SV_on(g); \ |
56 | } while (0) |
3720d1a1 |
57 | #endif |
58 | |
d551a208 |
59 | #define GvSetAV(g,v) do { \ |
60 | SvREFCNT_dec(GvAV(g)); \ |
61 | if ((GvAV(g) = (AV*)(v))) \ |
62 | GvIMPORTED_AV_on(g); \ |
63 | } while (0) |
64 | #define GvSetHV(g,v) do { \ |
65 | SvREFCNT_dec(GvHV(g)); \ |
66 | if ((GvHV(g) = (HV*)(v))) \ |
67 | GvIMPORTED_HV_on(g); \ |
68 | } while (0) |
69 | #define GvSetCV(g,v) do { \ |
70 | SvREFCNT_dec(GvCV(g)); \ |
71 | if ((GvCV(g) = (CV*)(v))) { \ |
72 | GvIMPORTED_CV_on(g); \ |
73 | GvASSUMECV_on(g); \ |
74 | } \ |
75 | GvCVGEN(g) = 0; \ |
76 | mro_method_changed_in(GvSTASH(g)); \ |
77 | } while (0) |
78 | #define GvSetIO(g,v) do { \ |
79 | SvREFCNT_dec(GvIO(g)); \ |
80 | GvIOp(g) = (IO*)(v); \ |
81 | } while (0) |
82 | |
d1d0e437 |
83 | /* XXX: the core implementation of caller() is private, so we need a |
84 | * a reimplementation. luckily, padwalker already has done this. rafl says |
85 | * that there should be a public interface in 5.14, so maybe look into |
86 | * converting to use that at some point */ |
87 | #include "stolen_bits_of_padwalker.c" |
88 | |
a382a84b |
89 | typedef enum { |
90 | VAR_NONE = 0, |
91 | VAR_SCALAR, |
92 | VAR_ARRAY, |
93 | VAR_HASH, |
94 | VAR_CODE, |
95 | VAR_IO, |
96 | VAR_GLOB, /* TODO: unimplemented */ |
97 | VAR_FORMAT /* TODO: unimplemented */ |
98 | } vartype_t; |
99 | |
100 | typedef struct { |
101 | vartype_t type; |
a382a84b |
102 | char *name; |
103 | } varspec_t; |
104 | |
76f7c306 |
105 | const char *vartype_to_string(vartype_t type) |
106 | { |
107 | switch (type) { |
108 | case VAR_SCALAR: |
109 | return "SCALAR"; |
110 | case VAR_ARRAY: |
111 | return "ARRAY"; |
112 | case VAR_HASH: |
113 | return "HASH"; |
114 | case VAR_CODE: |
115 | return "CODE"; |
116 | case VAR_IO: |
117 | return "IO"; |
118 | default: |
119 | return "unknown"; |
120 | } |
121 | } |
122 | |
123 | I32 vartype_to_svtype(vartype_t type) |
124 | { |
125 | switch (type) { |
126 | case VAR_SCALAR: |
127 | return SVt_PV; /* or whatever */ |
128 | case VAR_ARRAY: |
129 | return SVt_PVAV; |
130 | case VAR_HASH: |
131 | return SVt_PVHV; |
132 | case VAR_CODE: |
133 | return SVt_PVCV; |
134 | case VAR_IO: |
135 | return SVt_PVIO; |
136 | default: |
137 | return SVt_NULL; |
138 | } |
139 | } |
140 | |
a382a84b |
141 | vartype_t string_to_vartype(char *vartype) |
142 | { |
143 | if (strEQ(vartype, "SCALAR")) { |
144 | return VAR_SCALAR; |
145 | } |
146 | else if (strEQ(vartype, "ARRAY")) { |
147 | return VAR_ARRAY; |
148 | } |
149 | else if (strEQ(vartype, "HASH")) { |
150 | return VAR_HASH; |
151 | } |
152 | else if (strEQ(vartype, "CODE")) { |
153 | return VAR_CODE; |
154 | } |
155 | else if (strEQ(vartype, "IO")) { |
156 | return VAR_IO; |
157 | } |
158 | else { |
159 | croak("Type must be one of 'SCALAR', 'ARRAY', 'HASH', 'CODE', or 'IO'"); |
160 | } |
161 | } |
162 | |
163 | void _deconstruct_variable_name(char *variable, varspec_t *varspec) |
164 | { |
165 | if (!variable || !variable[0]) |
166 | croak("You must pass a variable name"); |
167 | |
168 | varspec->type = VAR_NONE; |
169 | |
170 | switch (variable[0]) { |
171 | case '$': |
172 | varspec->type = VAR_SCALAR; |
173 | break; |
174 | case '@': |
175 | varspec->type = VAR_ARRAY; |
176 | break; |
177 | case '%': |
178 | varspec->type = VAR_HASH; |
179 | break; |
180 | case '&': |
181 | varspec->type = VAR_CODE; |
182 | break; |
183 | } |
184 | |
185 | if (varspec->type != VAR_NONE) { |
a382a84b |
186 | varspec->name = &variable[1]; |
187 | } |
188 | else { |
189 | varspec->type = VAR_IO; |
a382a84b |
190 | varspec->name = variable; |
191 | } |
192 | } |
193 | |
194 | void _deconstruct_variable_hash(HV *variable, varspec_t *varspec) |
195 | { |
196 | SV **val; |
a382a84b |
197 | |
198 | val = hv_fetch(variable, "name", 4, 0); |
199 | if (!val) |
200 | croak("The 'name' key is required in variable specs"); |
201 | |
202 | varspec->name = savesvpv(*val); |
301f570b |
203 | SAVEFREEPV(varspec->name); |
a382a84b |
204 | |
a382a84b |
205 | val = hv_fetch(variable, "type", 4, 0); |
206 | if (!val) |
207 | croak("The 'type' key is required in variable specs"); |
208 | |
209 | varspec->type = string_to_vartype(SvPV_nolen(*val)); |
210 | } |
211 | |
212 | int _valid_for_type(SV *value, vartype_t type) |
213 | { |
214 | svtype sv_type = SvROK(value) ? SvTYPE(SvRV(value)) : SVt_NULL; |
215 | |
216 | switch (type) { |
217 | case VAR_SCALAR: |
218 | return sv_type == SVt_NULL || |
219 | sv_type == SVt_IV || |
220 | sv_type == SVt_NV || |
221 | sv_type == SVt_PV || |
222 | sv_type == SVt_RV; |
223 | case VAR_ARRAY: |
224 | return sv_type == SVt_PVAV; |
225 | case VAR_HASH: |
226 | return sv_type == SVt_PVHV; |
227 | case VAR_CODE: |
228 | return sv_type == SVt_PVCV; |
229 | case VAR_IO: |
76f7c306 |
230 | return sv_type == SVt_PVIO; |
a382a84b |
231 | default: |
232 | return 0; |
233 | } |
234 | } |
235 | |
3fd56b4d |
236 | HV *_get_namespace(SV *self) |
237 | { |
238 | dSP; |
239 | SV *ret; |
240 | |
241 | PUSHMARK(SP); |
242 | XPUSHs(self); |
243 | PUTBACK; |
244 | |
612dcf3b |
245 | call_method("namespace", G_SCALAR); |
3fd56b4d |
246 | |
247 | SPAGAIN; |
248 | ret = POPs; |
249 | PUTBACK; |
250 | |
251 | return (HV*)SvRV(ret); |
252 | } |
253 | |
76f7c306 |
254 | SV *_get_name(SV *self) |
255 | { |
256 | dSP; |
257 | SV *ret; |
258 | |
259 | PUSHMARK(SP); |
260 | XPUSHs(self); |
261 | PUTBACK; |
262 | |
612dcf3b |
263 | call_method("name", G_SCALAR); |
76f7c306 |
264 | |
265 | SPAGAIN; |
266 | ret = POPs; |
267 | PUTBACK; |
268 | |
269 | return ret; |
270 | } |
271 | |
15c104e2 |
272 | SV *_get_symbol(SV *self, varspec_t *variable, int vivify) |
4871b1a0 |
273 | { |
274 | HV *namespace; |
275 | SV **entry; |
276 | GV *glob; |
277 | |
278 | namespace = _get_namespace(self); |
279 | entry = hv_fetch(namespace, variable->name, strlen(variable->name), vivify); |
280 | if (!entry) |
281 | return NULL; |
282 | |
283 | glob = (GV*)(*entry); |
284 | if (!isGV(glob)) { |
285 | SV *namesv; |
4871b1a0 |
286 | |
287 | namesv = newSVsv(_get_name(self)); |
288 | sv_catpvs(namesv, "::"); |
289 | sv_catpv(namesv, variable->name); |
290 | |
b55c97c2 |
291 | /* can't use gv_init here, because it screws up @ISA in a way that I |
292 | * can't reproduce, but that CMOP triggers */ |
293 | gv_fetchsv(namesv, GV_ADD, vartype_to_svtype(variable->type)); |
02b2a57f |
294 | SvREFCNT_dec(namesv); |
4871b1a0 |
295 | } |
296 | |
297 | if (vivify) { |
298 | switch (variable->type) { |
299 | case VAR_SCALAR: |
d551a208 |
300 | if (!GvSVOK(glob)) |
301 | GvSetSV(glob, newSV(0)); |
4871b1a0 |
302 | break; |
303 | case VAR_ARRAY: |
d551a208 |
304 | if (!GvAVOK(glob)) |
305 | GvSetAV(glob, newAV()); |
4871b1a0 |
306 | break; |
307 | case VAR_HASH: |
d551a208 |
308 | if (!GvHVOK(glob)) |
309 | GvSetHV(glob, newHV()); |
4871b1a0 |
310 | break; |
311 | case VAR_CODE: |
312 | croak("Don't know how to vivify CODE variables"); |
313 | case VAR_IO: |
d551a208 |
314 | if (!GvIOOK(glob)) |
315 | GvSetIO(glob, newIO()); |
4871b1a0 |
316 | break; |
317 | default: |
318 | croak("Unknown type in vivication"); |
319 | } |
320 | } |
321 | |
322 | switch (variable->type) { |
323 | case VAR_SCALAR: |
324 | return GvSV(glob); |
325 | case VAR_ARRAY: |
326 | return (SV*)GvAV(glob); |
327 | case VAR_HASH: |
328 | return (SV*)GvHV(glob); |
329 | case VAR_CODE: |
330 | return (SV*)GvCV(glob); |
331 | case VAR_IO: |
332 | return (SV*)GvIO(glob); |
333 | default: |
334 | return NULL; |
335 | } |
336 | } |
337 | |
59017825 |
338 | MODULE = Package::Stash PACKAGE = Package::Stash |
339 | |
be2a7e99 |
340 | PROTOTYPES: DISABLE |
341 | |
59017825 |
342 | SV* |
343 | new(class, package_name) |
344 | char *class |
345 | SV *package_name |
3496f1e8 |
346 | PREINIT: |
59017825 |
347 | HV *instance; |
348 | HV *namespace; |
1d6c978b |
349 | SV *nsref; |
59017825 |
350 | CODE: |
351 | if (!SvPOK(package_name)) |
352 | croak("The constructor argument must be the name of a package"); |
353 | |
6c3e69c6 |
354 | instance = newHV(); |
59017825 |
355 | |
1d6c978b |
356 | if (!hv_store(instance, "name", 4, SvREFCNT_inc_simple_NN(package_name), 0)) { |
357 | SvREFCNT_dec(package_name); |
c86a1630 |
358 | SvREFCNT_dec(instance); |
e8d57afd |
359 | croak("Couldn't initialize the 'name' key, hv_store failed"); |
1d6c978b |
360 | } |
59017825 |
361 | namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD); |
1d6c978b |
362 | nsref = newRV_inc((SV*)namespace); |
363 | if (!hv_store(instance, "namespace", 9, nsref, 0)) { |
364 | SvREFCNT_dec(nsref); |
c86a1630 |
365 | SvREFCNT_dec(instance); |
e8d57afd |
366 | croak("Couldn't initialize the 'namespace' key, hv_store failed"); |
1d6c978b |
367 | } |
59017825 |
368 | |
6c3e69c6 |
369 | RETVAL = sv_bless(newRV_noinc((SV*)instance), gv_stashpv(class, 0)); |
59017825 |
370 | OUTPUT: |
371 | RETVAL |
194acf47 |
372 | |
373 | SV* |
374 | name(self) |
375 | SV *self |
3496f1e8 |
376 | PREINIT: |
194acf47 |
377 | SV **slot; |
378 | CODE: |
379 | if (!sv_isobject(self)) |
380 | croak("Can't call name as a class method"); |
381 | slot = hv_fetch((HV*)SvRV(self), "name", 4, 0); |
a2fec41a |
382 | RETVAL = slot ? SvREFCNT_inc_simple_NN(*slot) : &PL_sv_undef; |
194acf47 |
383 | OUTPUT: |
384 | RETVAL |
385 | |
386 | SV* |
387 | namespace(self) |
388 | SV *self |
3496f1e8 |
389 | PREINIT: |
194acf47 |
390 | SV **slot; |
391 | CODE: |
392 | if (!sv_isobject(self)) |
393 | croak("Can't call namespace as a class method"); |
394 | slot = hv_fetch((HV*)SvRV(self), "namespace", 9, 0); |
a2fec41a |
395 | RETVAL = slot ? SvREFCNT_inc_simple_NN(*slot) : &PL_sv_undef; |
194acf47 |
396 | OUTPUT: |
397 | RETVAL |
3fd56b4d |
398 | |
399 | void |
15c104e2 |
400 | add_symbol(self, variable, initial=NULL, ...) |
76f7c306 |
401 | SV *self |
402 | varspec_t variable |
403 | SV *initial |
404 | PREINIT: |
405 | SV *name; |
406 | GV *glob; |
407 | CODE: |
408 | if (initial && !_valid_for_type(initial, variable.type)) |
409 | croak("%s is not of type %s", |
410 | SvPV_nolen(initial), vartype_to_string(variable.type)); |
411 | |
412 | name = newSVsv(_get_name(self)); |
413 | sv_catpvs(name, "::"); |
414 | sv_catpv(name, variable.name); |
415 | |
76f7c306 |
416 | if (items > 2 && (PL_perldb & 0x10) && variable.type == VAR_CODE) { |
417 | int i; |
d1d0e437 |
418 | char *filename = NULL, *namepv; |
419 | I32 first_line_num = -1, last_line_num = -1; |
420 | STRLEN namelen; |
421 | SV *dbval; |
422 | HV *dbsub; |
76f7c306 |
423 | |
424 | if ((items - 3) % 2) |
15c104e2 |
425 | croak("add_symbol: Odd number of elements in %%opts"); |
76f7c306 |
426 | |
427 | for (i = 3; i < items; i += 2) { |
428 | char *key; |
429 | key = SvPV_nolen(ST(i)); |
430 | if (strEQ(key, "filename")) { |
431 | if (!SvPOK(ST(i + 1))) |
15c104e2 |
432 | croak("add_symbol: filename must be a string"); |
76f7c306 |
433 | filename = SvPV_nolen(ST(i + 1)); |
434 | } |
435 | else if (strEQ(key, "first_line_num")) { |
436 | if (!SvIOK(ST(i + 1))) |
15c104e2 |
437 | croak("add_symbol: first_line_num must be an integer"); |
76f7c306 |
438 | first_line_num = SvIV(ST(i + 1)); |
439 | } |
440 | else if (strEQ(key, "last_line_num")) { |
441 | if (!SvIOK(ST(i + 1))) |
15c104e2 |
442 | croak("add_symbol: last_line_num must be an integer"); |
76f7c306 |
443 | last_line_num = SvIV(ST(i + 1)); |
444 | } |
445 | } |
446 | |
d1d0e437 |
447 | if (!filename || first_line_num == -1) { |
448 | I32 cxix_from, cxix_to; |
449 | PERL_CONTEXT *cx, *ccstack; |
450 | COP *cop = NULL; |
451 | |
452 | cx = upcontext(0, &cop, &ccstack, &cxix_from, &cxix_to); |
453 | if (!cop) |
454 | cop = PL_curcop; |
455 | |
456 | if (!filename) |
457 | filename = CopFILE(cop); |
458 | if (first_line_num == -1) |
459 | first_line_num = cop->cop_line; |
460 | } |
461 | |
462 | if (last_line_num == -1) |
463 | last_line_num = first_line_num; |
464 | |
465 | /* http://perldoc.perl.org/perldebguts.html#Debugger-Internals */ |
466 | dbsub = get_hv("DB::sub", 1); |
467 | dbval = newSVpvf("%s:%d-%d", filename, first_line_num, last_line_num); |
468 | namepv = SvPV(name, namelen); |
469 | if (!hv_store(dbsub, namepv, namelen, dbval, 0)) { |
470 | warn("Failed to update $DB::sub for subroutine %s", namepv); |
471 | SvREFCNT_dec(dbval); |
76f7c306 |
472 | } |
473 | } |
76f7c306 |
474 | |
9aa6fe4f |
475 | /* GV_ADDMULTI rather than GV_ADD because otherwise you get 'used only |
476 | * once' warnings in some situations... i can't reproduce this, but CMOP |
477 | * triggers it */ |
fedea7f9 |
478 | glob = gv_fetchsv(name, GV_ADDMULTI, vartype_to_svtype(variable.type)); |
76f7c306 |
479 | |
480 | if (initial) { |
481 | SV *val; |
482 | |
483 | if (SvROK(initial)) { |
484 | val = SvRV(initial); |
a2fec41a |
485 | SvREFCNT_inc_simple_void_NN(val); |
76f7c306 |
486 | } |
487 | else { |
488 | val = newSVsv(initial); |
489 | } |
490 | |
491 | switch (variable.type) { |
492 | case VAR_SCALAR: |
d551a208 |
493 | GvSetSV(glob, val); |
76f7c306 |
494 | break; |
495 | case VAR_ARRAY: |
d551a208 |
496 | GvSetAV(glob, val); |
76f7c306 |
497 | break; |
498 | case VAR_HASH: |
d551a208 |
499 | GvSetHV(glob, val); |
76f7c306 |
500 | break; |
501 | case VAR_CODE: |
d551a208 |
502 | GvSetCV(glob, val); |
76f7c306 |
503 | break; |
504 | case VAR_IO: |
d551a208 |
505 | GvSetIO(glob, val); |
76f7c306 |
506 | break; |
507 | } |
508 | } |
509 | |
5bb2b07b |
510 | SvREFCNT_dec(name); |
511 | |
76f7c306 |
512 | void |
15c104e2 |
513 | remove_glob(self, name) |
3fd56b4d |
514 | SV *self |
515 | char *name |
3fd56b4d |
516 | CODE: |
517 | hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD); |
9b608466 |
518 | |
34805376 |
519 | int |
15c104e2 |
520 | has_symbol(self, variable) |
34805376 |
521 | SV *self |
522 | varspec_t variable |
523 | PREINIT: |
524 | HV *namespace; |
525 | SV **entry; |
526 | CODE: |
527 | namespace = _get_namespace(self); |
528 | entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0); |
529 | if (!entry) |
530 | XSRETURN_UNDEF; |
531 | |
532 | if (isGV(*entry)) { |
533 | GV *glob = (GV*)(*entry); |
534 | switch (variable.type) { |
535 | case VAR_SCALAR: |
d551a208 |
536 | RETVAL = GvSVOK(glob) ? 1 : 0; |
34805376 |
537 | break; |
538 | case VAR_ARRAY: |
d551a208 |
539 | RETVAL = GvAVOK(glob) ? 1 : 0; |
34805376 |
540 | break; |
541 | case VAR_HASH: |
d551a208 |
542 | RETVAL = GvHVOK(glob) ? 1 : 0; |
34805376 |
543 | break; |
544 | case VAR_CODE: |
d551a208 |
545 | RETVAL = GvCVOK(glob) ? 1 : 0; |
34805376 |
546 | break; |
547 | case VAR_IO: |
d551a208 |
548 | RETVAL = GvIOOK(glob) ? 1 : 0; |
34805376 |
549 | break; |
550 | } |
551 | } |
552 | else { |
553 | RETVAL = (variable.type == VAR_CODE); |
554 | } |
555 | OUTPUT: |
556 | RETVAL |
557 | |
e3ad44fd |
558 | SV* |
15c104e2 |
559 | get_symbol(self, variable) |
e3ad44fd |
560 | SV *self |
561 | varspec_t variable |
562 | PREINIT: |
fca4ed0c |
563 | SV *val; |
e3ad44fd |
564 | CODE: |
15c104e2 |
565 | val = _get_symbol(self, &variable, 0); |
4871b1a0 |
566 | if (!val) |
e3ad44fd |
567 | XSRETURN_UNDEF; |
93c36417 |
568 | RETVAL = newRV_inc(val); |
4871b1a0 |
569 | OUTPUT: |
570 | RETVAL |
e3ad44fd |
571 | |
4871b1a0 |
572 | SV* |
15c104e2 |
573 | get_or_add_symbol(self, variable) |
4871b1a0 |
574 | SV *self |
575 | varspec_t variable |
576 | PREINIT: |
577 | SV *val; |
578 | CODE: |
15c104e2 |
579 | val = _get_symbol(self, &variable, 1); |
fca4ed0c |
580 | if (!val) |
581 | XSRETURN_UNDEF; |
93c36417 |
582 | RETVAL = newRV_inc(val); |
e3ad44fd |
583 | OUTPUT: |
584 | RETVAL |
585 | |
9b608466 |
586 | void |
15c104e2 |
587 | remove_symbol(self, variable) |
215f49f8 |
588 | SV *self |
589 | varspec_t variable |
590 | PREINIT: |
591 | HV *namespace; |
592 | SV **entry; |
593 | CODE: |
594 | namespace = _get_namespace(self); |
595 | entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0); |
596 | if (!entry) |
597 | XSRETURN_EMPTY; |
598 | |
599 | if (isGV(*entry)) { |
600 | GV *glob = (GV*)(*entry); |
601 | switch (variable.type) { |
602 | case VAR_SCALAR: |
d551a208 |
603 | GvSetSV(glob, NULL); |
215f49f8 |
604 | break; |
605 | case VAR_ARRAY: |
d551a208 |
606 | GvSetAV(glob, NULL); |
215f49f8 |
607 | break; |
608 | case VAR_HASH: |
d551a208 |
609 | GvSetHV(glob, NULL); |
215f49f8 |
610 | break; |
611 | case VAR_CODE: |
d551a208 |
612 | GvSetCV(glob, NULL); |
215f49f8 |
613 | break; |
614 | case VAR_IO: |
d551a208 |
615 | GvSetIO(glob, NULL); |
215f49f8 |
616 | break; |
617 | } |
618 | } |
619 | else { |
620 | if (variable.type == VAR_CODE) { |
621 | hv_delete(namespace, variable.name, strlen(variable.name), G_DISCARD); |
622 | } |
623 | } |
624 | |
625 | void |
15c104e2 |
626 | list_all_symbols(self, vartype=VAR_NONE) |
9b608466 |
627 | SV *self |
628 | vartype_t vartype |
629 | PPCODE: |
630 | if (vartype == VAR_NONE) { |
631 | HV *namespace; |
632 | HE *entry; |
633 | int keys; |
634 | |
635 | namespace = _get_namespace(self); |
636 | keys = hv_iterinit(namespace); |
637 | EXTEND(SP, keys); |
ebcc8ba8 |
638 | while ((entry = hv_iternext(namespace))) { |
13f8a7b7 |
639 | mPUSHs(newSVhe(entry)); |
9b608466 |
640 | } |
641 | } |
642 | else { |
643 | HV *namespace; |
9b608466 |
644 | SV *val; |
645 | char *key; |
646 | int len; |
647 | |
648 | namespace = _get_namespace(self); |
649 | hv_iterinit(namespace); |
ebcc8ba8 |
650 | while ((val = hv_iternextsv(namespace, &key, &len))) { |
9b608466 |
651 | GV *gv = (GV*)val; |
652 | if (isGV(gv)) { |
653 | switch (vartype) { |
654 | case VAR_SCALAR: |
d551a208 |
655 | if (GvSVOK(val)) |
9b608466 |
656 | mXPUSHp(key, len); |
657 | break; |
658 | case VAR_ARRAY: |
d551a208 |
659 | if (GvAVOK(val)) |
9b608466 |
660 | mXPUSHp(key, len); |
661 | break; |
662 | case VAR_HASH: |
d551a208 |
663 | if (GvHVOK(val)) |
9b608466 |
664 | mXPUSHp(key, len); |
665 | break; |
666 | case VAR_CODE: |
d551a208 |
667 | if (GvCVOK(val)) |
9b608466 |
668 | mXPUSHp(key, len); |
669 | break; |
670 | case VAR_IO: |
d551a208 |
671 | if (GvIOOK(val)) |
9b608466 |
672 | mXPUSHp(key, len); |
673 | break; |
674 | } |
675 | } |
676 | else if (vartype == VAR_CODE) { |
677 | mXPUSHp(key, len); |
678 | } |
679 | } |
680 | } |