ext/Data/Dumper/Dumper.xs

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