This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix quoting of keys with embedded nulls
[perl5.git] / ext / Data / Dumper / Dumper.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 static SV       *freezer;
6 static SV       *toaster;
7
8 static I32 num_q _((char *s, STRLEN slen));
9 static I32 esc_q _((char *dest, char *src, STRLEN slen));
10 static SV *sv_x _((SV *sv, char *str, STRLEN len, I32 n));
11 static 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? */
18 static I32
19 needs_quote(register char *s)
20 {
21 TOP:
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 */
44 static I32
45 num_q(register char *s, register STRLEN slen)
46 {
47     register I32 ret = 0;
48
49     while (slen > 0) {
50         if (*s == '\'' || *s == '\\')
51             ++ret;
52         ++s;
53         --slen;
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 */
62 static I32
63 esc_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 */
83 static SV *
84 sv_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  */
114 static I32
115 DD_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);
142     if (val == &PL_sv_undef || !SvOK(val)) {
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;
155             if (SvTRUE(GvSV(PL_errgv)))
156                 warn("WARNING(Freezer method call failed): %s",
157                      SvPVX(GvSV(PL_errgv)));
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
306                     elem = &PL_sv_undef;
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)) {
384                     nticks = num_q(key, klen);
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
583 MODULE = 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
591 void
592 Data_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
644                 = freezer = toaster = bless = &PL_sv_undef;
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
703                         val = &PL_sv_undef;
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         }