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