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