ext/Data/Dumper/Dumper.xs

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