projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Yves said that the XS version of Data::Dumper was inefficient because
[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
9fa5cce2 277 if (SvTYPE(retval) >= SVt_PV && (SvLEN(retval) - SvCUR(retval)) < 40) {
278 sv_grow(retval, SvCUR(retval) * 1.5);
279 }
823edd99 280 realtype = SvTYPE(val);
6cde4e94 281
823edd99 282 if (SvGMAGICAL(val))
283 mg_get(val);
823edd99 284 if (SvROK(val)) {
285
c5f7c514 286 /* If a freeze method is provided and the object has it, call
287 it. Warn on errors. */
823edd99 288 if (SvOBJECT(SvRV(val)) && freezer &&
c5f7c514 289 SvPOK(freezer) && SvCUR(freezer) &&
aa07b2f6 290 gv_fetchmeth(SvSTASH(SvRV(val)), SvPVX_const(freezer),
c5f7c514 291 SvCUR(freezer), -1) != NULL)
823edd99 292 {
293 dSP; ENTER; SAVETMPS; PUSHMARK(sp);
294 XPUSHs(val); PUTBACK;
aa07b2f6 295 i = perl_call_method(SvPVX_const(freezer), G_EVAL|G_VOID);
823edd99 296 SPAGAIN;
7820172a 297 if (SvTRUE(ERRSV))
35c1215d 298 warn("WARNING(Freezer method call failed): %"SVf"", ERRSV);
823edd99 299 PUTBACK; FREETMPS; LEAVE;
823edd99 300 }
301
302 ival = SvRV(val);
823edd99 303 realtype = SvTYPE(ival);
e52c0e5a 304#ifdef DD_USE_OLD_ID_FORMAT
f5def3a2 305 idlen = my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(ival));
e52c0e5a 306#else
307 id_buffer = PTR2UV(ival);
308 idlen = sizeof(id_buffer);
309#endif
823edd99 310 if (SvOBJECT(ival))
bfcb3514 311 realpack = HvNAME_get(SvSTASH(ival));
823edd99 312 else
313 realpack = Nullch;
7820172a 314
315 /* if it has a name, we need to either look it up, or keep a tab
316 * on it so we know when we hit it later
317 */
318 if (namelen) {
319 if ((svp = hv_fetch(seenhv, id, idlen, FALSE))
320 && (sv = *svp) && SvROK(sv) && (seenentry = (AV*)SvRV(sv)))
321 {
322 SV *othername;
323 if ((svp = av_fetch(seenentry, 0, FALSE))
324 && (othername = *svp))
325 {
326 if (purity && *levelp > 0) {
327 SV *postentry;
328
329 if (realtype == SVt_PVHV)
330 sv_catpvn(retval, "{}", 2);
331 else if (realtype == SVt_PVAV)
332 sv_catpvn(retval, "[]", 2);
333 else
5df59fb6 334 sv_catpvn(retval, "do{my $o}", 9);
7820172a 335 postentry = newSVpvn(name, namelen);
336 sv_catpvn(postentry, " = ", 3);
337 sv_catsv(postentry, othername);
338 av_push(postav, postentry);
339 }
340 else {
341 if (name[0] == '@' || name[0] == '%') {
aa07b2f6 342 if ((SvPVX_const(othername))[0] == '\\' &&
343 (SvPVX_const(othername))[1] == name[0]) {
344 sv_catpvn(retval, SvPVX_const(othername)+1,
7820172a 345 SvCUR(othername)-1);
346 }
347 else {
348 sv_catpvn(retval, name, 1);
349 sv_catpvn(retval, "{", 1);
350 sv_catsv(retval, othername);
351 sv_catpvn(retval, "}", 1);
352 }
823edd99 353 }
7820172a 354 else
823edd99 355 sv_catsv(retval, othername);
823edd99 356 }
7820172a 357 return 1;
358 }
359 else {
e52c0e5a 360#ifdef DD_USE_OLD_ID_FORMAT
7820172a 361 warn("ref name not found for %s", id);
e52c0e5a 362#else
363 warn("ref name not found for 0x%"UVxf, PTR2UV(ival));
364#endif
7820172a 365 return 0;
823edd99 366 }
823edd99 367 }
7820172a 368 else { /* store our name and continue */
369 SV *namesv;
370 if (name[0] == '@' || name[0] == '%') {
371 namesv = newSVpvn("\\", 1);
372 sv_catpvn(namesv, name, namelen);
373 }
374 else if (realtype == SVt_PVCV && name[0] == '*') {
375 namesv = newSVpvn("\\", 2);
376 sv_catpvn(namesv, name, namelen);
377 (SvPVX(namesv))[1] = '&';
378 }
379 else
380 namesv = newSVpvn(name, namelen);
381 seenentry = newAV();
382 av_push(seenentry, namesv);
383 (void)SvREFCNT_inc(val);
384 av_push(seenentry, val);
383d9087 385 (void)hv_store(seenhv, id, idlen,
fec5e1eb 386 newRV_inc((SV*)seenentry), 0);
7820172a 387 SvREFCNT_dec(seenentry);
823edd99 388 }
823edd99 389 }
823edd99 390
a2126434 391 if (realpack && *realpack == 'R' && strEQ(realpack, "Regexp")) {
392 STRLEN rlen;
9061c4b9 393 const char *rval = SvPV(val, rlen);
394 const char *slash = strchr(rval, '/');
a2126434 395 sv_catpvn(retval, "qr/", 3);
396 while (slash) {
397 sv_catpvn(retval, rval, slash-rval);
398 sv_catpvn(retval, "\\/", 2);
399 rlen -= slash-rval+1;
400 rval = slash+1;
401 slash = strchr(rval, '/');
7894fbab 402 }
a2126434 403 sv_catpvn(retval, rval, rlen);
404 sv_catpvn(retval, "/", 1);
405 return 1;
406 }
407
408 /* If purity is not set and maxdepth is set, then check depth:
409 * if we have reached maximum depth, return the string
410 * representation of the thing we are currently examining
6cde4e94 411 * at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
a2126434 412 */
413 if (!purity && maxdepth > 0 && *levelp >= maxdepth) {
414 STRLEN vallen;
9061c4b9 415 const char * const valstr = SvPV(val,vallen);
a2126434 416 sv_catpvn(retval, "'", 1);
417 sv_catpvn(retval, valstr, vallen);
418 sv_catpvn(retval, "'", 1);
419 return 1;
420 }
421
422 if (realpack) { /* we have a blessed ref */
423 STRLEN blesslen;
9061c4b9 424 const char * const blessstr = SvPV(bless, blesslen);
a2126434 425 sv_catpvn(retval, blessstr, blesslen);
426 sv_catpvn(retval, "( ", 2);
427 if (indent >= 2) {
428 blesspad = apad;
429 apad = newSVsv(apad);
430 sv_x(aTHX_ apad, " ", 1, blesslen+2);
823edd99 431 }
432 }
433
7894fbab 434 (*levelp)++;
aa07b2f6 435 ipad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), *levelp);
7894fbab 436
7820172a 437 if (realtype <= SVt_PVBM) { /* scalar ref */
9061c4b9 438 SV * const namesv = newSVpvn("${", 2);
7820172a 439 sv_catpvn(namesv, name, namelen);
440 sv_catpvn(namesv, "}", 1);
6cde4e94 441 if (realpack) { /* blessed */
823edd99 442 sv_catpvn(retval, "do{\\(my $o = ", 13);
aa07b2f6 443 DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
30b4f386 444 postav, levelp, indent, pad, xpad, apad, sep, pair,
a2126434 445 freezer, toaster, purity, deepcopy, quotekeys, bless,
e9105f86 446 maxdepth, sortkeys);
823edd99 447 sv_catpvn(retval, ")}", 2);
7820172a 448 } /* plain */
823edd99 449 else {
450 sv_catpvn(retval, "\\", 1);
aa07b2f6 451 DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
30b4f386 452 postav, levelp, indent, pad, xpad, apad, sep, pair,
a2126434 453 freezer, toaster, purity, deepcopy, quotekeys, bless,
e9105f86 454 maxdepth, sortkeys);
823edd99 455 }
7820172a 456 SvREFCNT_dec(namesv);
457 }
458 else if (realtype == SVt_PVGV) { /* glob ref */
9061c4b9 459 SV * const namesv = newSVpvn("*{", 2);
7820172a 460 sv_catpvn(namesv, name, namelen);
461 sv_catpvn(namesv, "}", 1);
462 sv_catpvn(retval, "\\", 1);
aa07b2f6 463 DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
30b4f386 464 postav, levelp, indent, pad, xpad, apad, sep, pair,
a2126434 465 freezer, toaster, purity, deepcopy, quotekeys, bless,
e9105f86 466 maxdepth, sortkeys);
7820172a 467 SvREFCNT_dec(namesv);
823edd99 468 }
469 else if (realtype == SVt_PVAV) {
470 SV *totpad;
471 I32 ix = 0;
9061c4b9 472 const I32 ixmax = av_len((AV *)ival);
6cde4e94 473
9061c4b9 474 SV * const ixsv = newSViv(0);
823edd99 475 /* allowing for a 24 char wide array index */
476 New(0, iname, namelen+28, char);
477 (void)strcpy(iname, name);
478 inamelen = namelen;
479 if (name[0] == '@') {
480 sv_catpvn(retval, "(", 1);
481 iname[0] = '$';
482 }
483 else {
484 sv_catpvn(retval, "[", 1);
7820172a 485 /* omit "->" in $foo{bar}->[0], but not in ${$foo}->[0] */
486 /*if (namelen > 0
487 && name[namelen-1] != ']' && name[namelen-1] != '}'
488 && (namelen < 4 || (name[1] != '{' && name[2] != '{')))*/
489 if ((namelen > 0
490 && name[namelen-1] != ']' && name[namelen-1] != '}')
491 || (namelen > 4
492 && (name[1] == '{'
493 || (name[0] == '\\' && name[2] == '{'))))
494 {
823edd99 495 iname[inamelen++] = '-'; iname[inamelen++] = '>';
496 iname[inamelen] = '\0';
497 }
498 }
499 if (iname[0] == '*' && iname[inamelen-1] == '}' && inamelen >= 8 &&
500 (instr(iname+inamelen-8, "{SCALAR}") ||
501 instr(iname+inamelen-7, "{ARRAY}") ||
502 instr(iname+inamelen-6, "{HASH}"))) {
503 iname[inamelen++] = '-'; iname[inamelen++] = '>';
504 }
505 iname[inamelen++] = '['; iname[inamelen] = '\0';
506 totpad = newSVsv(sep);
507 sv_catsv(totpad, pad);
508 sv_catsv(totpad, apad);
509
510 for (ix = 0; ix <= ixmax; ++ix) {
511 STRLEN ilen;
512 SV *elem;
513 svp = av_fetch((AV*)ival, ix, FALSE);
514 if (svp)
515 elem = *svp;
516 else
3280af22 517 elem = &PL_sv_undef;
823edd99 518
519 ilen = inamelen;
520 sv_setiv(ixsv, ix);
f5def3a2 521 ilen = ilen + my_sprintf(iname+ilen, "%"IVdf, (IV)ix);
823edd99 522 iname[ilen++] = ']'; iname[ilen] = '\0';
523 if (indent >= 3) {
524 sv_catsv(retval, totpad);
525 sv_catsv(retval, ipad);
526 sv_catpvn(retval, "#", 1);
527 sv_catsv(retval, ixsv);
528 }
529 sv_catsv(retval, totpad);
530 sv_catsv(retval, ipad);
cea2e8a9 531 DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
30b4f386 532 levelp, indent, pad, xpad, apad, sep, pair,
a2126434 533 freezer, toaster, purity, deepcopy, quotekeys, bless,
e9105f86 534 maxdepth, sortkeys);
823edd99 535 if (ix < ixmax)
536 sv_catpvn(retval, ",", 1);
537 }
538 if (ixmax >= 0) {
9061c4b9 539 SV * const opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), (*levelp)-1);
823edd99 540 sv_catsv(retval, totpad);
541 sv_catsv(retval, opad);
542 SvREFCNT_dec(opad);
543 }
544 if (name[0] == '@')
545 sv_catpvn(retval, ")", 1);
546 else
547 sv_catpvn(retval, "]", 1);
548 SvREFCNT_dec(ixsv);
549 SvREFCNT_dec(totpad);
550 Safefree(iname);
551 }
552 else if (realtype == SVt_PVHV) {
553 SV *totpad, *newapad;
9061c4b9 554 SV *sname;
823edd99 555 HE *entry;
556 char *key;
557 I32 klen;
558 SV *hval;
7d49f689 559 AV *keys = NULL;
6cde4e94 560
9061c4b9 561 SV * const iname = newSVpvn(name, namelen);
823edd99 562 if (name[0] == '%') {
563 sv_catpvn(retval, "(", 1);
564 (SvPVX(iname))[0] = '$';
565 }
566 else {
567 sv_catpvn(retval, "{", 1);
7820172a 568 /* omit "->" in $foo[0]->{bar}, but not in ${$foo}->{bar} */
569 if ((namelen > 0
570 && name[namelen-1] != ']' && name[namelen-1] != '}')
571 || (namelen > 4
572 && (name[1] == '{'
573 || (name[0] == '\\' && name[2] == '{'))))
574 {
823edd99 575 sv_catpvn(iname, "->", 2);
576 }
577 }
578 if (name[0] == '*' && name[namelen-1] == '}' && namelen >= 8 &&
579 (instr(name+namelen-8, "{SCALAR}") ||
580 instr(name+namelen-7, "{ARRAY}") ||
581 instr(name+namelen-6, "{HASH}"))) {
582 sv_catpvn(iname, "->", 2);
583 }
584 sv_catpvn(iname, "{", 1);
585 totpad = newSVsv(sep);
586 sv_catsv(totpad, pad);
587 sv_catsv(totpad, apad);
6cde4e94 588
e9105f86 589 /* If requested, get a sorted/filtered array of hash keys */
590 if (sortkeys) {
591 if (sortkeys == &PL_sv_yes) {
fec5e1eb 592#if PERL_VERSION < 8
593 sortkeys = sv_2mortal(newSVpvn("Data::Dumper::_sortkeys", 23));
594#else
e9105f86 595 keys = newAV();
596 (void)hv_iterinit((HV*)ival);
20d72259 597 while ((entry = hv_iternext((HV*)ival))) {
e9105f86 598 sv = hv_iterkeysv(entry);
599 SvREFCNT_inc(sv);
600 av_push(keys, sv);
601 }
fec5e1eb 602# ifdef USE_LOCALE_NUMERIC
e9105f86 603 sortsv(AvARRAY(keys),
604 av_len(keys)+1,
3c253d0e 605 IN_LOCALE ? Perl_sv_cmp_locale : Perl_sv_cmp);
fec5e1eb 606# else
503ec68f 607 sortsv(AvARRAY(keys),
608 av_len(keys)+1,
609 Perl_sv_cmp);
fec5e1eb 610# endif
02a99678 611#endif
e9105f86 612 }
fec5e1eb 613 if (sortkeys != &PL_sv_yes) {
e9105f86 614 dSP; ENTER; SAVETMPS; PUSHMARK(sp);
615 XPUSHs(sv_2mortal(newRV_inc(ival))); PUTBACK;
616 i = perl_call_sv(sortkeys, G_SCALAR | G_EVAL);
617 SPAGAIN;
618 if (i) {
619 sv = POPs;
620 if (SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVAV))
621 keys = (AV*)SvREFCNT_inc(SvRV(sv));
622 }
623 if (! keys)
624 warn("Sortkeys subroutine did not return ARRAYREF\n");
625 PUTBACK; FREETMPS; LEAVE;
626 }
627 if (keys)
628 sv_2mortal((SV*)keys);
629 }
630 else
631 (void)hv_iterinit((HV*)ival);
ecfc8647 632
633 /* foreach (keys %hash) */
634 for (i = 0; 1; i++) {
fdce9ba9 635 char *nkey;
636 char *nkey_buffer = NULL;
823edd99 637 I32 nticks = 0;
dc71dc59 638 SV* keysv;
639 STRLEN keylen;
fdce9ba9 640 I32 nlen;
dc71dc59 641 bool do_utf8 = FALSE;
ecfc8647 642
27688d77 643 if (sortkeys) {
644 if (!(keys && (I32)i <= av_len(keys))) break;
645 } else {
646 if (!(entry = hv_iternext((HV *)ival))) break;
647 }
ecfc8647 648
823edd99 649 if (i)
650 sv_catpvn(retval, ",", 1);
e9105f86 651
652 if (sortkeys) {
653 char *key;
654 svp = av_fetch(keys, i, FALSE);
655 keysv = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
656 key = SvPV(keysv, keylen);
d075f8ed 657 svp = hv_fetch((HV*)ival, key,
6e21dc91 658 SvUTF8(keysv) ? -(I32)keylen : keylen, 0);
e9105f86 659 hval = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
660 }
661 else {
662 keysv = hv_iterkeysv(entry);
663 hval = hv_iterval((HV*)ival, entry);
664 }
665
dc71dc59 666 key = SvPV(keysv, keylen);
8738e0c0 667 do_utf8 = DO_UTF8(keysv);
dc71dc59 668 klen = keylen;
669
fdce9ba9 670 sv_catsv(retval, totpad);
671 sv_catsv(retval, ipad);
672 /* old logic was first to check utf8 flag, and if utf8 always
673 call esc_q_utf8. This caused test to break under -Mutf8,
674 because there even strings like 'c' have utf8 flag on.
675 Hence with quotekeys == 0 the XS code would still '' quote
676 them based on flags, whereas the perl code would not,
677 based on regexps.
678 The perl code is correct.
679 needs_quote() decides that anything that isn't a valid
680 perl identifier needs to be quoted, hence only correctly
681 formed strings with no characters outside [A-Za-z0-9_:]
682 won't need quoting. None of those characters are used in
683 the byte encoding of utf8, so anything with utf8
684 encoded characters in will need quoting. Hence strings
685 with utf8 encoded characters in will end up inside do_utf8
686 just like before, but now strings with utf8 flag set but
687 only ascii characters will end up in the unquoted section.
688
689 There should also be less tests for the (probably currently)
690 more common doesn't need quoting case.
691 The code is also smaller (22044 vs 22260) because I've been
30b4f386 692 able to pull the common logic out to both sides. */
fdce9ba9 693 if (quotekeys || needs_quote(key)) {
694 if (do_utf8) {
695 STRLEN ocur = SvCUR(retval);
696 nlen = esc_q_utf8(aTHX_ retval, key, klen);
697 nkey = SvPVX(retval) + ocur;
698 }
699 else {
dc71dc59 700 nticks = num_q(key, klen);
fdce9ba9 701 New(0, nkey_buffer, klen+nticks+3, char);
702 nkey = nkey_buffer;
dc71dc59 703 nkey[0] = '\'';
704 if (nticks)
705 klen += esc_q(nkey+1, key, klen);
706 else
707 (void)Copy(key, nkey+1, klen, char);
708 nkey[++klen] = '\'';
709 nkey[++klen] = '\0';
fdce9ba9 710 nlen = klen;
711 sv_catpvn(retval, nkey, klen);
dc71dc59 712 }
fdce9ba9 713 }
714 else {
715 nkey = key;
716 nlen = klen;
717 sv_catpvn(retval, nkey, klen);
dc71dc59 718 }
fdce9ba9 719 sname = newSVsv(iname);
720 sv_catpvn(sname, nkey, nlen);
721 sv_catpvn(sname, "}", 1);
722
30b4f386 723 sv_catsv(retval, pair);
823edd99 724 if (indent >= 2) {
725 char *extra;
726 I32 elen = 0;
727 newapad = newSVsv(apad);
728 New(0, extra, klen+4+1, char);
729 while (elen < (klen+4))
730 extra[elen++] = ' ';
731 extra[elen] = '\0';
732 sv_catpvn(newapad, extra, elen);
733 Safefree(extra);
734 }
735 else
736 newapad = apad;
737
aa07b2f6 738 DD_dump(aTHX_ hval, SvPVX_const(sname), SvCUR(sname), retval, seenhv,
30b4f386 739 postav, levelp, indent, pad, xpad, newapad, sep, pair,
a2126434 740 freezer, toaster, purity, deepcopy, quotekeys, bless,
e9105f86 741 maxdepth, sortkeys);
823edd99 742 SvREFCNT_dec(sname);
fdce9ba9 743 Safefree(nkey_buffer);
823edd99 744 if (indent >= 2)
745 SvREFCNT_dec(newapad);
746 }
747 if (i) {
aa07b2f6 748 SV *opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), *levelp-1);
823edd99 749 sv_catsv(retval, totpad);
750 sv_catsv(retval, opad);
751 SvREFCNT_dec(opad);
752 }
753 if (name[0] == '%')
754 sv_catpvn(retval, ")", 1);
755 else
756 sv_catpvn(retval, "}", 1);
757 SvREFCNT_dec(iname);
758 SvREFCNT_dec(totpad);
759 }
760 else if (realtype == SVt_PVCV) {
761 sv_catpvn(retval, "sub { \"DUMMY\" }", 15);
762 if (purity)
763 warn("Encountered CODE ref, using dummy placeholder");
764 }
765 else {
766 warn("cannot handle ref type %ld", realtype);
767 }
768
769 if (realpack) { /* free blessed allocs */
770 if (indent >= 2) {
771 SvREFCNT_dec(apad);
772 apad = blesspad;
773 }
774 sv_catpvn(retval, ", '", 3);
775 sv_catpvn(retval, realpack, strlen(realpack));
776 sv_catpvn(retval, "' )", 3);
777 if (toaster && SvPOK(toaster) && SvCUR(toaster)) {
778 sv_catpvn(retval, "->", 2);
779 sv_catsv(retval, toaster);
780 sv_catpvn(retval, "()", 2);
781 }
782 }
783 SvREFCNT_dec(ipad);
784 (*levelp)--;
785 }
786 else {
787 STRLEN i;
788
789 if (namelen) {
e52c0e5a 790#ifdef DD_USE_OLD_ID_FORMAT
f5def3a2 791 idlen = my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(val));
e52c0e5a 792#else
793 id_buffer = PTR2UV(val);
794 idlen = sizeof(id_buffer);
795#endif
f5def3a2 796 if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) &&
823edd99 797 (sv = *svp) && SvROK(sv) &&
7820172a 798 (seenentry = (AV*)SvRV(sv)))
799 {
823edd99 800 SV *othername;
7820172a 801 if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)
802 && (svp = av_fetch(seenentry, 2, FALSE)) && *svp && SvIV(*svp) > 0)
803 {
804 sv_catpvn(retval, "${", 2);
823edd99 805 sv_catsv(retval, othername);
7820172a 806 sv_catpvn(retval, "}", 1);
823edd99 807 return 1;
808 }
809 }
3bef8b4a 810 else if (val != &PL_sv_undef) {
9061c4b9 811 SV * const namesv = newSVpvn("\\", 1);
823edd99 812 sv_catpvn(namesv, name, namelen);
813 seenentry = newAV();
814 av_push(seenentry, namesv);
fec5e1eb 815 av_push(seenentry, newRV_inc(val));
383d9087 816 (void)hv_store(seenhv, id, idlen, newRV_inc((SV*)seenentry), 0);
823edd99 817 SvREFCNT_dec(seenentry);
818 }
819 }
7820172a 820
fec5e1eb 821 if (DD_is_integer(val)) {
823edd99 822 STRLEN len;
0e8b3009 823 if (SvIsUV(val))
f5def3a2 824 len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"UVuf, SvUV(val));
0e8b3009 825 else
f5def3a2 826 len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"IVdf, SvIV(val));
c4cce848 827 if (SvPOK(val)) {
828 /* Need to check to see if this is a string such as " 0".
829 I'm assuming from sprintf isn't going to clash with utf8.
830 Is this valid on EBCDIC? */
831 STRLEN pvlen;
9061c4b9 832 const char * const pv = SvPV(val, pvlen);
c4cce848 833 if (pvlen != len || memNE(pv, tmpbuf, len))
834 goto integer_came_from_string;
835 }
836 if (len > 10) {
837 /* Looks like we're on a 64 bit system. Make it a string so that
838 if a 32 bit system reads the number it will cope better. */
839 sv_catpvf(retval, "'%s'", tmpbuf);
840 } else
841 sv_catpvn(retval, tmpbuf, len);
823edd99 842 }
843 else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */
844 c = SvPV(val, i);
845 ++c; --i; /* just get the name */
846 if (i >= 6 && strncmp(c, "main::", 6) == 0) {
847 c += 4;
848 i -= 4;
849 }
850 if (needs_quote(c)) {
851 sv_grow(retval, SvCUR(retval)+6+2*i);
852 r = SvPVX(retval)+SvCUR(retval);
853 r[0] = '*'; r[1] = '{'; r[2] = '\'';
854 i += esc_q(r+3, c, i);
855 i += 3;
856 r[i++] = '\''; r[i++] = '}';
857 r[i] = '\0';
858 }
859 else {
860 sv_grow(retval, SvCUR(retval)+i+2);
861 r = SvPVX(retval)+SvCUR(retval);
862 r[0] = '*'; strcpy(r+1, c);
863 i++;
864 }
7820172a 865 SvCUR_set(retval, SvCUR(retval)+i);
823edd99 866
867 if (purity) {
27da23d5 868 static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
869 static const STRLEN sizes[] = { 8, 7, 6 };
823edd99 870 SV *e;
9061c4b9 871 SV * const nname = newSVpvn("", 0);
872 SV * const newapad = newSVpvn("", 0);
873 GV * const gv = (GV*)val;
823edd99 874 I32 j;
875
876 for (j=0; j<3; j++) {
877 e = ((j == 0) ? GvSV(gv) : (j == 1) ? (SV*)GvAV(gv) : (SV*)GvHV(gv));
7820172a 878 if (!e)
879 continue;
880 if (j == 0 && !SvOK(e))
881 continue;
882
883 {
823edd99 884 I32 nlevel = 0;
7820172a 885 SV *postentry = newSVpvn(r,i);
823edd99 886
887 sv_setsv(nname, postentry);
888 sv_catpvn(nname, entries[j], sizes[j]);
889 sv_catpvn(postentry, " = ", 3);
890 av_push(postav, postentry);
fec5e1eb 891 e = newRV_inc(e);
823edd99 892
b162af07 893 SvCUR_set(newapad, 0);
823edd99 894 if (indent >= 2)
cea2e8a9 895 (void)sv_x(aTHX_ newapad, " ", 1, SvCUR(postentry));
823edd99 896
aa07b2f6 897 DD_dump(aTHX_ e, SvPVX_const(nname), SvCUR(nname), postentry,
823edd99 898 seenhv, postav, &nlevel, indent, pad, xpad,
30b4f386 899 newapad, sep, pair, freezer, toaster, purity,
e9105f86 900 deepcopy, quotekeys, bless, maxdepth,
901 sortkeys);
823edd99 902 SvREFCNT_dec(e);
903 }
904 }
905
906 SvREFCNT_dec(newapad);
907 SvREFCNT_dec(nname);
908 }
909 }
7820172a 910 else if (val == &PL_sv_undef || !SvOK(val)) {
911 sv_catpvn(retval, "undef", 5);
912 }
823edd99 913 else {
c4cce848 914 integer_came_from_string:
823edd99 915 c = SvPV(val, i);
dc71dc59 916 if (DO_UTF8(val))
6cde4e94 917 i += esc_q_utf8(aTHX_ retval, c, i);
dc71dc59 918 else {
919 sv_grow(retval, SvCUR(retval)+3+2*i); /* 3: ""\0 */
920 r = SvPVX(retval) + SvCUR(retval);
921 r[0] = '\'';
922 i += esc_q(r+1, c, i);
923 ++i;
924 r[i++] = '\'';
925 r[i] = '\0';
926 SvCUR_set(retval, SvCUR(retval)+i);
927 }
823edd99 928 }
823edd99 929 }
930
7820172a 931 if (idlen) {
932 if (deepcopy)
933 (void)hv_delete(seenhv, id, idlen, G_DISCARD);
934 else if (namelen && seenentry) {
935 SV *mark = *av_fetch(seenentry, 2, TRUE);
936 sv_setiv(mark,1);
937 }
938 }
823edd99 939 return 1;
940}
941
942
943MODULE = Data::Dumper PACKAGE = Data::Dumper PREFIX = Data_Dumper_
944
945#
946# This is the exact equivalent of Dump. Well, almost. The things that are
947# different as of now (due to Laziness):
948# * doesnt do double-quotes yet.
949#
950
951void
952Data_Dumper_Dumpxs(href, ...)
953 SV *href;
954 PROTOTYPE: $;$$
955 PPCODE:
956 {
957 HV *hv;
958 SV *retval, *valstr;
5c284bb0 959 HV *seenhv = NULL;
823edd99 960 AV *postav, *todumpav, *namesav;
961 I32 level = 0;
497b47a8 962 I32 indent, terse, i, imax, postlen;
823edd99 963 SV **svp;
30b4f386 964 SV *val, *name, *pad, *xpad, *apad, *sep, *pair, *varname;
e9105f86 965 SV *freezer, *toaster, *bless, *sortkeys;
7b0972df 966 I32 purity, deepcopy, quotekeys, maxdepth = 0;
823edd99 967 char tmpbuf[1024];
968 I32 gimme = GIMME;
969
970 if (!SvROK(href)) { /* call new to get an object first */
0f1923bd 971 if (items < 2)
972 croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, [NAME_ARY_REF])");
823edd99 973
974 ENTER;
975 SAVETMPS;
976
977 PUSHMARK(sp);
978 XPUSHs(href);
0f1923bd 979 XPUSHs(sv_2mortal(newSVsv(ST(1))));
980 if (items >= 3)
981 XPUSHs(sv_2mortal(newSVsv(ST(2))));
823edd99 982 PUTBACK;
983 i = perl_call_method("new", G_SCALAR);
984 SPAGAIN;
985 if (i)
986 href = newSVsv(POPs);
987
988 PUTBACK;
989 FREETMPS;
990 LEAVE;
991 if (i)
992 (void)sv_2mortal(href);
993 }
994
7d49f689 995 todumpav = namesav = NULL;
5c284bb0 996 seenhv = NULL;
30b4f386 997 val = pad = xpad = apad = sep = pair = varname
65e66c80 998 = freezer = toaster = bless = sortkeys = &PL_sv_undef;
823edd99 999 name = sv_newmortal();
1000 indent = 2;
497b47a8 1001 terse = purity = deepcopy = 0;
823edd99 1002 quotekeys = 1;
6cde4e94 1003
7820172a 1004 retval = newSVpvn("", 0);
823edd99 1005 if (SvROK(href)
1006 && (hv = (HV*)SvRV((SV*)href))
1007 && SvTYPE(hv) == SVt_PVHV) {
1008
1009 if ((svp = hv_fetch(hv, "seen", 4, FALSE)) && SvROK(*svp))
1010 seenhv = (HV*)SvRV(*svp);
1011 if ((svp = hv_fetch(hv, "todump", 6, FALSE)) && SvROK(*svp))
1012 todumpav = (AV*)SvRV(*svp);
1013 if ((svp = hv_fetch(hv, "names", 5, FALSE)) && SvROK(*svp))
1014 namesav = (AV*)SvRV(*svp);
1015 if ((svp = hv_fetch(hv, "indent", 6, FALSE)))
1016 indent = SvIV(*svp);
1017 if ((svp = hv_fetch(hv, "purity", 6, FALSE)))
1018 purity = SvIV(*svp);
1019 if ((svp = hv_fetch(hv, "terse", 5, FALSE)))
1020 terse = SvTRUE(*svp);
497b47a8 1021#if 0 /* useqq currently unused */
823edd99 1022 if ((svp = hv_fetch(hv, "useqq", 5, FALSE)))
1023 useqq = SvTRUE(*svp);
497b47a8 1024#endif
823edd99 1025 if ((svp = hv_fetch(hv, "pad", 3, FALSE)))
1026 pad = *svp;
1027 if ((svp = hv_fetch(hv, "xpad", 4, FALSE)))
1028 xpad = *svp;
1029 if ((svp = hv_fetch(hv, "apad", 4, FALSE)))
1030 apad = *svp;
1031 if ((svp = hv_fetch(hv, "sep", 3, FALSE)))
1032 sep = *svp;
30b4f386 1033 if ((svp = hv_fetch(hv, "pair", 4, FALSE)))
1034 pair = *svp;
823edd99 1035 if ((svp = hv_fetch(hv, "varname", 7, FALSE)))
1036 varname = *svp;
1037 if ((svp = hv_fetch(hv, "freezer", 7, FALSE)))
1038 freezer = *svp;
1039 if ((svp = hv_fetch(hv, "toaster", 7, FALSE)))
1040 toaster = *svp;
1041 if ((svp = hv_fetch(hv, "deepcopy", 8, FALSE)))
1042 deepcopy = SvTRUE(*svp);
1043 if ((svp = hv_fetch(hv, "quotekeys", 9, FALSE)))
1044 quotekeys = SvTRUE(*svp);
1045 if ((svp = hv_fetch(hv, "bless", 5, FALSE)))
1046 bless = *svp;
a2126434 1047 if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE)))
1048 maxdepth = SvIV(*svp);
e9105f86 1049 if ((svp = hv_fetch(hv, "sortkeys", 8, FALSE))) {
1050 sortkeys = *svp;
1051 if (! SvTRUE(sortkeys))
1052 sortkeys = NULL;
1053 else if (! (SvROK(sortkeys) &&
1054 SvTYPE(SvRV(sortkeys)) == SVt_PVCV) )
1055 {
1056 /* flag to use qsortsv() for sorting hash keys */
1057 sortkeys = &PL_sv_yes;
1058 }
1059 }
823edd99 1060 postav = newAV();
1061
1062 if (todumpav)
1063 imax = av_len(todumpav);
1064 else
1065 imax = -1;
7820172a 1066 valstr = newSVpvn("",0);
823edd99 1067 for (i = 0; i <= imax; ++i) {
1068 SV *newapad;
6cde4e94 1069
823edd99 1070 av_clear(postav);
1071 if ((svp = av_fetch(todumpav, i, FALSE)))
1072 val = *svp;
1073 else
3280af22 1074 val = &PL_sv_undef;
d20128b8 1075 if ((svp = av_fetch(namesav, i, TRUE))) {
823edd99 1076 sv_setsv(name, *svp);
d20128b8 1077 if (SvOK(*svp) && !SvPOK(*svp))
1078 (void)SvPV_nolen_const(name);
1079 }
823edd99 1080 else
8063af02 1081 (void)SvOK_off(name);
6cde4e94 1082
d20128b8 1083 if (SvPOK(name)) {
aa07b2f6 1084 if ((SvPVX_const(name))[0] == '*') {
823edd99 1085 if (SvROK(val)) {
1086 switch (SvTYPE(SvRV(val))) {
1087 case SVt_PVAV:
1088 (SvPVX(name))[0] = '@';
1089 break;
1090 case SVt_PVHV:
1091 (SvPVX(name))[0] = '%';
1092 break;
1093 case SVt_PVCV:
1094 (SvPVX(name))[0] = '*';
1095 break;
1096 default:
1097 (SvPVX(name))[0] = '$';
1098 break;
1099 }
1100 }
1101 else
1102 (SvPVX(name))[0] = '$';
1103 }
aa07b2f6 1104 else if ((SvPVX_const(name))[0] != '$')
823edd99 1105 sv_insert(name, 0, 0, "$", 1);
1106 }
1107 else {
9061c4b9 1108 STRLEN nchars;
823edd99 1109 sv_setpvn(name, "$", 1);
1110 sv_catsv(name, varname);
f5def3a2 1111 nchars = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"IVdf, (IV)(i+1));
823edd99 1112 sv_catpvn(name, tmpbuf, nchars);
1113 }
6cde4e94 1114
823edd99 1115 if (indent >= 2) {
9061c4b9 1116 SV * const tmpsv = sv_x(aTHX_ NULL, " ", 1, SvCUR(name)+3);
823edd99 1117 newapad = newSVsv(apad);
1118 sv_catsv(newapad, tmpsv);
1119 SvREFCNT_dec(tmpsv);
1120 }
1121 else
1122 newapad = apad;
6cde4e94 1123
aa07b2f6 1124 DD_dump(aTHX_ val, SvPVX_const(name), SvCUR(name), valstr, seenhv,
30b4f386 1125 postav, &level, indent, pad, xpad, newapad, sep, pair,
823edd99 1126 freezer, toaster, purity, deepcopy, quotekeys,
e9105f86 1127 bless, maxdepth, sortkeys);
6cde4e94 1128
823edd99 1129 if (indent >= 2)
1130 SvREFCNT_dec(newapad);
1131
1132 postlen = av_len(postav);
1133 if (postlen >= 0 || !terse) {
1134 sv_insert(valstr, 0, 0, " = ", 3);
aa07b2f6 1135 sv_insert(valstr, 0, 0, SvPVX_const(name), SvCUR(name));
823edd99 1136 sv_catpvn(valstr, ";", 1);
1137 }
1138 sv_catsv(retval, pad);
1139 sv_catsv(retval, valstr);
1140 sv_catsv(retval, sep);
1141 if (postlen >= 0) {
1142 I32 i;
1143 sv_catsv(retval, pad);
1144 for (i = 0; i <= postlen; ++i) {
1145 SV *elem;
1146 svp = av_fetch(postav, i, FALSE);
1147 if (svp && (elem = *svp)) {
1148 sv_catsv(retval, elem);
1149 if (i < postlen) {
1150 sv_catpvn(retval, ";", 1);
1151 sv_catsv(retval, sep);
1152 sv_catsv(retval, pad);
1153 }
1154 }
1155 }
1156 sv_catpvn(retval, ";", 1);
1157 sv_catsv(retval, sep);
1158 }
1159 sv_setpvn(valstr, "", 0);
1160 if (gimme == G_ARRAY) {
1161 XPUSHs(sv_2mortal(retval));
1162 if (i < imax) /* not the last time thro ? */
7820172a 1163 retval = newSVpvn("",0);
823edd99 1164 }
1165 }
1166 SvREFCNT_dec(postav);
1167 SvREFCNT_dec(valstr);
1168 }
1169 else
1170 croak("Call to new() method failed to return HASH ref");
1171 if (gimme == G_SCALAR)
1172 XPUSHs(sv_2mortal(retval));
1173 }
Unnamed repository; edit this file to name it for gitweb.