projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
correct bugs exposed in MM_Unix.pm by commenting out Selfloader
[p5sagit/p5-mst-13.2.git] / ext / Data / Dumper / Dumper.xs
CommitLineData
823edd99 1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
823edd99 4
5static SV *freezer;
6static SV *toaster;
7
6c1ab3c2 8static I32 num_q _((char *s, STRLEN slen));
823edd99 9static I32 esc_q _((char *dest, char *src, STRLEN slen));
10static SV *sv_x _((SV *sv, char *str, STRLEN len, I32 n));
11static I32 DD_dump _((SV *val, char *name, STRLEN namelen, SV *retval,
12 HV *seenhv, AV *postav, I32 *levelp, I32 indent,
13 SV *pad, SV *xpad, SV *apad, SV *sep,
14 SV *freezer, SV *toaster,
15 I32 purity, I32 deepcopy, I32 quotekeys, SV *bless));
16
17/* does a string need to be protected? */
18static I32
19needs_quote(register char *s)
20{
21TOP:
22 if (s[0] == ':') {
23 if (*++s) {
24 if (*s++ != ':')
25 return 1;
26 }
27 else
28 return 1;
29 }
30 if (isIDFIRST(*s)) {
31 while (*++s)
32 if (!isALNUM(*s))
33 if (*s == ':')
34 goto TOP;
35 else
36 return 1;
37 }
38 else
39 return 1;
40 return 0;
41}
42
43/* count the number of "'"s and "\"s in string */
44static I32
6c1ab3c2 45num_q(register char *s, register STRLEN slen)
823edd99 46{
47 register I32 ret = 0;
6c1ab3c2 48
49 while (slen > 0) {
823edd99 50 if (*s == '\'' || *s == '\\')
51 ++ret;
52 ++s;
6c1ab3c2 53 --slen;
823edd99 54 }
55 return ret;
56}
57
58
59/* returns number of chars added to escape "'"s and "\"s in s */
60/* slen number of characters in s will be escaped */
61/* destination must be long enough for additional chars */
62static I32
63esc_q(register char *d, register char *s, register STRLEN slen)
64{
65 register I32 ret = 0;
66
67 while (slen > 0) {
68 switch (*s) {
69 case '\'':
70 case '\\':
71 *d = '\\';
72 ++d; ++ret;
73 default:
74 *d = *s;
75 ++d; ++s; --slen;
76 break;
77 }
78 }
79 return ret;
80}
81
82/* append a repeated string to an SV */
83static SV *
84sv_x(SV *sv, register char *str, STRLEN len, I32 n)
85{
86 if (sv == Nullsv)
87 sv = newSVpv("", 0);
88 else
89 assert(SvTYPE(sv) >= SVt_PV);
90
91 if (n > 0) {
92 SvGROW(sv, len*n + SvCUR(sv) + 1);
93 if (len == 1) {
94 char *start = SvPVX(sv) + SvCUR(sv);
95 SvCUR(sv) += n;
96 start[n] = '\0';
97 while (n > 0)
98 start[--n] = str[0];
99 }
100 else
101 while (n > 0) {
102 sv_catpvn(sv, str, len);
103 --n;
104 }
105 }
106 return sv;
107}
108
109/*
110 * This ought to be split into smaller functions. (it is one long function since
111 * it exactly parallels the perl version, which was one long thing for
112 * efficiency raisins.) Ugggh!
113 */
114static I32
115DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
116 AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad,
117 SV *apad, SV *sep, SV *freezer, SV *toaster, I32 purity,
118 I32 deepcopy, I32 quotekeys, SV *bless)
119{
120 char tmpbuf[128];
121 U32 i;
122 char *c, *r, *realpack, id[128];
123 SV **svp;
124 SV *sv;
125 SV *blesspad = Nullsv;
126 SV *ipad;
127 SV *ival;
128 AV *seenentry;
129 char *iname;
130 STRLEN inamelen, idlen = 0;
131 U32 flags;
132 U32 realtype;
133
134 if (!val)
135 return 0;
136
137 flags = SvFLAGS(val);
138 realtype = SvTYPE(val);
139
140 if (SvGMAGICAL(val))
141 mg_get(val);
3280af22 142 if (val == &PL_sv_undef || !SvOK(val)) {
823edd99 143 sv_catpvn(retval, "undef", 5);
144 return 1;
145 }
146 if (SvROK(val)) {
147
148 if (SvOBJECT(SvRV(val)) && freezer &&
149 SvPOK(freezer) && SvCUR(freezer))
150 {
151 dSP; ENTER; SAVETMPS; PUSHMARK(sp);
152 XPUSHs(val); PUTBACK;
153 i = perl_call_method(SvPVX(freezer), G_EVAL|G_SCALAR);
154 SPAGAIN;
3280af22 155 if (SvTRUE(GvSV(PL_errgv)))
823edd99 156 warn("WARNING(Freezer method call failed): %s",
3280af22 157 SvPVX(GvSV(PL_errgv)));
823edd99 158 else if (i)
159 val = newSVsv(POPs);
160 PUTBACK; FREETMPS; LEAVE;
161 if (i)
162 (void)sv_2mortal(val);
163 }
164
165 ival = SvRV(val);
166 flags = SvFLAGS(ival);
167 realtype = SvTYPE(ival);
168 (void) sprintf(id, "0x%lx", (unsigned long)ival);
169 idlen = strlen(id);
170 if (SvOBJECT(ival))
171 realpack = HvNAME(SvSTASH(ival));
172 else
173 realpack = Nullch;
174 if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) &&
175 (sv = *svp) && SvROK(sv) &&
176 (seenentry = (AV*)SvRV(sv))) {
177 SV *othername;
178 if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)) {
179 if (purity && *levelp > 0) {
180 SV *postentry;
181
182 if (realtype == SVt_PVHV)
183 sv_catpvn(retval, "{}", 2);
184 else if (realtype == SVt_PVAV)
185 sv_catpvn(retval, "[]", 2);
186 else
187 sv_catpvn(retval, "''", 2);
188 postentry = newSVpv(name, namelen);
189 sv_catpvn(postentry, " = ", 3);
190 sv_catsv(postentry, othername);
191 av_push(postav, postentry);
192 }
193 else {
194 if (name[0] == '@' || name[0] == '%') {
195 if ((SvPVX(othername))[0] == '\\' &&
196 (SvPVX(othername))[1] == name[0]) {
197 sv_catpvn(retval, SvPVX(othername)+1, SvCUR(othername)-1);
198 }
199 else {
200 sv_catpvn(retval, name, 1);
201 sv_catpvn(retval, "{", 1);
202 sv_catsv(retval, othername);
203 sv_catpvn(retval, "}", 1);
204 }
205 }
206 else
207 sv_catsv(retval, othername);
208 }
209 return 1;
210 }
211 else {
212 warn("ref name not found for %s", id);
213 return 0;
214 }
215 }
216 else { /* store our name and continue */
217 SV *namesv;
218 if (name[0] == '@' || name[0] == '%') {
219 namesv = newSVpv("\\", 1);
220 sv_catpvn(namesv, name, namelen);
221 }
222 else if (realtype == SVt_PVCV && name[0] == '*') {
223 namesv = newSVpv("\\", 2);
224 sv_catpvn(namesv, name, namelen);
225 (SvPVX(namesv))[1] = '&';
226 }
227 else
228 namesv = newSVpv(name, namelen);
229 seenentry = newAV();
230 av_push(seenentry, namesv);
231 (void)SvREFCNT_inc(val);
232 av_push(seenentry, val);
233 (void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0);
234 SvREFCNT_dec(seenentry);
235 }
236
237 (*levelp)++;
238 ipad = sv_x(Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp);
239
240 if (realpack) { /* we have a blessed ref */
241 STRLEN blesslen;
242 char *blessstr = SvPV(bless, blesslen);
243 sv_catpvn(retval, blessstr, blesslen);
244 sv_catpvn(retval, "( ", 2);
245 if (indent >= 2) {
246 blesspad = apad;
247 apad = newSVsv(apad);
248 sv_x(apad, " ", 1, blesslen+2);
249 }
250 }
251
252 if (realtype <= SVt_PVBM || realtype == SVt_PVGV) { /* scalars */
253 if (realpack && realtype != SVt_PVGV) { /* blessed */
254 sv_catpvn(retval, "do{\\(my $o = ", 13);
255 DD_dump(ival, "", 0, retval, seenhv, postav,
256 levelp, indent, pad, xpad, apad, sep,
257 freezer, toaster, purity, deepcopy, quotekeys, bless);
258 sv_catpvn(retval, ")}", 2);
259 }
260 else {
261 sv_catpvn(retval, "\\", 1);
262 DD_dump(ival, "", 0, retval, seenhv, postav,
263 levelp, indent, pad, xpad, apad, sep,
264 freezer, toaster, purity, deepcopy, quotekeys, bless);
265 }
266 }
267 else if (realtype == SVt_PVAV) {
268 SV *totpad;
269 I32 ix = 0;
270 I32 ixmax = av_len((AV *)ival);
271
272 SV *ixsv = newSViv(0);
273 /* allowing for a 24 char wide array index */
274 New(0, iname, namelen+28, char);
275 (void)strcpy(iname, name);
276 inamelen = namelen;
277 if (name[0] == '@') {
278 sv_catpvn(retval, "(", 1);
279 iname[0] = '$';
280 }
281 else {
282 sv_catpvn(retval, "[", 1);
283 if (namelen > 0 && name[namelen-1] != ']' && name[namelen-1] != '}') {
284 iname[inamelen++] = '-'; iname[inamelen++] = '>';
285 iname[inamelen] = '\0';
286 }
287 }
288 if (iname[0] == '*' && iname[inamelen-1] == '}' && inamelen >= 8 &&
289 (instr(iname+inamelen-8, "{SCALAR}") ||
290 instr(iname+inamelen-7, "{ARRAY}") ||
291 instr(iname+inamelen-6, "{HASH}"))) {
292 iname[inamelen++] = '-'; iname[inamelen++] = '>';
293 }
294 iname[inamelen++] = '['; iname[inamelen] = '\0';
295 totpad = newSVsv(sep);
296 sv_catsv(totpad, pad);
297 sv_catsv(totpad, apad);
298
299 for (ix = 0; ix <= ixmax; ++ix) {
300 STRLEN ilen;
301 SV *elem;
302 svp = av_fetch((AV*)ival, ix, FALSE);
303 if (svp)
304 elem = *svp;
305 else
3280af22 306 elem = &PL_sv_undef;
823edd99 307
308 ilen = inamelen;
309 sv_setiv(ixsv, ix);
310 (void) sprintf(iname+ilen, "%ld", ix);
311 ilen = strlen(iname);
312 iname[ilen++] = ']'; iname[ilen] = '\0';
313 if (indent >= 3) {
314 sv_catsv(retval, totpad);
315 sv_catsv(retval, ipad);
316 sv_catpvn(retval, "#", 1);
317 sv_catsv(retval, ixsv);
318 }
319 sv_catsv(retval, totpad);
320 sv_catsv(retval, ipad);
321 DD_dump(elem, iname, ilen, retval, seenhv, postav,
322 levelp, indent, pad, xpad, apad, sep,
323 freezer, toaster, purity, deepcopy, quotekeys, bless);
324 if (ix < ixmax)
325 sv_catpvn(retval, ",", 1);
326 }
327 if (ixmax >= 0) {
328 SV *opad = sv_x(Nullsv, SvPVX(xpad), SvCUR(xpad), (*levelp)-1);
329 sv_catsv(retval, totpad);
330 sv_catsv(retval, opad);
331 SvREFCNT_dec(opad);
332 }
333 if (name[0] == '@')
334 sv_catpvn(retval, ")", 1);
335 else
336 sv_catpvn(retval, "]", 1);
337 SvREFCNT_dec(ixsv);
338 SvREFCNT_dec(totpad);
339 Safefree(iname);
340 }
341 else if (realtype == SVt_PVHV) {
342 SV *totpad, *newapad;
343 SV *iname, *sname;
344 HE *entry;
345 char *key;
346 I32 klen;
347 SV *hval;
348
349 iname = newSVpv(name, namelen);
350 if (name[0] == '%') {
351 sv_catpvn(retval, "(", 1);
352 (SvPVX(iname))[0] = '$';
353 }
354 else {
355 sv_catpvn(retval, "{", 1);
356 if (namelen > 0 && name[namelen-1] != ']' && name[namelen-1] != '}') {
357 sv_catpvn(iname, "->", 2);
358 }
359 }
360 if (name[0] == '*' && name[namelen-1] == '}' && namelen >= 8 &&
361 (instr(name+namelen-8, "{SCALAR}") ||
362 instr(name+namelen-7, "{ARRAY}") ||
363 instr(name+namelen-6, "{HASH}"))) {
364 sv_catpvn(iname, "->", 2);
365 }
366 sv_catpvn(iname, "{", 1);
367 totpad = newSVsv(sep);
368 sv_catsv(totpad, pad);
369 sv_catsv(totpad, apad);
370
371 (void)hv_iterinit((HV*)ival);
372 i = 0;
373 while ((entry = hv_iternext((HV*)ival))) {
374 char *nkey;
375 I32 nticks = 0;
376
377 if (i)
378 sv_catpvn(retval, ",", 1);
379 i++;
380 key = hv_iterkey(entry, &klen);
381 hval = hv_iterval((HV*)ival, entry);
382
383 if (quotekeys || needs_quote(key)) {
6c1ab3c2 384 nticks = num_q(key, klen);
823edd99 385 New(0, nkey, klen+nticks+3, char);
386 nkey[0] = '\'';
387 if (nticks)
388 klen += esc_q(nkey+1, key, klen);
389 else
390 (void)Copy(key, nkey+1, klen, char);
391 nkey[++klen] = '\'';
392 nkey[++klen] = '\0';
393 }
394 else {
395 New(0, nkey, klen, char);
396 (void)Copy(key, nkey, klen, char);
397 }
398
399 sname = newSVsv(iname);
400 sv_catpvn(sname, nkey, klen);
401 sv_catpvn(sname, "}", 1);
402
403 sv_catsv(retval, totpad);
404 sv_catsv(retval, ipad);
405 sv_catpvn(retval, nkey, klen);
406 sv_catpvn(retval, " => ", 4);
407 if (indent >= 2) {
408 char *extra;
409 I32 elen = 0;
410 newapad = newSVsv(apad);
411 New(0, extra, klen+4+1, char);
412 while (elen < (klen+4))
413 extra[elen++] = ' ';
414 extra[elen] = '\0';
415 sv_catpvn(newapad, extra, elen);
416 Safefree(extra);
417 }
418 else
419 newapad = apad;
420
421 DD_dump(hval, SvPVX(sname), SvCUR(sname), retval, seenhv,
422 postav, levelp, indent, pad, xpad, newapad, sep,
423 freezer, toaster, purity, deepcopy, quotekeys, bless);
424 SvREFCNT_dec(sname);
425 Safefree(nkey);
426 if (indent >= 2)
427 SvREFCNT_dec(newapad);
428 }
429 if (i) {
430 SV *opad = sv_x(Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp-1);
431 sv_catsv(retval, totpad);
432 sv_catsv(retval, opad);
433 SvREFCNT_dec(opad);
434 }
435 if (name[0] == '%')
436 sv_catpvn(retval, ")", 1);
437 else
438 sv_catpvn(retval, "}", 1);
439 SvREFCNT_dec(iname);
440 SvREFCNT_dec(totpad);
441 }
442 else if (realtype == SVt_PVCV) {
443 sv_catpvn(retval, "sub { \"DUMMY\" }", 15);
444 if (purity)
445 warn("Encountered CODE ref, using dummy placeholder");
446 }
447 else {
448 warn("cannot handle ref type %ld", realtype);
449 }
450
451 if (realpack) { /* free blessed allocs */
452 if (indent >= 2) {
453 SvREFCNT_dec(apad);
454 apad = blesspad;
455 }
456 sv_catpvn(retval, ", '", 3);
457 sv_catpvn(retval, realpack, strlen(realpack));
458 sv_catpvn(retval, "' )", 3);
459 if (toaster && SvPOK(toaster) && SvCUR(toaster)) {
460 sv_catpvn(retval, "->", 2);
461 sv_catsv(retval, toaster);
462 sv_catpvn(retval, "()", 2);
463 }
464 }
465 SvREFCNT_dec(ipad);
466 (*levelp)--;
467 }
468 else {
469 STRLEN i;
470
471 if (namelen) {
472 (void) sprintf(id, "0x%lx", (unsigned long)val);
473 if ((svp = hv_fetch(seenhv, id, (idlen = strlen(id)), FALSE)) &&
474 (sv = *svp) && SvROK(sv) &&
475 (seenentry = (AV*)SvRV(sv))) {
476 SV *othername;
477 if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)) {
478 sv_catsv(retval, othername);
479 return 1;
480 }
481 }
482 else {
483 SV *namesv;
484 namesv = newSVpv("\\", 1);
485 sv_catpvn(namesv, name, namelen);
486 seenentry = newAV();
487 av_push(seenentry, namesv);
488 (void)SvREFCNT_inc(val);
489 av_push(seenentry, val);
490 (void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0);
491 SvREFCNT_dec(seenentry);
492 }
493 }
494
495 if (SvIOK(val)) {
496 STRLEN len;
497 i = SvIV(val);
498 (void) sprintf(tmpbuf, "%d", i);
499 len = strlen(tmpbuf);
500 sv_catpvn(retval, tmpbuf, len);
501 return 1;
502 }
503 else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */
504 c = SvPV(val, i);
505 ++c; --i; /* just get the name */
506 if (i >= 6 && strncmp(c, "main::", 6) == 0) {
507 c += 4;
508 i -= 4;
509 }
510 if (needs_quote(c)) {
511 sv_grow(retval, SvCUR(retval)+6+2*i);
512 r = SvPVX(retval)+SvCUR(retval);
513 r[0] = '*'; r[1] = '{'; r[2] = '\'';
514 i += esc_q(r+3, c, i);
515 i += 3;
516 r[i++] = '\''; r[i++] = '}';
517 r[i] = '\0';
518 }
519 else {
520 sv_grow(retval, SvCUR(retval)+i+2);
521 r = SvPVX(retval)+SvCUR(retval);
522 r[0] = '*'; strcpy(r+1, c);
523 i++;
524 }
525
526 if (purity) {
527 static char *entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
528 static STRLEN sizes[] = { 8, 7, 6 };
529 SV *e;
530 SV *nname = newSVpv("", 0);
531 SV *newapad = newSVpv("", 0);
532 GV *gv = (GV*)val;
533 I32 j;
534
535 for (j=0; j<3; j++) {
536 e = ((j == 0) ? GvSV(gv) : (j == 1) ? (SV*)GvAV(gv) : (SV*)GvHV(gv));
537 if (e) {
538 I32 nlevel = 0;
539 SV *postentry = newSVpv(r,i);
540
541 sv_setsv(nname, postentry);
542 sv_catpvn(nname, entries[j], sizes[j]);
543 sv_catpvn(postentry, " = ", 3);
544 av_push(postav, postentry);
545 e = newRV(e);
546
547 SvCUR(newapad) = 0;
548 if (indent >= 2)
549 (void)sv_x(newapad, " ", 1, SvCUR(postentry));
550
551 DD_dump(e, SvPVX(nname), SvCUR(nname), postentry,
552 seenhv, postav, &nlevel, indent, pad, xpad,
553 newapad, sep, freezer, toaster, purity,
554 deepcopy, quotekeys, bless);
555 SvREFCNT_dec(e);
556 }
557 }
558
559 SvREFCNT_dec(newapad);
560 SvREFCNT_dec(nname);
561 }
562 }
563 else {
564 c = SvPV(val, i);
565 sv_grow(retval, SvCUR(retval)+3+2*i);
566 r = SvPVX(retval)+SvCUR(retval);
567 r[0] = '\'';
568 i += esc_q(r+1, c, i);
569 ++i;
570 r[i++] = '\'';
571 r[i] = '\0';
572 }
573 SvCUR_set(retval, SvCUR(retval)+i);
574 }
575
576 if (deepcopy && idlen)
577 (void)hv_delete(seenhv, id, idlen, G_DISCARD);
578
579 return 1;
580}
581
582
583MODULE = Data::Dumper PACKAGE = Data::Dumper PREFIX = Data_Dumper_
584
585#
586# This is the exact equivalent of Dump. Well, almost. The things that are
587# different as of now (due to Laziness):
588# * doesnt do double-quotes yet.
589#
590
591void
592Data_Dumper_Dumpxs(href, ...)
593 SV *href;
594 PROTOTYPE: $;$$
595 PPCODE:
596 {
597 HV *hv;
598 SV *retval, *valstr;
599 HV *seenhv = Nullhv;
600 AV *postav, *todumpav, *namesav;
601 I32 level = 0;
602 I32 indent, terse, useqq, i, imax, postlen;
603 SV **svp;
604 SV *val, *name, *pad, *xpad, *apad, *sep, *tmp, *varname;
605 SV *freezer, *toaster, *bless;
606 I32 purity, deepcopy, quotekeys;
607 char tmpbuf[1024];
608 I32 gimme = GIMME;
609
610 if (!SvROK(href)) { /* call new to get an object first */
611 SV *valarray;
612 SV *namearray;
613
614 if (items == 3) {
615 valarray = ST(1);
616 namearray = ST(2);
617 }
618 else
619 croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, NAME_ARY_REF)");
620
621 ENTER;
622 SAVETMPS;
623
624 PUSHMARK(sp);
625 XPUSHs(href);
626 XPUSHs(sv_2mortal(newSVsv(valarray)));
627 XPUSHs(sv_2mortal(newSVsv(namearray)));
628 PUTBACK;
629 i = perl_call_method("new", G_SCALAR);
630 SPAGAIN;
631 if (i)
632 href = newSVsv(POPs);
633
634 PUTBACK;
635 FREETMPS;
636 LEAVE;
637 if (i)
638 (void)sv_2mortal(href);
639 }
640
641 todumpav = namesav = Nullav;
642 seenhv = Nullhv;
643 val = pad = xpad = apad = sep = tmp = varname
3280af22 644 = freezer = toaster = bless = &PL_sv_undef;
823edd99 645 name = sv_newmortal();
646 indent = 2;
647 terse = useqq = purity = deepcopy = 0;
648 quotekeys = 1;
649
650 retval = newSVpv("", 0);
651 if (SvROK(href)
652 && (hv = (HV*)SvRV((SV*)href))
653 && SvTYPE(hv) == SVt_PVHV) {
654
655 if ((svp = hv_fetch(hv, "seen", 4, FALSE)) && SvROK(*svp))
656 seenhv = (HV*)SvRV(*svp);
657 if ((svp = hv_fetch(hv, "todump", 6, FALSE)) && SvROK(*svp))
658 todumpav = (AV*)SvRV(*svp);
659 if ((svp = hv_fetch(hv, "names", 5, FALSE)) && SvROK(*svp))
660 namesav = (AV*)SvRV(*svp);
661 if ((svp = hv_fetch(hv, "indent", 6, FALSE)))
662 indent = SvIV(*svp);
663 if ((svp = hv_fetch(hv, "purity", 6, FALSE)))
664 purity = SvIV(*svp);
665 if ((svp = hv_fetch(hv, "terse", 5, FALSE)))
666 terse = SvTRUE(*svp);
667 if ((svp = hv_fetch(hv, "useqq", 5, FALSE)))
668 useqq = SvTRUE(*svp);
669 if ((svp = hv_fetch(hv, "pad", 3, FALSE)))
670 pad = *svp;
671 if ((svp = hv_fetch(hv, "xpad", 4, FALSE)))
672 xpad = *svp;
673 if ((svp = hv_fetch(hv, "apad", 4, FALSE)))
674 apad = *svp;
675 if ((svp = hv_fetch(hv, "sep", 3, FALSE)))
676 sep = *svp;
677 if ((svp = hv_fetch(hv, "varname", 7, FALSE)))
678 varname = *svp;
679 if ((svp = hv_fetch(hv, "freezer", 7, FALSE)))
680 freezer = *svp;
681 if ((svp = hv_fetch(hv, "toaster", 7, FALSE)))
682 toaster = *svp;
683 if ((svp = hv_fetch(hv, "deepcopy", 8, FALSE)))
684 deepcopy = SvTRUE(*svp);
685 if ((svp = hv_fetch(hv, "quotekeys", 9, FALSE)))
686 quotekeys = SvTRUE(*svp);
687 if ((svp = hv_fetch(hv, "bless", 5, FALSE)))
688 bless = *svp;
689 postav = newAV();
690
691 if (todumpav)
692 imax = av_len(todumpav);
693 else
694 imax = -1;
695 valstr = newSVpv("",0);
696 for (i = 0; i <= imax; ++i) {
697 SV *newapad;
698
699 av_clear(postav);
700 if ((svp = av_fetch(todumpav, i, FALSE)))
701 val = *svp;
702 else
3280af22 703 val = &PL_sv_undef;
823edd99 704 if ((svp = av_fetch(namesav, i, TRUE)))
705 sv_setsv(name, *svp);
706 else
707 SvOK_off(name);
708
709 if (SvOK(name)) {
710 if ((SvPVX(name))[0] == '*') {
711 if (SvROK(val)) {
712 switch (SvTYPE(SvRV(val))) {
713 case SVt_PVAV:
714 (SvPVX(name))[0] = '@';
715 break;
716 case SVt_PVHV:
717 (SvPVX(name))[0] = '%';
718 break;
719 case SVt_PVCV:
720 (SvPVX(name))[0] = '*';
721 break;
722 default:
723 (SvPVX(name))[0] = '$';
724 break;
725 }
726 }
727 else
728 (SvPVX(name))[0] = '$';
729 }
730 else if ((SvPVX(name))[0] != '$')
731 sv_insert(name, 0, 0, "$", 1);
732 }
733 else {
734 STRLEN nchars = 0;
735 sv_setpvn(name, "$", 1);
736 sv_catsv(name, varname);
737 (void) sprintf(tmpbuf, "%ld", i+1);
738 nchars = strlen(tmpbuf);
739 sv_catpvn(name, tmpbuf, nchars);
740 }
741
742 if (indent >= 2) {
743 SV *tmpsv = sv_x(Nullsv, " ", 1, SvCUR(name)+3);
744 newapad = newSVsv(apad);
745 sv_catsv(newapad, tmpsv);
746 SvREFCNT_dec(tmpsv);
747 }
748 else
749 newapad = apad;
750
751 DD_dump(val, SvPVX(name), SvCUR(name), valstr, seenhv,
752 postav, &level, indent, pad, xpad, newapad, sep,
753 freezer, toaster, purity, deepcopy, quotekeys,
754 bless);
755
756 if (indent >= 2)
757 SvREFCNT_dec(newapad);
758
759 postlen = av_len(postav);
760 if (postlen >= 0 || !terse) {
761 sv_insert(valstr, 0, 0, " = ", 3);
762 sv_insert(valstr, 0, 0, SvPVX(name), SvCUR(name));
763 sv_catpvn(valstr, ";", 1);
764 }
765 sv_catsv(retval, pad);
766 sv_catsv(retval, valstr);
767 sv_catsv(retval, sep);
768 if (postlen >= 0) {
769 I32 i;
770 sv_catsv(retval, pad);
771 for (i = 0; i <= postlen; ++i) {
772 SV *elem;
773 svp = av_fetch(postav, i, FALSE);
774 if (svp && (elem = *svp)) {
775 sv_catsv(retval, elem);
776 if (i < postlen) {
777 sv_catpvn(retval, ";", 1);
778 sv_catsv(retval, sep);
779 sv_catsv(retval, pad);
780 }
781 }
782 }
783 sv_catpvn(retval, ";", 1);
784 sv_catsv(retval, sep);
785 }
786 sv_setpvn(valstr, "", 0);
787 if (gimme == G_ARRAY) {
788 XPUSHs(sv_2mortal(retval));
789 if (i < imax) /* not the last time thro ? */
790 retval = newSVpv("",0);
791 }
792 }
793 SvREFCNT_dec(postav);
794 SvREFCNT_dec(valstr);
795 }
796 else
797 croak("Call to new() method failed to return HASH ref");
798 if (gimme == G_SCALAR)
799 XPUSHs(sv_2mortal(retval));
800 }
Unnamed repository; edit this file to name it for gitweb.