Dumper.xs revision 7c478bd95313f5f23a4c958a745db2134aa03244
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifndef PERL_VERSION
#include "patchlevel.h"
#define PERL_VERSION PATCHLEVEL
#endif
#if PERL_VERSION < 5
# ifndef PL_sv_undef
# define PL_sv_undef sv_undef
# endif
# ifndef ERRSV
# endif
# ifndef newSVpvn
# endif
#endif
/* does a string need to be protected? */
static I32
needs_quote(register char *s)
{
TOP:
if (s[0] == ':') {
if (*++s) {
if (*s++ != ':')
return 1;
}
else
return 1;
}
if (isIDFIRST(*s)) {
while (*++s)
if (!isALNUM(*s)) {
if (*s == ':')
goto TOP;
else
return 1;
}
}
else
return 1;
return 0;
}
/* count the number of "'"s and "\"s in string */
static I32
{
while (slen > 0) {
if (*s == '\'' || *s == '\\')
++ret;
++s;
--slen;
}
return ret;
}
/* returns number of chars added to escape "'"s and "\"s in s */
/* slen number of characters in s will be escaped */
/* destination must be long enough for additional chars */
static I32
{
while (slen > 0) {
switch (*s) {
case '\'':
case '\\':
*d = '\\';
++d; ++ret;
default:
*d = *s;
++d; ++s; --slen;
break;
}
}
return ret;
}
/* append a repeated string to an SV */
static SV *
{
else
if (n > 0) {
if (len == 1) {
start[n] = '\0';
while (n > 0)
}
else
while (n > 0) {
--n;
}
}
return sv;
}
/*
* This ought to be split into smaller functions. (it is one long function since
* it exactly parallels the perl version, which was one long thing for
* efficiency raisins.) Ugggh!
*/
static I32
{
char tmpbuf[128];
U32 i;
char *iname;
if (!val)
return 0;
if (SvGMAGICAL(val))
{
warn("WARNING(Freezer method call failed): %s",
else if (i)
if (i)
(void)sv_2mortal(val);
}
else
/* if it has a name, we need to either look it up, or keep a tab
* on it so we know when we hit it later
*/
if (namelen) {
{
{
else
}
else {
}
else {
}
}
else
}
return 1;
}
else {
return 0;
}
}
else { /* store our name and continue */
}
}
else
(void)SvREFCNT_inc(val);
}
}
while (slash) {
}
return 1;
}
/* If purity is not set and maxdepth is set, then check depth:
* if we have reached maximum depth, return the string
* representation of the thing we are currently examining
* at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
*/
return 1;
}
if (realpack) { /* we have a blessed ref */
if (indent >= 2) {
}
}
(*levelp)++;
if (realpack) { /* blessed */
maxdepth);
} /* plain */
else {
maxdepth);
}
}
maxdepth);
}
/* allowing for a 24 char wide array index */
if (name[0] == '@') {
iname[0] = '$';
}
else {
/* omit "->" in $foo{bar}->[0], but not in ${$foo}->[0] */
/*if (namelen > 0
&& name[namelen-1] != ']' && name[namelen-1] != '}'
&& (namelen < 4 || (name[1] != '{' && name[2] != '{')))*/
if ((namelen > 0
|| (namelen > 4
{
}
}
}
if (svp)
else
elem = &PL_sv_undef;
if (indent >= 3) {
}
maxdepth);
}
if (ixmax >= 0) {
}
if (name[0] == '@')
else
}
char *key;
if (name[0] == '%') {
}
else {
/* omit "->" in $foo[0]->{bar}, but not in ${$foo}->{bar} */
if ((namelen > 0
|| (namelen > 4
{
}
}
}
i = 0;
char *nkey;
if (i)
i++;
nkey[0] = '\'';
if (nticks)
else
}
else {
}
if (indent >= 2) {
char *extra;
}
else
maxdepth);
if (indent >= 2)
}
if (i) {
}
if (name[0] == '%')
else
}
if (purity)
warn("Encountered CODE ref, using dummy placeholder");
}
else {
}
if (realpack) { /* free blessed allocs */
if (indent >= 2) {
}
}
}
(*levelp)--;
}
else {
STRLEN i;
if (namelen) {
{
{
return 1;
}
}
else {
}
}
else
}
++c; --i; /* just get the name */
c += 4;
i -= 4;
}
if (needs_quote(c)) {
r[0] = '*'; r[1] = '{'; r[2] = '\'';
i += esc_q(r+3, c, i);
i += 3;
r[i++] = '\''; r[i++] = '}';
r[i] = '\0';
}
else {
i++;
}
if (purity) {
SV *e;
I32 j;
for (j=0; j<3; j++) {
if (!e)
continue;
if (j == 0 && !SvOK(e))
continue;
{
e = newRV(e);
if (indent >= 2)
SvREFCNT_dec(e);
}
}
}
}
}
else {
r[0] = '\'';
i += esc_q(r+1, c, i);
++i;
r[i++] = '\'';
r[i] = '\0';
}
}
if (idlen) {
if (deepcopy)
}
}
return 1;
}
#
#
void
Data_Dumper_Dumpxs(href, ...)
PROTOTYPE: $;$$
{
char tmpbuf[1024];
if (items < 2)
croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, [NAME_ARY_REF])");
if (items >= 3)
if (i)
if (i)
(void)sv_2mortal(href);
}
name = sv_newmortal();
indent = 2;
quotekeys = 1;
if (todumpav)
else
imax = -1;
for (i = 0; i <= imax; ++i) {
else
val = &PL_sv_undef;
else
case SVt_PVAV:
break;
case SVt_PVHV:
break;
case SVt_PVCV:
break;
default:
break;
}
}
else
}
}
else {
}
if (indent >= 2) {
}
else
if (indent >= 2)
}
if (postlen >= 0) {
I32 i;
for (i = 0; i <= postlen; ++i) {
if (i < postlen) {
}
}
}
}
if (i < imax) /* not the last time thro ? */
}
}
}
else
croak("Call to new() method failed to return HASH ref");
}