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