This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make DD dump *{''} correctly under 5.6
[perl5.git] / dist / Data-Dumper / Dumper.xs
1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5 #ifdef USE_PPPORT_H
6 #  define NEED_my_snprintf
7 #  define NEED_sv_2pv_flags
8 #  include "ppport.h"
9 #endif
10
11 #if PERL_VERSION < 8
12 #  define DD_USE_OLD_ID_FORMAT
13 #endif
14
15 static I32 num_q (const char *s, STRLEN slen);
16 static I32 esc_q (char *dest, const char *src, STRLEN slen);
17 static I32 esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen);
18 static I32 needs_quote(register const char *s, STRLEN len);
19 static SV *sv_x (pTHX_ SV *sv, const char *str, STRLEN len, I32 n);
20 static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval,
21                     HV *seenhv, AV *postav, I32 *levelp, I32 indent,
22                     SV *pad, SV *xpad, SV *apad, SV *sep, SV *pair,
23                     SV *freezer, SV *toaster,
24                     I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
25                     I32 maxdepth, SV *sortkeys);
26
27 #ifndef HvNAME_get
28 #define HvNAME_get HvNAME
29 #endif
30
31 #if PERL_VERSION <= 6 /* Perl 5.6 and earlier */
32
33 # ifdef EBCDIC
34 #  define UNI_TO_NATIVE(ch) (((ch) > 255) ? (ch) : ASCII_TO_NATIVE(ch))
35 # else
36 #  define UNI_TO_NATIVE(ch) (ch)
37 # endif
38
39 UV
40 Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen)
41 {
42     const UV uv = utf8_to_uv(s, UTF8_MAXLEN, retlen,
43                     ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
44     return UNI_TO_NATIVE(uv);
45 }
46
47 # if !defined(PERL_IMPLICIT_CONTEXT)
48 #  define utf8_to_uvchr      Perl_utf8_to_uvchr
49 # else
50 #  define utf8_to_uvchr(a,b) Perl_utf8_to_uvchr(aTHX_ a,b)
51 # endif
52
53 #endif /* PERL_VERSION <= 6 */
54
55 /* Changes in 5.7 series mean that now IOK is only set if scalar is
56    precisely integer but in 5.6 and earlier we need to do a more
57    complex test  */
58 #if PERL_VERSION <= 6
59 #define DD_is_integer(sv) (SvIOK(sv) && (SvIsUV(val) ? SvUV(sv) == SvNV(sv) : SvIV(sv) == SvNV(sv)))
60 #else
61 #define DD_is_integer(sv) SvIOK(sv)
62 #endif
63
64 /* does a string need to be protected? */
65 static I32
66 needs_quote(register const char *s, STRLEN len)
67 {
68     const char *send = s+len;
69 TOP:
70     if (s[0] == ':') {
71         if (++s<send) {
72             if (*s++ != ':')
73                 return 1;
74         }
75         else
76             return 1;
77     }
78     if (isIDFIRST(*s)) {
79         while (++s<send)
80             if (!isALNUM(*s)) {
81                 if (*s == ':')
82                     goto TOP;
83                 else
84                     return 1;
85             }
86     }
87     else
88         return 1;
89     return 0;
90 }
91
92 /* count the number of "'"s and "\"s in string */
93 static I32
94 num_q(register const char *s, register STRLEN slen)
95 {
96     register I32 ret = 0;
97
98     while (slen > 0) {
99         if (*s == '\'' || *s == '\\')
100             ++ret;
101         ++s;
102         --slen;
103     }
104     return ret;
105 }
106
107
108 /* returns number of chars added to escape "'"s and "\"s in s */
109 /* slen number of characters in s will be escaped */
110 /* destination must be long enough for additional chars */
111 static I32
112 esc_q(register char *d, register const char *s, register STRLEN slen)
113 {
114     register I32 ret = 0;
115
116     while (slen > 0) {
117         switch (*s) {
118         case '\'':
119         case '\\':
120             *d = '\\';
121             ++d; ++ret;
122         default:
123             *d = *s;
124             ++d; ++s; --slen;
125             break;
126         }
127     }
128     return ret;
129 }
130
131 static I32
132 esc_q_utf8(pTHX_ SV* sv, register const char *src, register STRLEN slen)
133 {
134     char *r, *rstart;
135     const char *s = src;
136     const char * const send = src + slen;
137     STRLEN j, cur = SvCUR(sv);
138     /* Could count 128-255 and 256+ in two variables, if we want to
139        be like &qquote and make a distinction.  */
140     STRLEN grow = 0;    /* bytes needed to represent chars 128+ */
141     /* STRLEN topbit_grow = 0;  bytes needed to represent chars 128-255 */
142     STRLEN backslashes = 0;
143     STRLEN single_quotes = 0;
144     STRLEN qq_escapables = 0;   /* " $ @ will need a \ in "" strings.  */
145     STRLEN normal = 0;
146     int increment;
147
148     /* this will need EBCDICification */
149     for (s = src; s < send; s += increment) {
150         const UV k = utf8_to_uvchr((U8*)s, NULL);
151
152         /* check for invalid utf8 */
153         increment = (k == 0 && *s != '\0') ? 1 : UTF8SKIP(s);
154
155 #ifdef EBCDIC
156         if (!isprint(k) || k > 256) {
157 #else
158         if (k > 127) {
159 #endif
160             /* 4: \x{} then count the number of hex digits.  */
161             grow += 4 + (k <= 0xFF ? 2 : k <= 0xFFF ? 3 : k <= 0xFFFF ? 4 :
162 #if UVSIZE == 4
163                 8 /* We may allocate a bit more than the minimum here.  */
164 #else
165                 k <= 0xFFFFFFFF ? 8 : UVSIZE * 4
166 #endif
167                 );
168         } else if (k == '\\') {
169             backslashes++;
170         } else if (k == '\'') {
171             single_quotes++;
172         } else if (k == '"' || k == '$' || k == '@') {
173             qq_escapables++;
174         } else {
175             normal++;
176         }
177     }
178     if (grow) {
179         /* We have something needing hex. 3 is ""\0 */
180         sv_grow(sv, cur + 3 + grow + 2*backslashes + single_quotes
181                 + 2*qq_escapables + normal);
182         rstart = r = SvPVX(sv) + cur;
183
184         *r++ = '"';
185
186         for (s = src; s < send; s += UTF8SKIP(s)) {
187             const UV k = utf8_to_uvchr((U8*)s, NULL);
188
189             if (k == '"' || k == '\\' || k == '$' || k == '@') {
190                 *r++ = '\\';
191                 *r++ = (char)k;
192             }
193             else
194 #ifdef EBCDIC
195               if (isprint(k) && k < 256)
196 #else
197               if (k < 0x80)
198 #endif
199                 *r++ = (char)k;
200             else {
201 #if PERL_VERSION < 10
202                 sprintf(r, "\\x{%"UVxf"}", k);
203                 r += strlen(r);
204                 /* my_sprintf is not supported by ppport.h */
205 #else
206                 r = r + my_sprintf(r, "\\x{%"UVxf"}", k);
207 #endif
208             }
209         }
210         *r++ = '"';
211     } else {
212         /* Single quotes.  */
213         sv_grow(sv, cur + 3 + 2*backslashes + 2*single_quotes
214                 + qq_escapables + normal);
215         rstart = r = SvPVX(sv) + cur;
216         *r++ = '\'';
217         for (s = src; s < send; s ++) {
218             const char k = *s;
219             if (k == '\'' || k == '\\')
220                 *r++ = '\\';
221             *r++ = k;
222         }
223         *r++ = '\'';
224     }
225     *r = '\0';
226     j = r - rstart;
227     SvCUR_set(sv, cur + j);
228
229     return j;
230 }
231
232 /* append a repeated string to an SV */
233 static SV *
234 sv_x(pTHX_ SV *sv, const char *str, STRLEN len, I32 n)
235 {
236     if (!sv)
237         sv = newSVpvn("", 0);
238 #ifdef DEBUGGING
239     else
240         assert(SvTYPE(sv) >= SVt_PV);
241 #endif
242
243     if (n > 0) {
244         SvGROW(sv, len*n + SvCUR(sv) + 1);
245         if (len == 1) {
246             char * const start = SvPVX(sv) + SvCUR(sv);
247             SvCUR_set(sv, SvCUR(sv) + n);
248             start[n] = '\0';
249             while (n > 0)
250                 start[--n] = str[0];
251         }
252         else
253             while (n > 0) {
254                 sv_catpvn(sv, str, len);
255                 --n;
256             }
257     }
258     return sv;
259 }
260
261 /*
262  * This ought to be split into smaller functions. (it is one long function since
263  * it exactly parallels the perl version, which was one long thing for
264  * efficiency raisins.)  Ugggh!
265  */
266 static I32
267 DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
268         AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad,
269         SV *apad, SV *sep, SV *pair, SV *freezer, SV *toaster, I32 purity,
270         I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys)
271 {
272     char tmpbuf[128];
273     U32 i;
274     char *c, *r, *realpack;
275 #ifdef DD_USE_OLD_ID_FORMAT
276     char id[128];
277 #else
278     UV id_buffer;
279     char *const id = (char *)&id_buffer;
280 #endif
281     SV **svp;
282     SV *sv, *ipad, *ival;
283     SV *blesspad = Nullsv;
284     AV *seenentry = NULL;
285     char *iname;
286     STRLEN inamelen, idlen = 0;
287     U32 realtype;
288     bool no_bless = 0; /* when a qr// is blessed into Regexp we dont want to bless it.
289                           in later perls we should actually check the classname of the 
290                           engine. this gets tricky as it involves lexical issues that arent so
291                           easy to resolve */
292     bool is_regex = 0; /* we are dumping a regex, we need to know this before we bless */
293
294     if (!val)
295         return 0;
296
297     /* If the ouput buffer has less than some arbitrary amount of space
298        remaining, then enlarge it. For the test case (25M of output),
299        *1.1 was slower, *2.0 was the same, so the first guess of 1.5 is
300         deemed to be good enough.  */
301     if (SvTYPE(retval) >= SVt_PV && (SvLEN(retval) - SvCUR(retval)) < 42) {
302         sv_grow(retval, SvCUR(retval) * 3 / 2);
303     }
304
305     realtype = SvTYPE(val);
306
307     if (SvGMAGICAL(val))
308         mg_get(val);
309     if (SvROK(val)) {
310
311         /* If a freeze method is provided and the object has it, call
312            it.  Warn on errors. */
313         if (SvOBJECT(SvRV(val)) && freezer &&
314             SvPOK(freezer) && SvCUR(freezer) &&
315             gv_fetchmeth(SvSTASH(SvRV(val)), SvPVX_const(freezer), 
316                          SvCUR(freezer), -1) != NULL)
317         {
318             dSP; ENTER; SAVETMPS; PUSHMARK(sp);
319             XPUSHs(val); PUTBACK;
320             i = perl_call_method(SvPVX_const(freezer), G_EVAL|G_VOID);
321             SPAGAIN;
322             if (SvTRUE(ERRSV))
323                 warn("WARNING(Freezer method call failed): %"SVf"", ERRSV);
324             PUTBACK; FREETMPS; LEAVE;
325         }
326         
327         ival = SvRV(val);
328         realtype = SvTYPE(ival);
329 #ifdef DD_USE_OLD_ID_FORMAT
330         idlen = my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(ival));
331 #else
332         id_buffer = PTR2UV(ival);
333         idlen = sizeof(id_buffer);
334 #endif
335         if (SvOBJECT(ival))
336             realpack = HvNAME_get(SvSTASH(ival));
337         else
338             realpack = NULL;
339
340         /* if it has a name, we need to either look it up, or keep a tab
341          * on it so we know when we hit it later
342          */
343         if (namelen) {
344             if ((svp = hv_fetch(seenhv, id, idlen, FALSE))
345                 && (sv = *svp) && SvROK(sv) && (seenentry = (AV*)SvRV(sv)))
346             {
347                 SV *othername;
348                 if ((svp = av_fetch(seenentry, 0, FALSE))
349                     && (othername = *svp))
350                 {
351                     if (purity && *levelp > 0) {
352                         SV *postentry;
353                         
354                         if (realtype == SVt_PVHV)
355                             sv_catpvn(retval, "{}", 2);
356                         else if (realtype == SVt_PVAV)
357                             sv_catpvn(retval, "[]", 2);
358                         else
359                             sv_catpvn(retval, "do{my $o}", 9);
360                         postentry = newSVpvn(name, namelen);
361                         sv_catpvn(postentry, " = ", 3);
362                         sv_catsv(postentry, othername);
363                         av_push(postav, postentry);
364                     }
365                     else {
366                         if (name[0] == '@' || name[0] == '%') {
367                             if ((SvPVX_const(othername))[0] == '\\' &&
368                                 (SvPVX_const(othername))[1] == name[0]) {
369                                 sv_catpvn(retval, SvPVX_const(othername)+1,
370                                           SvCUR(othername)-1);
371                             }
372                             else {
373                                 sv_catpvn(retval, name, 1);
374                                 sv_catpvn(retval, "{", 1);
375                                 sv_catsv(retval, othername);
376                                 sv_catpvn(retval, "}", 1);
377                             }
378                         }
379                         else
380                             sv_catsv(retval, othername);
381                     }
382                     return 1;
383                 }
384                 else {
385 #ifdef DD_USE_OLD_ID_FORMAT
386                     warn("ref name not found for %s", id);
387 #else
388                     warn("ref name not found for 0x%"UVxf, PTR2UV(ival));
389 #endif
390                     return 0;
391                 }
392             }
393             else {   /* store our name and continue */
394                 SV *namesv;
395                 if (name[0] == '@' || name[0] == '%') {
396                     namesv = newSVpvn("\\", 1);
397                     sv_catpvn(namesv, name, namelen);
398                 }
399                 else if (realtype == SVt_PVCV && name[0] == '*') {
400                     namesv = newSVpvn("\\", 2);
401                     sv_catpvn(namesv, name, namelen);
402                     (SvPVX(namesv))[1] = '&';
403                 }
404                 else
405                     namesv = newSVpvn(name, namelen);
406                 seenentry = newAV();
407                 av_push(seenentry, namesv);
408                 (void)SvREFCNT_inc(val);
409                 av_push(seenentry, val);
410                 (void)hv_store(seenhv, id, idlen,
411                                newRV_inc((SV*)seenentry), 0);
412                 SvREFCNT_dec(seenentry);
413             }
414         }
415         /* regexps dont have to be blessed into package "Regexp"
416          * they can be blessed into any package. 
417          */
418 #if PERL_VERSION < 8
419         if (realpack && *realpack == 'R' && strEQ(realpack, "Regexp")) 
420 #elif PERL_VERSION < 11
421         if (realpack && realtype == SVt_PVMG && mg_find(ival, PERL_MAGIC_qr))
422 #else        
423         if (realpack && realtype == SVt_REGEXP) 
424 #endif
425         {
426             is_regex = 1;
427             if (strEQ(realpack, "Regexp")) 
428                 no_bless = 1;
429             else
430                 no_bless = 0;
431         }
432
433         /* If purity is not set and maxdepth is set, then check depth:
434          * if we have reached maximum depth, return the string
435          * representation of the thing we are currently examining
436          * at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
437          */
438         if (!purity && maxdepth > 0 && *levelp >= maxdepth) {
439             STRLEN vallen;
440             const char * const valstr = SvPV(val,vallen);
441             sv_catpvn(retval, "'", 1);
442             sv_catpvn(retval, valstr, vallen);
443             sv_catpvn(retval, "'", 1);
444             return 1;
445         }
446
447         if (realpack && !no_bless) {                            /* we have a blessed ref */
448             STRLEN blesslen;
449             const char * const blessstr = SvPV(bless, blesslen);
450             sv_catpvn(retval, blessstr, blesslen);
451             sv_catpvn(retval, "( ", 2);
452             if (indent >= 2) {
453                 blesspad = apad;
454                 apad = newSVsv(apad);
455                 sv_x(aTHX_ apad, " ", 1, blesslen+2);
456             }
457         }
458
459         (*levelp)++;
460         ipad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), *levelp);
461
462         if (is_regex) 
463         {
464             STRLEN rlen;
465             const char *rval = SvPV(val, rlen);
466             const char *slash = strchr(rval, '/');
467             sv_catpvn(retval, "qr/", 3);
468             while (slash) {
469                 sv_catpvn(retval, rval, slash-rval);
470                 sv_catpvn(retval, "\\/", 2);
471                 rlen -= slash-rval+1;
472                 rval = slash+1;
473                 slash = strchr(rval, '/');
474             }
475             sv_catpvn(retval, rval, rlen);
476             sv_catpvn(retval, "/", 1);
477         } 
478         else if (
479 #if PERL_VERSION < 9
480                 realtype <= SVt_PVBM
481 #else
482                 realtype <= SVt_PVMG
483 #endif
484         ) {                          /* scalar ref */
485             SV * const namesv = newSVpvn("${", 2);
486             sv_catpvn(namesv, name, namelen);
487             sv_catpvn(namesv, "}", 1);
488             if (realpack) {                                  /* blessed */
489                 sv_catpvn(retval, "do{\\(my $o = ", 13);
490                 DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
491                         postav, levelp, indent, pad, xpad, apad, sep, pair,
492                         freezer, toaster, purity, deepcopy, quotekeys, bless,
493                         maxdepth, sortkeys);
494                 sv_catpvn(retval, ")}", 2);
495             }                                                /* plain */
496             else {
497                 sv_catpvn(retval, "\\", 1);
498                 DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
499                         postav, levelp, indent, pad, xpad, apad, sep, pair,
500                         freezer, toaster, purity, deepcopy, quotekeys, bless,
501                         maxdepth, sortkeys);
502             }
503             SvREFCNT_dec(namesv);
504         }
505         else if (realtype == SVt_PVGV) {                     /* glob ref */
506             SV * const namesv = newSVpvn("*{", 2);
507             sv_catpvn(namesv, name, namelen);
508             sv_catpvn(namesv, "}", 1);
509             sv_catpvn(retval, "\\", 1);
510             DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
511                     postav, levelp,     indent, pad, xpad, apad, sep, pair,
512                     freezer, toaster, purity, deepcopy, quotekeys, bless,
513                     maxdepth, sortkeys);
514             SvREFCNT_dec(namesv);
515         }
516         else if (realtype == SVt_PVAV) {
517             SV *totpad;
518             I32 ix = 0;
519             const I32 ixmax = av_len((AV *)ival);
520         
521             SV * const ixsv = newSViv(0);
522             /* allowing for a 24 char wide array index */
523             New(0, iname, namelen+28, char);
524             (void)strcpy(iname, name);
525             inamelen = namelen;
526             if (name[0] == '@') {
527                 sv_catpvn(retval, "(", 1);
528                 iname[0] = '$';
529             }
530             else {
531                 sv_catpvn(retval, "[", 1);
532                 /* omit "->" in $foo{bar}->[0], but not in ${$foo}->[0] */
533                 /*if (namelen > 0
534                     && name[namelen-1] != ']' && name[namelen-1] != '}'
535                     && (namelen < 4 || (name[1] != '{' && name[2] != '{')))*/
536                 if ((namelen > 0
537                      && name[namelen-1] != ']' && name[namelen-1] != '}')
538                     || (namelen > 4
539                         && (name[1] == '{'
540                             || (name[0] == '\\' && name[2] == '{'))))
541                 {
542                     iname[inamelen++] = '-'; iname[inamelen++] = '>';
543                     iname[inamelen] = '\0';
544                 }
545             }
546             if (iname[0] == '*' && iname[inamelen-1] == '}' && inamelen >= 8 &&
547                 (instr(iname+inamelen-8, "{SCALAR}") ||
548                  instr(iname+inamelen-7, "{ARRAY}") ||
549                  instr(iname+inamelen-6, "{HASH}"))) {
550                 iname[inamelen++] = '-'; iname[inamelen++] = '>';
551             }
552             iname[inamelen++] = '['; iname[inamelen] = '\0';
553             totpad = newSVsv(sep);
554             sv_catsv(totpad, pad);
555             sv_catsv(totpad, apad);
556
557             for (ix = 0; ix <= ixmax; ++ix) {
558                 STRLEN ilen;
559                 SV *elem;
560                 svp = av_fetch((AV*)ival, ix, FALSE);
561                 if (svp)
562                     elem = *svp;
563                 else
564                     elem = &PL_sv_undef;
565                 
566                 ilen = inamelen;
567                 sv_setiv(ixsv, ix);
568 #if PERL_VERSION < 10
569                 (void) sprintf(iname+ilen, "%"IVdf, (IV)ix);
570                 ilen = strlen(iname);
571 #else
572                 ilen = ilen + my_sprintf(iname+ilen, "%"IVdf, (IV)ix);
573 #endif
574                 iname[ilen++] = ']'; iname[ilen] = '\0';
575                 if (indent >= 3) {
576                     sv_catsv(retval, totpad);
577                     sv_catsv(retval, ipad);
578                     sv_catpvn(retval, "#", 1);
579                     sv_catsv(retval, ixsv);
580                 }
581                 sv_catsv(retval, totpad);
582                 sv_catsv(retval, ipad);
583                 DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
584                         levelp, indent, pad, xpad, apad, sep, pair,
585                         freezer, toaster, purity, deepcopy, quotekeys, bless,
586                         maxdepth, sortkeys);
587                 if (ix < ixmax)
588                     sv_catpvn(retval, ",", 1);
589             }
590             if (ixmax >= 0) {
591                 SV * const opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), (*levelp)-1);
592                 sv_catsv(retval, totpad);
593                 sv_catsv(retval, opad);
594                 SvREFCNT_dec(opad);
595             }
596             if (name[0] == '@')
597                 sv_catpvn(retval, ")", 1);
598             else
599                 sv_catpvn(retval, "]", 1);
600             SvREFCNT_dec(ixsv);
601             SvREFCNT_dec(totpad);
602             Safefree(iname);
603         }
604         else if (realtype == SVt_PVHV) {
605             SV *totpad, *newapad;
606             SV *sname;
607             HE *entry;
608             char *key;
609             I32 klen;
610             SV *hval;
611             AV *keys = NULL;
612         
613             SV * const iname = newSVpvn(name, namelen);
614             if (name[0] == '%') {
615                 sv_catpvn(retval, "(", 1);
616                 (SvPVX(iname))[0] = '$';
617             }
618             else {
619                 sv_catpvn(retval, "{", 1);
620                 /* omit "->" in $foo[0]->{bar}, but not in ${$foo}->{bar} */
621                 if ((namelen > 0
622                      && name[namelen-1] != ']' && name[namelen-1] != '}')
623                     || (namelen > 4
624                         && (name[1] == '{'
625                             || (name[0] == '\\' && name[2] == '{'))))
626                 {
627                     sv_catpvn(iname, "->", 2);
628                 }
629             }
630             if (name[0] == '*' && name[namelen-1] == '}' && namelen >= 8 &&
631                 (instr(name+namelen-8, "{SCALAR}") ||
632                  instr(name+namelen-7, "{ARRAY}") ||
633                  instr(name+namelen-6, "{HASH}"))) {
634                 sv_catpvn(iname, "->", 2);
635             }
636             sv_catpvn(iname, "{", 1);
637             totpad = newSVsv(sep);
638             sv_catsv(totpad, pad);
639             sv_catsv(totpad, apad);
640         
641             /* If requested, get a sorted/filtered array of hash keys */
642             if (sortkeys) {
643                 if (sortkeys == &PL_sv_yes) {
644 #if PERL_VERSION < 8
645                     sortkeys = sv_2mortal(newSVpvn("Data::Dumper::_sortkeys", 23));
646 #else
647                     keys = newAV();
648                     (void)hv_iterinit((HV*)ival);
649                     while ((entry = hv_iternext((HV*)ival))) {
650                         sv = hv_iterkeysv(entry);
651                         SvREFCNT_inc(sv);
652                         av_push(keys, sv);
653                     }
654 # ifdef USE_LOCALE_NUMERIC
655                     sortsv(AvARRAY(keys), 
656                            av_len(keys)+1, 
657                            IN_LOCALE ? Perl_sv_cmp_locale : Perl_sv_cmp);
658 # else
659                     sortsv(AvARRAY(keys), 
660                            av_len(keys)+1, 
661                            Perl_sv_cmp);
662 # endif
663 #endif
664                 }
665                 if (sortkeys != &PL_sv_yes) {
666                     dSP; ENTER; SAVETMPS; PUSHMARK(sp);
667                     XPUSHs(sv_2mortal(newRV_inc(ival))); PUTBACK;
668                     i = perl_call_sv(sortkeys, G_SCALAR | G_EVAL);
669                     SPAGAIN;
670                     if (i) {
671                         sv = POPs;
672                         if (SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVAV))
673                             keys = (AV*)SvREFCNT_inc(SvRV(sv));
674                     }
675                     if (! keys)
676                         warn("Sortkeys subroutine did not return ARRAYREF\n");
677                     PUTBACK; FREETMPS; LEAVE;
678                 }
679                 if (keys)
680                     sv_2mortal((SV*)keys);
681             }
682             else
683                 (void)hv_iterinit((HV*)ival);
684
685             /* foreach (keys %hash) */
686             for (i = 0; 1; i++) {
687                 char *nkey;
688                 char *nkey_buffer = NULL;
689                 I32 nticks = 0;
690                 SV* keysv;
691                 STRLEN keylen;
692                 I32 nlen;
693                 bool do_utf8 = FALSE;
694
695                if (sortkeys) {
696                    if (!(keys && (I32)i <= av_len(keys))) break;
697                } else {
698                    if (!(entry = hv_iternext((HV *)ival))) break;
699                }
700
701                 if (i)
702                     sv_catpvn(retval, ",", 1);
703
704                 if (sortkeys) {
705                     char *key;
706                     svp = av_fetch(keys, i, FALSE);
707                     keysv = svp ? *svp : sv_newmortal();
708                     key = SvPV(keysv, keylen);
709                     svp = hv_fetch((HV*)ival, key,
710                                    SvUTF8(keysv) ? -(I32)keylen : (I32)keylen, 0);
711                     hval = svp ? *svp : sv_newmortal();
712                 }
713                 else {
714                     keysv = hv_iterkeysv(entry);
715                     hval = hv_iterval((HV*)ival, entry);
716                 }
717
718                 key = SvPV(keysv, keylen);
719                 do_utf8 = DO_UTF8(keysv);
720                 klen = keylen;
721
722                 sv_catsv(retval, totpad);
723                 sv_catsv(retval, ipad);
724                 /* old logic was first to check utf8 flag, and if utf8 always
725                    call esc_q_utf8.  This caused test to break under -Mutf8,
726                    because there even strings like 'c' have utf8 flag on.
727                    Hence with quotekeys == 0 the XS code would still '' quote
728                    them based on flags, whereas the perl code would not,
729                    based on regexps.
730                    The perl code is correct.
731                    needs_quote() decides that anything that isn't a valid
732                    perl identifier needs to be quoted, hence only correctly
733                    formed strings with no characters outside [A-Za-z0-9_:]
734                    won't need quoting.  None of those characters are used in
735                    the byte encoding of utf8, so anything with utf8
736                    encoded characters in will need quoting. Hence strings
737                    with utf8 encoded characters in will end up inside do_utf8
738                    just like before, but now strings with utf8 flag set but
739                    only ascii characters will end up in the unquoted section.
740
741                    There should also be less tests for the (probably currently)
742                    more common doesn't need quoting case.
743                    The code is also smaller (22044 vs 22260) because I've been
744                    able to pull the common logic out to both sides.  */
745                 if (quotekeys || needs_quote(key,keylen)) {
746                     if (do_utf8) {
747                         STRLEN ocur = SvCUR(retval);
748                         nlen = esc_q_utf8(aTHX_ retval, key, klen);
749                         nkey = SvPVX(retval) + ocur;
750                     }
751                     else {
752                         nticks = num_q(key, klen);
753                         New(0, nkey_buffer, klen+nticks+3, char);
754                         nkey = nkey_buffer;
755                         nkey[0] = '\'';
756                         if (nticks)
757                             klen += esc_q(nkey+1, key, klen);
758                         else
759                             (void)Copy(key, nkey+1, klen, char);
760                         nkey[++klen] = '\'';
761                         nkey[++klen] = '\0';
762                         nlen = klen;
763                         sv_catpvn(retval, nkey, klen);
764                     }
765                 }
766                 else {
767                     nkey = key;
768                     nlen = klen;
769                     sv_catpvn(retval, nkey, klen);
770                 }
771                 sname = newSVsv(iname);
772                 sv_catpvn(sname, nkey, nlen);
773                 sv_catpvn(sname, "}", 1);
774
775                 sv_catsv(retval, pair);
776                 if (indent >= 2) {
777                     char *extra;
778                     I32 elen = 0;
779                     newapad = newSVsv(apad);
780                     New(0, extra, klen+4+1, char);
781                     while (elen < (klen+4))
782                         extra[elen++] = ' ';
783                     extra[elen] = '\0';
784                     sv_catpvn(newapad, extra, elen);
785                     Safefree(extra);
786                 }
787                 else
788                     newapad = apad;
789
790                 DD_dump(aTHX_ hval, SvPVX_const(sname), SvCUR(sname), retval, seenhv,
791                         postav, levelp, indent, pad, xpad, newapad, sep, pair,
792                         freezer, toaster, purity, deepcopy, quotekeys, bless,
793                         maxdepth, sortkeys);
794                 SvREFCNT_dec(sname);
795                 Safefree(nkey_buffer);
796                 if (indent >= 2)
797                     SvREFCNT_dec(newapad);
798             }
799             if (i) {
800                 SV *opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), *levelp-1);
801                 sv_catsv(retval, totpad);
802                 sv_catsv(retval, opad);
803                 SvREFCNT_dec(opad);
804             }
805             if (name[0] == '%')
806                 sv_catpvn(retval, ")", 1);
807             else
808                 sv_catpvn(retval, "}", 1);
809             SvREFCNT_dec(iname);
810             SvREFCNT_dec(totpad);
811         }
812         else if (realtype == SVt_PVCV) {
813             sv_catpvn(retval, "sub { \"DUMMY\" }", 15);
814             if (purity)
815                 warn("Encountered CODE ref, using dummy placeholder");
816         }
817         else {
818             warn("cannot handle ref type %d", (int)realtype);
819         }
820
821         if (realpack && !no_bless) {  /* free blessed allocs */
822             I32 plen;
823             I32 pticks;
824
825             if (indent >= 2) {
826                 SvREFCNT_dec(apad);
827                 apad = blesspad;
828             }
829             sv_catpvn(retval, ", '", 3);
830
831             plen = strlen(realpack);
832             pticks = num_q(realpack, plen);
833             if (pticks) { /* needs escaping */
834                 char *npack;
835                 char *npack_buffer = NULL;
836
837                 New(0, npack_buffer, plen+pticks+1, char);
838                 npack = npack_buffer;
839                 plen += esc_q(npack, realpack, plen);
840                 npack[plen] = '\0';
841
842                 sv_catpvn(retval, npack, plen);
843                 Safefree(npack_buffer);
844             }
845             else {
846                 sv_catpvn(retval, realpack, strlen(realpack));
847             }
848             sv_catpvn(retval, "' )", 3);
849             if (toaster && SvPOK(toaster) && SvCUR(toaster)) {
850                 sv_catpvn(retval, "->", 2);
851                 sv_catsv(retval, toaster);
852                 sv_catpvn(retval, "()", 2);
853             }
854         }
855         SvREFCNT_dec(ipad);
856         (*levelp)--;
857     }
858     else {
859         STRLEN i;
860         const MAGIC *mg;
861         
862         if (namelen) {
863 #ifdef DD_USE_OLD_ID_FORMAT
864             idlen = my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(val));
865 #else
866             id_buffer = PTR2UV(val);
867             idlen = sizeof(id_buffer);
868 #endif
869             if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) &&
870                 (sv = *svp) && SvROK(sv) &&
871                 (seenentry = (AV*)SvRV(sv)))
872             {
873                 SV *othername;
874                 if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)
875                     && (svp = av_fetch(seenentry, 2, FALSE)) && *svp && SvIV(*svp) > 0)
876                 {
877                     sv_catpvn(retval, "${", 2);
878                     sv_catsv(retval, othername);
879                     sv_catpvn(retval, "}", 1);
880                     return 1;
881                 }
882             }
883             else if (val != &PL_sv_undef) {
884                 SV * const namesv = newSVpvn("\\", 1);
885                 sv_catpvn(namesv, name, namelen);
886                 seenentry = newAV();
887                 av_push(seenentry, namesv);
888                 av_push(seenentry, newRV_inc(val));
889                 (void)hv_store(seenhv, id, idlen, newRV_inc((SV*)seenentry), 0);
890                 SvREFCNT_dec(seenentry);
891             }
892         }
893
894         if (DD_is_integer(val)) {
895             STRLEN len;
896             if (SvIsUV(val))
897               len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"UVuf, SvUV(val));
898             else
899               len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"IVdf, SvIV(val));
900             if (SvPOK(val)) {
901               /* Need to check to see if this is a string such as " 0".
902                  I'm assuming from sprintf isn't going to clash with utf8.
903                  Is this valid on EBCDIC?  */
904               STRLEN pvlen;
905               const char * const pv = SvPV(val, pvlen);
906               if (pvlen != len || memNE(pv, tmpbuf, len))
907                 goto integer_came_from_string;
908             }
909             if (len > 10) {
910               /* Looks like we're on a 64 bit system.  Make it a string so that
911                  if a 32 bit system reads the number it will cope better.  */
912               sv_catpvf(retval, "'%s'", tmpbuf);
913             } else
914               sv_catpvn(retval, tmpbuf, len);
915         }
916         else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */
917             c = SvPV(val, i);
918             if(i) ++c, --i;                     /* just get the name */
919             if (i >= 6 && strncmp(c, "main::", 6) == 0) {
920                 c += 4;
921 #if PERL_VERSION < 7
922                 if (i == 6 || (i == 7 && c[6] == '\0'))
923 #else
924                 if (i == 6)
925 #endif
926                     i = 0; else i -= 4;
927             }
928             if (needs_quote(c,i)) {
929 #ifdef GvNAMEUTF8
930               if (GvNAMEUTF8(val)) {
931                 sv_grow(retval, SvCUR(retval)+2);
932                 r = SvPVX(retval)+SvCUR(retval);
933                 r[0] = '*'; r[1] = '{';
934                 SvCUR_set(retval, SvCUR(retval)+2);
935                 esc_q_utf8(aTHX_ retval, c, i);
936                 sv_grow(retval, SvCUR(retval)+2);
937                 r = SvPVX(retval)+SvCUR(retval);
938                 r[0] = '}'; r[1] = '\0';
939                 i = 1;
940               }
941               else
942 #endif
943               {
944                 sv_grow(retval, SvCUR(retval)+6+2*i);
945                 r = SvPVX(retval)+SvCUR(retval);
946                 r[0] = '*'; r[1] = '{'; r[2] = '\'';
947                 i += esc_q(r+3, c, i);
948                 i += 3;
949                 r[i++] = '\''; r[i++] = '}';
950                 r[i] = '\0';
951               }
952             }
953             else {
954                 sv_grow(retval, SvCUR(retval)+i+2);
955                 r = SvPVX(retval)+SvCUR(retval);
956                 r[0] = '*'; strcpy(r+1, c);
957                 i++;
958             }
959             SvCUR_set(retval, SvCUR(retval)+i);
960
961             if (purity) {
962                 static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
963                 static const STRLEN sizes[] = { 8, 7, 6 };
964                 SV *e;
965                 SV * const nname = newSVpvn("", 0);
966                 SV * const newapad = newSVpvn("", 0);
967                 GV * const gv = (GV*)val;
968                 I32 j;
969                 
970                 for (j=0; j<3; j++) {
971                     e = ((j == 0) ? GvSV(gv) : (j == 1) ? (SV*)GvAV(gv) : (SV*)GvHV(gv));
972                     if (!e)
973                         continue;
974                     if (j == 0 && !SvOK(e))
975                         continue;
976
977                     {
978                         I32 nlevel = 0;
979                         SV *postentry = newSVpvn(r,i);
980                         
981                         sv_setsv(nname, postentry);
982                         sv_catpvn(nname, entries[j], sizes[j]);
983                         sv_catpvn(postentry, " = ", 3);
984                         av_push(postav, postentry);
985                         e = newRV_inc(e);
986                         
987                         SvCUR_set(newapad, 0);
988                         if (indent >= 2)
989                             (void)sv_x(aTHX_ newapad, " ", 1, SvCUR(postentry));
990                         
991                         DD_dump(aTHX_ e, SvPVX_const(nname), SvCUR(nname), postentry,
992                                 seenhv, postav, &nlevel, indent, pad, xpad,
993                                 newapad, sep, pair, freezer, toaster, purity,
994                                 deepcopy, quotekeys, bless, maxdepth, 
995                                 sortkeys);
996                         SvREFCNT_dec(e);
997                     }
998                 }
999                 
1000                 SvREFCNT_dec(newapad);
1001                 SvREFCNT_dec(nname);
1002             }
1003         }
1004         else if (val == &PL_sv_undef || !SvOK(val)) {
1005             sv_catpvn(retval, "undef", 5);
1006         }
1007 #ifdef SvVOK
1008         else if (SvMAGICAL(val) && (mg = mg_find(val, 'V'))) {
1009 # ifndef PL_vtbl_vstring
1010             SV * const vecsv = sv_newmortal();
1011 #  if PERL_VERSION < 10
1012             scan_vstring(mg->mg_ptr, vecsv);
1013 #  else
1014             scan_vstring(mg->mg_ptr, mg->mg_ptr + mg->mg_len, vecsv);
1015 #  endif
1016             if (!sv_eq(vecsv, val)) goto integer_came_from_string;
1017 # endif
1018             sv_catpvn(retval, (const char *)mg->mg_ptr, mg->mg_len);
1019         }
1020 #endif
1021         else {
1022         integer_came_from_string:
1023             c = SvPV(val, i);
1024             if (DO_UTF8(val))
1025                 i += esc_q_utf8(aTHX_ retval, c, i);
1026             else {
1027                 sv_grow(retval, SvCUR(retval)+3+2*i); /* 3: ""\0 */
1028                 r = SvPVX(retval) + SvCUR(retval);
1029                 r[0] = '\'';
1030                 i += esc_q(r+1, c, i);
1031                 ++i;
1032                 r[i++] = '\'';
1033                 r[i] = '\0';
1034                 SvCUR_set(retval, SvCUR(retval)+i);
1035             }
1036         }
1037     }
1038
1039     if (idlen) {
1040         if (deepcopy)
1041             (void)hv_delete(seenhv, id, idlen, G_DISCARD);
1042         else if (namelen && seenentry) {
1043             SV *mark = *av_fetch(seenentry, 2, TRUE);
1044             sv_setiv(mark,1);
1045         }
1046     }
1047     return 1;
1048 }
1049
1050
1051 MODULE = Data::Dumper           PACKAGE = Data::Dumper         PREFIX = Data_Dumper_
1052
1053 #
1054 # This is the exact equivalent of Dump.  Well, almost. The things that are
1055 # different as of now (due to Laziness):
1056 #   * doesn't do double-quotes yet.
1057 #
1058
1059 void
1060 Data_Dumper_Dumpxs(href, ...)
1061         SV      *href;
1062         PROTOTYPE: $;$$
1063         PPCODE:
1064         {
1065             HV *hv;
1066             SV *retval, *valstr;
1067             HV *seenhv = NULL;
1068             AV *postav, *todumpav, *namesav;
1069             I32 level = 0;
1070             I32 indent, terse, i, imax, postlen;
1071             SV **svp;
1072             SV *val, *name, *pad, *xpad, *apad, *sep, *pair, *varname;
1073             SV *freezer, *toaster, *bless, *sortkeys;
1074             I32 purity, deepcopy, quotekeys, maxdepth = 0;
1075             char tmpbuf[1024];
1076             I32 gimme = GIMME;
1077
1078             if (!SvROK(href)) {         /* call new to get an object first */
1079                 if (items < 2)
1080                     croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, [NAME_ARY_REF])");
1081                 
1082                 ENTER;
1083                 SAVETMPS;
1084                 
1085                 PUSHMARK(sp);
1086                 XPUSHs(href);
1087                 XPUSHs(sv_2mortal(newSVsv(ST(1))));
1088                 if (items >= 3)
1089                     XPUSHs(sv_2mortal(newSVsv(ST(2))));
1090                 PUTBACK;
1091                 i = perl_call_method("new", G_SCALAR);
1092                 SPAGAIN;
1093                 if (i)
1094                     href = newSVsv(POPs);
1095
1096                 PUTBACK;
1097                 FREETMPS;
1098                 LEAVE;
1099                 if (i)
1100                     (void)sv_2mortal(href);
1101             }
1102
1103             todumpav = namesav = NULL;
1104             seenhv = NULL;
1105             val = pad = xpad = apad = sep = pair = varname
1106                 = freezer = toaster = bless = sortkeys = &PL_sv_undef;
1107             name = sv_newmortal();
1108             indent = 2;
1109             terse = purity = deepcopy = 0;
1110             quotekeys = 1;
1111         
1112             retval = newSVpvn("", 0);
1113             if (SvROK(href)
1114                 && (hv = (HV*)SvRV((SV*)href))
1115                 && SvTYPE(hv) == SVt_PVHV)              {
1116
1117                 if ((svp = hv_fetch(hv, "seen", 4, FALSE)) && SvROK(*svp))
1118                     seenhv = (HV*)SvRV(*svp);
1119                 if ((svp = hv_fetch(hv, "todump", 6, FALSE)) && SvROK(*svp))
1120                     todumpav = (AV*)SvRV(*svp);
1121                 if ((svp = hv_fetch(hv, "names", 5, FALSE)) && SvROK(*svp))
1122                     namesav = (AV*)SvRV(*svp);
1123                 if ((svp = hv_fetch(hv, "indent", 6, FALSE)))
1124                     indent = SvIV(*svp);
1125                 if ((svp = hv_fetch(hv, "purity", 6, FALSE)))
1126                     purity = SvIV(*svp);
1127                 if ((svp = hv_fetch(hv, "terse", 5, FALSE)))
1128                     terse = SvTRUE(*svp);
1129 #if 0 /* useqq currently unused */
1130                 if ((svp = hv_fetch(hv, "useqq", 5, FALSE)))
1131                     useqq = SvTRUE(*svp);
1132 #endif
1133                 if ((svp = hv_fetch(hv, "pad", 3, FALSE)))
1134                     pad = *svp;
1135                 if ((svp = hv_fetch(hv, "xpad", 4, FALSE)))
1136                     xpad = *svp;
1137                 if ((svp = hv_fetch(hv, "apad", 4, FALSE)))
1138                     apad = *svp;
1139                 if ((svp = hv_fetch(hv, "sep", 3, FALSE)))
1140                     sep = *svp;
1141                 if ((svp = hv_fetch(hv, "pair", 4, FALSE)))
1142                     pair = *svp;
1143                 if ((svp = hv_fetch(hv, "varname", 7, FALSE)))
1144                     varname = *svp;
1145                 if ((svp = hv_fetch(hv, "freezer", 7, FALSE)))
1146                     freezer = *svp;
1147                 if ((svp = hv_fetch(hv, "toaster", 7, FALSE)))
1148                     toaster = *svp;
1149                 if ((svp = hv_fetch(hv, "deepcopy", 8, FALSE)))
1150                     deepcopy = SvTRUE(*svp);
1151                 if ((svp = hv_fetch(hv, "quotekeys", 9, FALSE)))
1152                     quotekeys = SvTRUE(*svp);
1153                 if ((svp = hv_fetch(hv, "bless", 5, FALSE)))
1154                     bless = *svp;
1155                 if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE)))
1156                     maxdepth = SvIV(*svp);
1157                 if ((svp = hv_fetch(hv, "sortkeys", 8, FALSE))) {
1158                     sortkeys = *svp;
1159                     if (! SvTRUE(sortkeys))
1160                         sortkeys = NULL;
1161                     else if (! (SvROK(sortkeys) &&
1162                                 SvTYPE(SvRV(sortkeys)) == SVt_PVCV) )
1163                     {
1164                         /* flag to use qsortsv() for sorting hash keys */       
1165                         sortkeys = &PL_sv_yes; 
1166                     }
1167                 }
1168                 postav = newAV();
1169
1170                 if (todumpav)
1171                     imax = av_len(todumpav);
1172                 else
1173                     imax = -1;
1174                 valstr = newSVpvn("",0);
1175                 for (i = 0; i <= imax; ++i) {
1176                     SV *newapad;
1177                 
1178                     av_clear(postav);
1179                     if ((svp = av_fetch(todumpav, i, FALSE)))
1180                         val = *svp;
1181                     else
1182                         val = &PL_sv_undef;
1183                     if ((svp = av_fetch(namesav, i, TRUE))) {
1184                         sv_setsv(name, *svp);
1185                         if (SvOK(*svp) && !SvPOK(*svp))
1186                             (void)SvPV_nolen_const(name);
1187                     }
1188                     else
1189                         (void)SvOK_off(name);
1190                 
1191                     if (SvPOK(name)) {
1192                         if ((SvPVX_const(name))[0] == '*') {
1193                             if (SvROK(val)) {
1194                                 switch (SvTYPE(SvRV(val))) {
1195                                 case SVt_PVAV:
1196                                     (SvPVX(name))[0] = '@';
1197                                     break;
1198                                 case SVt_PVHV:
1199                                     (SvPVX(name))[0] = '%';
1200                                     break;
1201                                 case SVt_PVCV:
1202                                     (SvPVX(name))[0] = '*';
1203                                     break;
1204                                 default:
1205                                     (SvPVX(name))[0] = '$';
1206                                     break;
1207                                 }
1208                             }
1209                             else
1210                                 (SvPVX(name))[0] = '$';
1211                         }
1212                         else if ((SvPVX_const(name))[0] != '$')
1213                             sv_insert(name, 0, 0, "$", 1);
1214                     }
1215                     else {
1216                         STRLEN nchars;
1217                         sv_setpvn(name, "$", 1);
1218                         sv_catsv(name, varname);
1219                         nchars = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"IVdf, (IV)(i+1));
1220                         sv_catpvn(name, tmpbuf, nchars);
1221                     }
1222                 
1223                     if (indent >= 2 && !terse) {
1224                         SV * const tmpsv = sv_x(aTHX_ NULL, " ", 1, SvCUR(name)+3);
1225                         newapad = newSVsv(apad);
1226                         sv_catsv(newapad, tmpsv);
1227                         SvREFCNT_dec(tmpsv);
1228                     }
1229                     else
1230                         newapad = apad;
1231                 
1232                     PUTBACK;
1233                     DD_dump(aTHX_ val, SvPVX_const(name), SvCUR(name), valstr, seenhv,
1234                             postav, &level, indent, pad, xpad, newapad, sep, pair,
1235                             freezer, toaster, purity, deepcopy, quotekeys,
1236                             bless, maxdepth, sortkeys);
1237                     SPAGAIN;
1238                 
1239                     if (indent >= 2 && !terse)
1240                         SvREFCNT_dec(newapad);
1241
1242                     postlen = av_len(postav);
1243                     if (postlen >= 0 || !terse) {
1244                         sv_insert(valstr, 0, 0, " = ", 3);
1245                         sv_insert(valstr, 0, 0, SvPVX_const(name), SvCUR(name));
1246                         sv_catpvn(valstr, ";", 1);
1247                     }
1248                     sv_catsv(retval, pad);
1249                     sv_catsv(retval, valstr);
1250                     sv_catsv(retval, sep);
1251                     if (postlen >= 0) {
1252                         I32 i;
1253                         sv_catsv(retval, pad);
1254                         for (i = 0; i <= postlen; ++i) {
1255                             SV *elem;
1256                             svp = av_fetch(postav, i, FALSE);
1257                             if (svp && (elem = *svp)) {
1258                                 sv_catsv(retval, elem);
1259                                 if (i < postlen) {
1260                                     sv_catpvn(retval, ";", 1);
1261                                     sv_catsv(retval, sep);
1262                                     sv_catsv(retval, pad);
1263                                 }
1264                             }
1265                         }
1266                         sv_catpvn(retval, ";", 1);
1267                             sv_catsv(retval, sep);
1268                     }
1269                     sv_setpvn(valstr, "", 0);
1270                     if (gimme == G_ARRAY) {
1271                         XPUSHs(sv_2mortal(retval));
1272                         if (i < imax)   /* not the last time thro ? */
1273                             retval = newSVpvn("",0);
1274                     }
1275                 }
1276                 SvREFCNT_dec(postav);
1277                 SvREFCNT_dec(valstr);
1278             }
1279             else
1280                 croak("Call to new() method failed to return HASH ref");
1281             if (gimme == G_SCALAR)
1282                 XPUSHs(sv_2mortal(retval));
1283         }
1284
1285 SV *
1286 Data_Dumper__vstring(sv)
1287         SV      *sv;
1288         PROTOTYPE: $
1289         CODE:
1290         {
1291 #ifdef SvVOK
1292             const MAGIC *mg;
1293             RETVAL =
1294                 SvMAGICAL(sv) && (mg = mg_find(sv, 'V'))
1295                  ? newSVpvn((const char *)mg->mg_ptr, mg->mg_len)
1296                  : &PL_sv_undef;
1297 #else
1298             RETVAL = &PL_sv_undef;
1299 #endif
1300         }
1301         OUTPUT: RETVAL