1 #define PERL_NO_GET_CONTEXT
7 static I32 num_q (const char *s, STRLEN slen);
8 static I32 esc_q (char *dest, const char *src, STRLEN slen);
9 static I32 esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen);
10 static I32 needs_quote(register const char *s);
11 static SV *sv_x (pTHX_ SV *sv, const char *str, STRLEN len, I32 n);
12 static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval,
13 HV *seenhv, AV *postav, I32 *levelp, I32 indent,
14 SV *pad, SV *xpad, SV *apad, SV *sep, SV *pair,
15 SV *freezer, SV *toaster,
16 I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
17 I32 maxdepth, SV *sortkeys);
20 #define HvNAME_get HvNAME
23 #if PERL_VERSION <= 6 /* Perl 5.6 and earlier */
26 # define UNI_TO_NATIVE(ch) (((ch) > 255) ? (ch) : ASCII_TO_NATIVE(ch))
28 # define UNI_TO_NATIVE(ch) (ch)
32 Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen)
34 const UV uv = utf8_to_uv(s, UTF8_MAXLEN, retlen,
35 ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
36 return UNI_TO_NATIVE(uv);
39 # if !defined(PERL_IMPLICIT_CONTEXT)
40 # define utf8_to_uvchr Perl_utf8_to_uvchr
42 # define utf8_to_uvchr(a,b) Perl_utf8_to_uvchr(aTHX_ a,b)
45 #endif /* PERL_VERSION <= 6 */
47 /* Changes in 5.7 series mean that now IOK is only set if scalar is
48 precisely integer but in 5.6 and earlier we need to do a more
51 #define DD_is_integer(sv) (SvIOK(sv) && (SvIsUV(val) ? SvUV(sv) == SvNV(sv) : SvIV(sv) == SvNV(sv)))
53 #define DD_is_integer(sv) SvIOK(sv)
56 /* does a string need to be protected? */
58 needs_quote(register const char *s)
83 /* count the number of "'"s and "\"s in string */
85 num_q(register const char *s, register STRLEN slen)
90 if (*s == '\'' || *s == '\\')
99 /* returns number of chars added to escape "'"s and "\"s in s */
100 /* slen number of characters in s will be escaped */
101 /* destination must be long enough for additional chars */
103 esc_q(register char *d, register const char *s, register STRLEN slen)
105 register I32 ret = 0;
123 esc_q_utf8(pTHX_ SV* sv, register const char *src, register STRLEN slen)
127 const char * const send = src + slen;
128 STRLEN j, cur = SvCUR(sv);
129 /* Could count 128-255 and 256+ in two variables, if we want to
130 be like &qquote and make a distinction. */
131 STRLEN grow = 0; /* bytes needed to represent chars 128+ */
132 /* STRLEN topbit_grow = 0; bytes needed to represent chars 128-255 */
133 STRLEN backslashes = 0;
134 STRLEN single_quotes = 0;
135 STRLEN qq_escapables = 0; /* " $ @ will need a \ in "" strings. */
138 /* this will need EBCDICification */
139 for (s = src; s < send; s += UTF8SKIP(s)) {
140 const UV k = utf8_to_uvchr((U8*)s, NULL);
143 if (!isprint(k) || k > 256) {
147 /* 4: \x{} then count the number of hex digits. */
148 grow += 4 + (k <= 0xFF ? 2 : k <= 0xFFF ? 3 : k <= 0xFFFF ? 4 :
150 8 /* We may allocate a bit more than the minimum here. */
152 k <= 0xFFFFFFFF ? 8 : UVSIZE * 4
155 } else if (k == '\\') {
157 } else if (k == '\'') {
159 } else if (k == '"' || k == '$' || k == '@') {
166 /* We have something needing hex. 3 is ""\0 */
167 sv_grow(sv, cur + 3 + grow + 2*backslashes + single_quotes
168 + 2*qq_escapables + normal);
169 rstart = r = SvPVX(sv) + cur;
173 for (s = src; s < send; s += UTF8SKIP(s)) {
174 const UV k = utf8_to_uvchr((U8*)s, NULL);
176 if (k == '"' || k == '\\' || k == '$' || k == '@') {
182 if (isprint(k) && k < 256)
188 /* The return value of sprintf() is unportable.
189 * In modern systems it returns (int) the number of characters,
190 * but in older systems it might return (char*) the original
191 * buffer, or it might even be (void). The easiest portable
192 * thing to do is probably use sprintf() in void context and
193 * then strlen(buffer) for the length. The more proper way
194 * would of course be to figure out the prototype of sprintf.
196 sprintf(r, "\\x{%"UVxf"}", k);
203 sv_grow(sv, cur + 3 + 2*backslashes + 2*single_quotes
204 + qq_escapables + normal);
205 rstart = r = SvPVX(sv) + cur;
207 for (s = src; s < send; s ++) {
209 if (k == '\'' || k == '\\')
217 SvCUR_set(sv, cur + j);
222 /* append a repeated string to an SV */
224 sv_x(pTHX_ SV *sv, const char *str, STRLEN len, I32 n)
227 sv = newSVpvn("", 0);
230 assert(SvTYPE(sv) >= SVt_PV);
234 SvGROW(sv, len*n + SvCUR(sv) + 1);
236 char * const start = SvPVX(sv) + SvCUR(sv);
237 SvCUR_set(sv, SvCUR(sv) + n);
244 sv_catpvn(sv, str, len);
252 * This ought to be split into smaller functions. (it is one long function since
253 * it exactly parallels the perl version, which was one long thing for
254 * efficiency raisins.) Ugggh!
257 DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
258 AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad,
259 SV *apad, SV *sep, SV *pair, SV *freezer, SV *toaster, I32 purity,
260 I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys)
264 char *c, *r, *realpack, id[128];
266 SV *sv, *ipad, *ival;
267 SV *blesspad = Nullsv;
268 AV *seenentry = NULL;
270 STRLEN inamelen, idlen = 0;
276 realtype = SvTYPE(val);
282 /* If a freeze method is provided and the object has it, call
283 it. Warn on errors. */
284 if (SvOBJECT(SvRV(val)) && freezer &&
285 SvPOK(freezer) && SvCUR(freezer) &&
286 gv_fetchmeth(SvSTASH(SvRV(val)), SvPVX_const(freezer),
287 SvCUR(freezer), -1) != NULL)
289 dSP; ENTER; SAVETMPS; PUSHMARK(sp);
290 XPUSHs(val); PUTBACK;
291 i = perl_call_method(SvPVX_const(freezer), G_EVAL|G_VOID);
294 warn("WARNING(Freezer method call failed): %"SVf"", ERRSV);
295 PUTBACK; FREETMPS; LEAVE;
299 realtype = SvTYPE(ival);
300 (void) my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(ival));
303 realpack = HvNAME_get(SvSTASH(ival));
307 /* if it has a name, we need to either look it up, or keep a tab
308 * on it so we know when we hit it later
311 if ((svp = hv_fetch(seenhv, id, idlen, FALSE))
312 && (sv = *svp) && SvROK(sv) && (seenentry = (AV*)SvRV(sv)))
315 if ((svp = av_fetch(seenentry, 0, FALSE))
316 && (othername = *svp))
318 if (purity && *levelp > 0) {
321 if (realtype == SVt_PVHV)
322 sv_catpvn(retval, "{}", 2);
323 else if (realtype == SVt_PVAV)
324 sv_catpvn(retval, "[]", 2);
326 sv_catpvn(retval, "do{my $o}", 9);
327 postentry = newSVpvn(name, namelen);
328 sv_catpvn(postentry, " = ", 3);
329 sv_catsv(postentry, othername);
330 av_push(postav, postentry);
333 if (name[0] == '@' || name[0] == '%') {
334 if ((SvPVX_const(othername))[0] == '\\' &&
335 (SvPVX_const(othername))[1] == name[0]) {
336 sv_catpvn(retval, SvPVX_const(othername)+1,
340 sv_catpvn(retval, name, 1);
341 sv_catpvn(retval, "{", 1);
342 sv_catsv(retval, othername);
343 sv_catpvn(retval, "}", 1);
347 sv_catsv(retval, othername);
352 warn("ref name not found for %s", id);
356 else { /* store our name and continue */
358 if (name[0] == '@' || name[0] == '%') {
359 namesv = newSVpvn("\\", 1);
360 sv_catpvn(namesv, name, namelen);
362 else if (realtype == SVt_PVCV && name[0] == '*') {
363 namesv = newSVpvn("\\", 2);
364 sv_catpvn(namesv, name, namelen);
365 (SvPVX(namesv))[1] = '&';
368 namesv = newSVpvn(name, namelen);
370 av_push(seenentry, namesv);
371 (void)SvREFCNT_inc(val);
372 av_push(seenentry, val);
373 (void)hv_store(seenhv, id, strlen(id),
374 newRV_inc((SV*)seenentry), 0);
375 SvREFCNT_dec(seenentry);
379 if (realpack && *realpack == 'R' && strEQ(realpack, "Regexp")) {
381 const char *rval = SvPV(val, rlen);
382 const char *slash = strchr(rval, '/');
383 sv_catpvn(retval, "qr/", 3);
385 sv_catpvn(retval, rval, slash-rval);
386 sv_catpvn(retval, "\\/", 2);
387 rlen -= slash-rval+1;
389 slash = strchr(rval, '/');
391 sv_catpvn(retval, rval, rlen);
392 sv_catpvn(retval, "/", 1);
396 /* If purity is not set and maxdepth is set, then check depth:
397 * if we have reached maximum depth, return the string
398 * representation of the thing we are currently examining
399 * at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
401 if (!purity && maxdepth > 0 && *levelp >= maxdepth) {
403 const char * const valstr = SvPV(val,vallen);
404 sv_catpvn(retval, "'", 1);
405 sv_catpvn(retval, valstr, vallen);
406 sv_catpvn(retval, "'", 1);
410 if (realpack) { /* we have a blessed ref */
412 const char * const blessstr = SvPV(bless, blesslen);
413 sv_catpvn(retval, blessstr, blesslen);
414 sv_catpvn(retval, "( ", 2);
417 apad = newSVsv(apad);
418 sv_x(aTHX_ apad, " ", 1, blesslen+2);
423 ipad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), *levelp);
425 if (realtype <= SVt_PVBM) { /* scalar ref */
426 SV * const namesv = newSVpvn("${", 2);
427 sv_catpvn(namesv, name, namelen);
428 sv_catpvn(namesv, "}", 1);
429 if (realpack) { /* blessed */
430 sv_catpvn(retval, "do{\\(my $o = ", 13);
431 DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
432 postav, levelp, indent, pad, xpad, apad, sep, pair,
433 freezer, toaster, purity, deepcopy, quotekeys, bless,
435 sv_catpvn(retval, ")}", 2);
438 sv_catpvn(retval, "\\", 1);
439 DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
440 postav, levelp, indent, pad, xpad, apad, sep, pair,
441 freezer, toaster, purity, deepcopy, quotekeys, bless,
444 SvREFCNT_dec(namesv);
446 else if (realtype == SVt_PVGV) { /* glob ref */
447 SV * const namesv = newSVpvn("*{", 2);
448 sv_catpvn(namesv, name, namelen);
449 sv_catpvn(namesv, "}", 1);
450 sv_catpvn(retval, "\\", 1);
451 DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
452 postav, levelp, indent, pad, xpad, apad, sep, pair,
453 freezer, toaster, purity, deepcopy, quotekeys, bless,
455 SvREFCNT_dec(namesv);
457 else if (realtype == SVt_PVAV) {
460 const I32 ixmax = av_len((AV *)ival);
462 SV * const ixsv = newSViv(0);
463 /* allowing for a 24 char wide array index */
464 New(0, iname, namelen+28, char);
465 (void)strcpy(iname, name);
467 if (name[0] == '@') {
468 sv_catpvn(retval, "(", 1);
472 sv_catpvn(retval, "[", 1);
473 /* omit "->" in $foo{bar}->[0], but not in ${$foo}->[0] */
475 && name[namelen-1] != ']' && name[namelen-1] != '}'
476 && (namelen < 4 || (name[1] != '{' && name[2] != '{')))*/
478 && name[namelen-1] != ']' && name[namelen-1] != '}')
481 || (name[0] == '\\' && name[2] == '{'))))
483 iname[inamelen++] = '-'; iname[inamelen++] = '>';
484 iname[inamelen] = '\0';
487 if (iname[0] == '*' && iname[inamelen-1] == '}' && inamelen >= 8 &&
488 (instr(iname+inamelen-8, "{SCALAR}") ||
489 instr(iname+inamelen-7, "{ARRAY}") ||
490 instr(iname+inamelen-6, "{HASH}"))) {
491 iname[inamelen++] = '-'; iname[inamelen++] = '>';
493 iname[inamelen++] = '['; iname[inamelen] = '\0';
494 totpad = newSVsv(sep);
495 sv_catsv(totpad, pad);
496 sv_catsv(totpad, apad);
498 for (ix = 0; ix <= ixmax; ++ix) {
501 svp = av_fetch((AV*)ival, ix, FALSE);
509 (void) sprintf(iname+ilen, "%"IVdf, (IV)ix);
510 ilen = strlen(iname);
511 iname[ilen++] = ']'; iname[ilen] = '\0';
513 sv_catsv(retval, totpad);
514 sv_catsv(retval, ipad);
515 sv_catpvn(retval, "#", 1);
516 sv_catsv(retval, ixsv);
518 sv_catsv(retval, totpad);
519 sv_catsv(retval, ipad);
520 DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
521 levelp, indent, pad, xpad, apad, sep, pair,
522 freezer, toaster, purity, deepcopy, quotekeys, bless,
525 sv_catpvn(retval, ",", 1);
528 SV * const opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), (*levelp)-1);
529 sv_catsv(retval, totpad);
530 sv_catsv(retval, opad);
534 sv_catpvn(retval, ")", 1);
536 sv_catpvn(retval, "]", 1);
538 SvREFCNT_dec(totpad);
541 else if (realtype == SVt_PVHV) {
542 SV *totpad, *newapad;
550 SV * const iname = newSVpvn(name, namelen);
551 if (name[0] == '%') {
552 sv_catpvn(retval, "(", 1);
553 (SvPVX(iname))[0] = '$';
556 sv_catpvn(retval, "{", 1);
557 /* omit "->" in $foo[0]->{bar}, but not in ${$foo}->{bar} */
559 && name[namelen-1] != ']' && name[namelen-1] != '}')
562 || (name[0] == '\\' && name[2] == '{'))))
564 sv_catpvn(iname, "->", 2);
567 if (name[0] == '*' && name[namelen-1] == '}' && namelen >= 8 &&
568 (instr(name+namelen-8, "{SCALAR}") ||
569 instr(name+namelen-7, "{ARRAY}") ||
570 instr(name+namelen-6, "{HASH}"))) {
571 sv_catpvn(iname, "->", 2);
573 sv_catpvn(iname, "{", 1);
574 totpad = newSVsv(sep);
575 sv_catsv(totpad, pad);
576 sv_catsv(totpad, apad);
578 /* If requested, get a sorted/filtered array of hash keys */
580 if (sortkeys == &PL_sv_yes) {
582 sortkeys = sv_2mortal(newSVpvn("Data::Dumper::_sortkeys", 23));
585 (void)hv_iterinit((HV*)ival);
586 while ((entry = hv_iternext((HV*)ival))) {
587 sv = hv_iterkeysv(entry);
591 # ifdef USE_LOCALE_NUMERIC
592 sortsv(AvARRAY(keys),
594 IN_LOCALE ? Perl_sv_cmp_locale : Perl_sv_cmp);
596 sortsv(AvARRAY(keys),
602 if (sortkeys != &PL_sv_yes) {
603 dSP; ENTER; SAVETMPS; PUSHMARK(sp);
604 XPUSHs(sv_2mortal(newRV_inc(ival))); PUTBACK;
605 i = perl_call_sv(sortkeys, G_SCALAR | G_EVAL);
609 if (SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVAV))
610 keys = (AV*)SvREFCNT_inc(SvRV(sv));
613 warn("Sortkeys subroutine did not return ARRAYREF\n");
614 PUTBACK; FREETMPS; LEAVE;
617 sv_2mortal((SV*)keys);
620 (void)hv_iterinit((HV*)ival);
622 /* foreach (keys %hash) */
623 for (i = 0; 1; i++) {
625 char *nkey_buffer = NULL;
630 bool do_utf8 = FALSE;
633 if (!(keys && (I32)i <= av_len(keys))) break;
635 if (!(entry = hv_iternext((HV *)ival))) break;
639 sv_catpvn(retval, ",", 1);
643 svp = av_fetch(keys, i, FALSE);
644 keysv = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
645 key = SvPV(keysv, keylen);
646 svp = hv_fetch((HV*)ival, key,
647 SvUTF8(keysv) ? -(I32)keylen : keylen, 0);
648 hval = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
651 keysv = hv_iterkeysv(entry);
652 hval = hv_iterval((HV*)ival, entry);
655 key = SvPV(keysv, keylen);
656 do_utf8 = DO_UTF8(keysv);
659 sv_catsv(retval, totpad);
660 sv_catsv(retval, ipad);
661 /* old logic was first to check utf8 flag, and if utf8 always
662 call esc_q_utf8. This caused test to break under -Mutf8,
663 because there even strings like 'c' have utf8 flag on.
664 Hence with quotekeys == 0 the XS code would still '' quote
665 them based on flags, whereas the perl code would not,
667 The perl code is correct.
668 needs_quote() decides that anything that isn't a valid
669 perl identifier needs to be quoted, hence only correctly
670 formed strings with no characters outside [A-Za-z0-9_:]
671 won't need quoting. None of those characters are used in
672 the byte encoding of utf8, so anything with utf8
673 encoded characters in will need quoting. Hence strings
674 with utf8 encoded characters in will end up inside do_utf8
675 just like before, but now strings with utf8 flag set but
676 only ascii characters will end up in the unquoted section.
678 There should also be less tests for the (probably currently)
679 more common doesn't need quoting case.
680 The code is also smaller (22044 vs 22260) because I've been
681 able to pull the common logic out to both sides. */
682 if (quotekeys || needs_quote(key)) {
684 STRLEN ocur = SvCUR(retval);
685 nlen = esc_q_utf8(aTHX_ retval, key, klen);
686 nkey = SvPVX(retval) + ocur;
689 nticks = num_q(key, klen);
690 New(0, nkey_buffer, klen+nticks+3, char);
694 klen += esc_q(nkey+1, key, klen);
696 (void)Copy(key, nkey+1, klen, char);
700 sv_catpvn(retval, nkey, klen);
706 sv_catpvn(retval, nkey, klen);
708 sname = newSVsv(iname);
709 sv_catpvn(sname, nkey, nlen);
710 sv_catpvn(sname, "}", 1);
712 sv_catsv(retval, pair);
716 newapad = newSVsv(apad);
717 New(0, extra, klen+4+1, char);
718 while (elen < (klen+4))
721 sv_catpvn(newapad, extra, elen);
727 DD_dump(aTHX_ hval, SvPVX_const(sname), SvCUR(sname), retval, seenhv,
728 postav, levelp, indent, pad, xpad, newapad, sep, pair,
729 freezer, toaster, purity, deepcopy, quotekeys, bless,
732 Safefree(nkey_buffer);
734 SvREFCNT_dec(newapad);
737 SV *opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), *levelp-1);
738 sv_catsv(retval, totpad);
739 sv_catsv(retval, opad);
743 sv_catpvn(retval, ")", 1);
745 sv_catpvn(retval, "}", 1);
747 SvREFCNT_dec(totpad);
749 else if (realtype == SVt_PVCV) {
750 sv_catpvn(retval, "sub { \"DUMMY\" }", 15);
752 warn("Encountered CODE ref, using dummy placeholder");
755 warn("cannot handle ref type %ld", realtype);
758 if (realpack) { /* free blessed allocs */
763 sv_catpvn(retval, ", '", 3);
764 sv_catpvn(retval, realpack, strlen(realpack));
765 sv_catpvn(retval, "' )", 3);
766 if (toaster && SvPOK(toaster) && SvCUR(toaster)) {
767 sv_catpvn(retval, "->", 2);
768 sv_catsv(retval, toaster);
769 sv_catpvn(retval, "()", 2);
779 (void) my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(val));
780 if ((svp = hv_fetch(seenhv, id, (idlen = strlen(id)), FALSE)) &&
781 (sv = *svp) && SvROK(sv) &&
782 (seenentry = (AV*)SvRV(sv)))
785 if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)
786 && (svp = av_fetch(seenentry, 2, FALSE)) && *svp && SvIV(*svp) > 0)
788 sv_catpvn(retval, "${", 2);
789 sv_catsv(retval, othername);
790 sv_catpvn(retval, "}", 1);
794 else if (val != &PL_sv_undef) {
795 SV * const namesv = newSVpvn("\\", 1);
796 sv_catpvn(namesv, name, namelen);
798 av_push(seenentry, namesv);
799 av_push(seenentry, newRV_inc(val));
800 (void)hv_store(seenhv, id, strlen(id), newRV_inc((SV*)seenentry), 0);
801 SvREFCNT_dec(seenentry);
805 if (DD_is_integer(val)) {
808 (void) my_snprintf(tmpbuf, sizeof(tmpbuf), "%"UVuf, SvUV(val));
810 (void) my_snprintf(tmpbuf, sizeof(tmpbuf), "%"IVdf, SvIV(val));
811 len = strlen(tmpbuf);
813 /* Need to check to see if this is a string such as " 0".
814 I'm assuming from sprintf isn't going to clash with utf8.
815 Is this valid on EBCDIC? */
817 const char * const pv = SvPV(val, pvlen);
818 if (pvlen != len || memNE(pv, tmpbuf, len))
819 goto integer_came_from_string;
822 /* Looks like we're on a 64 bit system. Make it a string so that
823 if a 32 bit system reads the number it will cope better. */
824 sv_catpvf(retval, "'%s'", tmpbuf);
826 sv_catpvn(retval, tmpbuf, len);
828 else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */
830 ++c; --i; /* just get the name */
831 if (i >= 6 && strncmp(c, "main::", 6) == 0) {
835 if (needs_quote(c)) {
836 sv_grow(retval, SvCUR(retval)+6+2*i);
837 r = SvPVX(retval)+SvCUR(retval);
838 r[0] = '*'; r[1] = '{'; r[2] = '\'';
839 i += esc_q(r+3, c, i);
841 r[i++] = '\''; r[i++] = '}';
845 sv_grow(retval, SvCUR(retval)+i+2);
846 r = SvPVX(retval)+SvCUR(retval);
847 r[0] = '*'; strcpy(r+1, c);
850 SvCUR_set(retval, SvCUR(retval)+i);
853 static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
854 static const STRLEN sizes[] = { 8, 7, 6 };
856 SV * const nname = newSVpvn("", 0);
857 SV * const newapad = newSVpvn("", 0);
858 GV * const gv = (GV*)val;
861 for (j=0; j<3; j++) {
862 e = ((j == 0) ? GvSV(gv) : (j == 1) ? (SV*)GvAV(gv) : (SV*)GvHV(gv));
865 if (j == 0 && !SvOK(e))
870 SV *postentry = newSVpvn(r,i);
872 sv_setsv(nname, postentry);
873 sv_catpvn(nname, entries[j], sizes[j]);
874 sv_catpvn(postentry, " = ", 3);
875 av_push(postav, postentry);
878 SvCUR_set(newapad, 0);
880 (void)sv_x(aTHX_ newapad, " ", 1, SvCUR(postentry));
882 DD_dump(aTHX_ e, SvPVX_const(nname), SvCUR(nname), postentry,
883 seenhv, postav, &nlevel, indent, pad, xpad,
884 newapad, sep, pair, freezer, toaster, purity,
885 deepcopy, quotekeys, bless, maxdepth,
891 SvREFCNT_dec(newapad);
895 else if (val == &PL_sv_undef || !SvOK(val)) {
896 sv_catpvn(retval, "undef", 5);
899 integer_came_from_string:
902 i += esc_q_utf8(aTHX_ retval, c, i);
904 sv_grow(retval, SvCUR(retval)+3+2*i); /* 3: ""\0 */
905 r = SvPVX(retval) + SvCUR(retval);
907 i += esc_q(r+1, c, i);
911 SvCUR_set(retval, SvCUR(retval)+i);
918 (void)hv_delete(seenhv, id, idlen, G_DISCARD);
919 else if (namelen && seenentry) {
920 SV *mark = *av_fetch(seenentry, 2, TRUE);
928 MODULE = Data::Dumper PACKAGE = Data::Dumper PREFIX = Data_Dumper_
931 # This is the exact equivalent of Dump. Well, almost. The things that are
932 # different as of now (due to Laziness):
933 # * doesnt do double-quotes yet.
937 Data_Dumper_Dumpxs(href, ...)
945 AV *postav, *todumpav, *namesav;
947 I32 indent, terse, i, imax, postlen;
949 SV *val, *name, *pad, *xpad, *apad, *sep, *pair, *varname;
950 SV *freezer, *toaster, *bless, *sortkeys;
951 I32 purity, deepcopy, quotekeys, maxdepth = 0;
955 if (!SvROK(href)) { /* call new to get an object first */
957 croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, [NAME_ARY_REF])");
964 XPUSHs(sv_2mortal(newSVsv(ST(1))));
966 XPUSHs(sv_2mortal(newSVsv(ST(2))));
968 i = perl_call_method("new", G_SCALAR);
971 href = newSVsv(POPs);
977 (void)sv_2mortal(href);
980 todumpav = namesav = NULL;
982 val = pad = xpad = apad = sep = pair = varname
983 = freezer = toaster = bless = sortkeys = &PL_sv_undef;
984 name = sv_newmortal();
986 terse = purity = deepcopy = 0;
989 retval = newSVpvn("", 0);
991 && (hv = (HV*)SvRV((SV*)href))
992 && SvTYPE(hv) == SVt_PVHV) {
994 if ((svp = hv_fetch(hv, "seen", 4, FALSE)) && SvROK(*svp))
995 seenhv = (HV*)SvRV(*svp);
996 if ((svp = hv_fetch(hv, "todump", 6, FALSE)) && SvROK(*svp))
997 todumpav = (AV*)SvRV(*svp);
998 if ((svp = hv_fetch(hv, "names", 5, FALSE)) && SvROK(*svp))
999 namesav = (AV*)SvRV(*svp);
1000 if ((svp = hv_fetch(hv, "indent", 6, FALSE)))
1001 indent = SvIV(*svp);
1002 if ((svp = hv_fetch(hv, "purity", 6, FALSE)))
1003 purity = SvIV(*svp);
1004 if ((svp = hv_fetch(hv, "terse", 5, FALSE)))
1005 terse = SvTRUE(*svp);
1006 #if 0 /* useqq currently unused */
1007 if ((svp = hv_fetch(hv, "useqq", 5, FALSE)))
1008 useqq = SvTRUE(*svp);
1010 if ((svp = hv_fetch(hv, "pad", 3, FALSE)))
1012 if ((svp = hv_fetch(hv, "xpad", 4, FALSE)))
1014 if ((svp = hv_fetch(hv, "apad", 4, FALSE)))
1016 if ((svp = hv_fetch(hv, "sep", 3, FALSE)))
1018 if ((svp = hv_fetch(hv, "pair", 4, FALSE)))
1020 if ((svp = hv_fetch(hv, "varname", 7, FALSE)))
1022 if ((svp = hv_fetch(hv, "freezer", 7, FALSE)))
1024 if ((svp = hv_fetch(hv, "toaster", 7, FALSE)))
1026 if ((svp = hv_fetch(hv, "deepcopy", 8, FALSE)))
1027 deepcopy = SvTRUE(*svp);
1028 if ((svp = hv_fetch(hv, "quotekeys", 9, FALSE)))
1029 quotekeys = SvTRUE(*svp);
1030 if ((svp = hv_fetch(hv, "bless", 5, FALSE)))
1032 if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE)))
1033 maxdepth = SvIV(*svp);
1034 if ((svp = hv_fetch(hv, "sortkeys", 8, FALSE))) {
1036 if (! SvTRUE(sortkeys))
1038 else if (! (SvROK(sortkeys) &&
1039 SvTYPE(SvRV(sortkeys)) == SVt_PVCV) )
1041 /* flag to use qsortsv() for sorting hash keys */
1042 sortkeys = &PL_sv_yes;
1048 imax = av_len(todumpav);
1051 valstr = newSVpvn("",0);
1052 for (i = 0; i <= imax; ++i) {
1056 if ((svp = av_fetch(todumpav, i, FALSE)))
1060 if ((svp = av_fetch(namesav, i, TRUE))) {
1061 sv_setsv(name, *svp);
1062 if (SvOK(*svp) && !SvPOK(*svp))
1063 (void)SvPV_nolen_const(name);
1066 (void)SvOK_off(name);
1069 if ((SvPVX_const(name))[0] == '*') {
1071 switch (SvTYPE(SvRV(val))) {
1073 (SvPVX(name))[0] = '@';
1076 (SvPVX(name))[0] = '%';
1079 (SvPVX(name))[0] = '*';
1082 (SvPVX(name))[0] = '$';
1087 (SvPVX(name))[0] = '$';
1089 else if ((SvPVX_const(name))[0] != '$')
1090 sv_insert(name, 0, 0, "$", 1);
1094 sv_setpvn(name, "$", 1);
1095 sv_catsv(name, varname);
1096 (void) my_snprintf(tmpbuf, sizeof(tmpbuf), "%"IVdf, (IV)(i+1));
1097 nchars = strlen(tmpbuf);
1098 sv_catpvn(name, tmpbuf, nchars);
1102 SV * const tmpsv = sv_x(aTHX_ NULL, " ", 1, SvCUR(name)+3);
1103 newapad = newSVsv(apad);
1104 sv_catsv(newapad, tmpsv);
1105 SvREFCNT_dec(tmpsv);
1110 DD_dump(aTHX_ val, SvPVX_const(name), SvCUR(name), valstr, seenhv,
1111 postav, &level, indent, pad, xpad, newapad, sep, pair,
1112 freezer, toaster, purity, deepcopy, quotekeys,
1113 bless, maxdepth, sortkeys);
1116 SvREFCNT_dec(newapad);
1118 postlen = av_len(postav);
1119 if (postlen >= 0 || !terse) {
1120 sv_insert(valstr, 0, 0, " = ", 3);
1121 sv_insert(valstr, 0, 0, SvPVX_const(name), SvCUR(name));
1122 sv_catpvn(valstr, ";", 1);
1124 sv_catsv(retval, pad);
1125 sv_catsv(retval, valstr);
1126 sv_catsv(retval, sep);
1129 sv_catsv(retval, pad);
1130 for (i = 0; i <= postlen; ++i) {
1132 svp = av_fetch(postav, i, FALSE);
1133 if (svp && (elem = *svp)) {
1134 sv_catsv(retval, elem);
1136 sv_catpvn(retval, ";", 1);
1137 sv_catsv(retval, sep);
1138 sv_catsv(retval, pad);
1142 sv_catpvn(retval, ";", 1);
1143 sv_catsv(retval, sep);
1145 sv_setpvn(valstr, "", 0);
1146 if (gimme == G_ARRAY) {
1147 XPUSHs(sv_2mortal(retval));
1148 if (i < imax) /* not the last time thro ? */
1149 retval = newSVpvn("",0);
1152 SvREFCNT_dec(postav);
1153 SvREFCNT_dec(valstr);
1156 croak("Call to new() method failed to return HASH ref");
1157 if (gimme == G_SCALAR)
1158 XPUSHs(sv_2mortal(retval));