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