summaryrefslogtreecommitdiffstats
path: root/contrib/perl5/ext/Data
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/perl5/ext/Data')
-rw-r--r--contrib/perl5/ext/Data/Dumper/Changes15
-rw-r--r--contrib/perl5/ext/Data/Dumper/Dumper.pm195
-rw-r--r--contrib/perl5/ext/Data/Dumper/Dumper.xs142
-rw-r--r--contrib/perl5/ext/Data/Dumper/Todo6
4 files changed, 227 insertions, 131 deletions
diff --git a/contrib/perl5/ext/Data/Dumper/Changes b/contrib/perl5/ext/Data/Dumper/Changes
index 9a96eda..161aba9 100644
--- a/contrib/perl5/ext/Data/Dumper/Changes
+++ b/contrib/perl5/ext/Data/Dumper/Changes
@@ -6,6 +6,21 @@ HISTORY - public release history for Data::Dumper
=over 8
+=item 2.11 (unreleased)
+
+C<0> is now dumped as such, not as C<'0'>.
+
+qr// objects are now dumped correctly (provided a post-5.005_58)
+overload.pm exists).
+
+Implemented $Data::Dumper::Maxdepth, which was on the Todo list.
+Thanks to John Nolan <jpnolan@Op.Net>.
+
+=item 2.101 (30 Apr 1999)
+
+Minor release to sync with version in 5.005_03. Fixes dump of
+dummy coderefs.
+
=item 2.10 (31 Oct 1998)
Bugfixes for dumping related undef values, globs, and better double
diff --git a/contrib/perl5/ext/Data/Dumper/Dumper.pm b/contrib/perl5/ext/Data/Dumper/Dumper.pm
index b1fd2b7..93b87f9 100644
--- a/contrib/perl5/ext/Data/Dumper/Dumper.pm
+++ b/contrib/perl5/ext/Data/Dumper/Dumper.pm
@@ -9,22 +9,22 @@
package Data::Dumper;
-$VERSION = $VERSION = '2.101';
+$VERSION = '2.101';
#$| = 1;
-require 5.004;
+require 5.005_64;
require Exporter;
-require DynaLoader;
+use XSLoader ();
require overload;
use Carp;
-@ISA = qw(Exporter DynaLoader);
+@ISA = qw(Exporter);
@EXPORT = qw(Dumper);
@EXPORT_OK = qw(DumperX);
-bootstrap Data::Dumper;
+XSLoader::load 'Data::Dumper';
# module vars and their defaults
$Indent = 2 unless defined $Indent;
@@ -39,7 +39,7 @@ $Deepcopy = 0 unless defined $Deepcopy;
$Quotekeys = 1 unless defined $Quotekeys;
$Bless = "bless" unless defined $Bless;
#$Expdepth = 0 unless defined $Expdepth;
-#$Maxdepth = 0 unless defined $Maxdepth;
+$Maxdepth = 0 unless defined $Maxdepth;
#
# expects an arrayref of values to be dumped.
@@ -74,7 +74,7 @@ sub new {
quotekeys => $Quotekeys, # quote hash keys
'bless' => $Bless, # keyword to use for "bless"
# expdepth => $Expdepth, # cutoff depth for explicit dumping
-# maxdepth => $Maxdepth, # depth beyond which we give up
+ maxdepth => $Maxdepth, # depth beyond which we give up
};
if ($Indent > 0) {
@@ -146,11 +146,17 @@ sub Names {
sub DESTROY {}
+sub Dump {
+ return &Dumpxs
+ unless $Data::Dumper::Useqq || (ref($_[0]) && $_[0]->{useqq});
+ return &Dumpperl;
+}
+
#
# dump the refs in the current dumper object.
# expects same args as new() if called via package name.
#
-sub Dump {
+sub Dumpperl {
my($s) = shift;
my(@out, $val, $name);
my($i) = 0;
@@ -214,14 +220,13 @@ sub _dump {
if ($type) {
# prep it, if it looks like an object
- if ($type =~ /[a-z_:]/) {
- my $freezer = $s->{freezer};
- $val->$freezer() if $freezer && UNIVERSAL::can($val, $freezer);
+ if (my $freezer = $s->{freezer}) {
+ $val->$freezer() if UNIVERSAL::can($val, $freezer);
}
($realpack, $realtype, $id) =
(overload::StrVal($val) =~ /^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$/);
-
+
# 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 (defined($name) and length($name)) {
@@ -231,7 +236,7 @@ sub _dump {
if ($s->{purity} and $s->{level} > 0) {
$out = ($realtype eq 'HASH') ? '{}' :
($realtype eq 'ARRAY') ? '[]' :
- "''" ;
+ 'do{my $o}' ;
push @post, $name . " = " . $s->{seen}{$id}[0];
}
else {
@@ -259,14 +264,33 @@ sub _dump {
}
}
- $s->{level}++;
- $ipad = $s->{xpad} x $s->{level};
+ if ($realpack and $realpack eq 'Regexp') {
+ $out = "$val";
+ $out =~ s,/,\\/,g;
+ return "qr/$out/";
+ }
+
+ # 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)').
+ if (!$s->{purity}
+ and $s->{maxdepth} > 0
+ and $s->{level} >= $s->{maxdepth})
+ {
+ return qq['$val'];
+ }
- if ($realpack) { # we have a blessed ref
+ # we have a blessed ref
+ if ($realpack) {
$out = $s->{'bless'} . '( ';
$blesspad = $s->{apad};
$s->{apad} .= ' ' if ($s->{indent} >= 2);
}
+
+ $s->{level}++;
+ $ipad = $s->{xpad} x $s->{level};
+
if ($realtype eq 'SCALAR') {
if ($realpack) {
@@ -389,7 +413,7 @@ sub _dump {
elsif (!defined($val)) {
$out .= "undef";
}
- elsif ($val =~ /^-?[1-9]\d{0,8}$/) { # safe decimal number
+ elsif ($val =~ /^(?:0|-?[1-9]\d{0,8})$/) { # safe decimal number
$out .= $val;
}
else { # string
@@ -422,9 +446,7 @@ sub Dumper {
return Data::Dumper->Dump([@_]);
}
-#
-# same, only calls the XS version
-#
+# compat stub
sub DumperX {
return Data::Dumper->Dumpxs([@_], []);
}
@@ -511,6 +533,12 @@ sub Bless {
defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
}
+sub Maxdepth {
+ my($s, $v) = @_;
+ defined($v) ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'};
+}
+
+
# used by qquote below
my %esc = (
"\a" => "\\a",
@@ -526,25 +554,35 @@ my %esc = (
sub qquote {
local($_) = shift;
s/([\\\"\@\$])/\\$1/g;
- return qq("$_") unless /[^\040-\176]/; # fast exit
+ return qq("$_") unless
+ /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/; # fast exit
my $high = shift || "";
s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
- # no need for 3 digits in escape for these
- s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
-
- s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
- if ($high eq "iso8859") {
- s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
- } elsif ($high eq "utf8") {
-# use utf8;
-# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
- } elsif ($high eq "8bit") {
- # leave it as it is
- } else {
- s/([\0-\037\177-\377])/'\\'.sprintf('%03o',ord($1))/eg;
+ if (ord('^')==94) { # ascii
+ # no need for 3 digits in escape for these
+ s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
+ s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
+ # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE--
+ if ($high eq "iso8859") {
+ s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
+ } elsif ($high eq "utf8") {
+# use utf8;
+# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
+ } elsif ($high eq "8bit") {
+ # leave it as it is
+ } else {
+ s/([\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
+ }
}
+ else { # ebcdic
+ s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])(?!\d)}
+ {my $v = ord($1); '\\'.sprintf(($v <= 037 ? '%o' : '%03o'), $v)}eg;
+ s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])}
+ {'\\'.sprintf('%03o',ord($1))}eg;
+ }
+
return qq("$_");
}
@@ -653,12 +691,6 @@ of strings corresponding to the supplied values.
The second form, for convenience, simply calls the C<new> method on its
arguments before dumping the object immediately.
-=item I<$OBJ>->Dumpxs I<or> I<PACKAGE>->Dumpxs(I<ARRAYREF [>, I<ARRAYREF]>)
-
-This method is available if you were able to compile and install the XSUB
-extension to C<Data::Dumper>. It is exactly identical to the C<Dump> method
-above, only about 4 to 5 times faster, since it is written entirely in C.
-
=item I<$OBJ>->Seen(I<[HASHREF]>)
Queries or adds to the internal table of already encountered references.
@@ -702,12 +734,6 @@ configuration options below. The values will be named C<$VAR>I<n> in the
output, where I<n> is a numeric suffix. Will return a list of strings
in an array context.
-=item DumperX(I<LIST>)
-
-Identical to the C<Dumper()> function above, but this calls the XSUB
-implementation. Only available if you were able to compile and install
-the XSUB extensions in C<Data::Dumper>.
-
=back
=head2 Configuration Variables or Methods
@@ -763,8 +789,8 @@ When set, enables the use of double quotes for representing string values.
Whitespace other than space will be represented as C<[\n\t\r]>, "unsafe"
characters will be backslashed, and unprintable characters will be output as
quoted octal integers. Since setting this variable imposes a performance
-penalty, the default is 0. The C<Dumpxs()> method does not honor this
-flag yet.
+penalty, the default is 0. C<Dump()> will run slower if this flag is set,
+since the fast XSUB implementation doesn't support it yet.
=item $Data::Dumper::Terse I<or> I<$OBJ>->Terse(I<[NEWVAL]>)
@@ -814,6 +840,14 @@ builtin operator used to create objects. A function with the specified
name should exist, and should accept the same arguments as the builtin.
Default is C<bless>.
+=item $Data::Dumper::Maxdepth I<or> $I<OBJ>->Maxdepth(I<[NEWVAL]>)
+
+Can be set to a positive integer that specifies the depth beyond which
+which we don't venture into a structure. Has no effect when
+C<Data::Dumper::Purity> is set. (Useful in debugger when we often don't
+want to see more than enough). Default is 0, which means there is
+no maximum depth.
+
=back
=head2 Exports
@@ -847,7 +881,7 @@ distribution for more examples.)
$boo = [ 1, [], "abcd", \*foo,
{1 => 'a', 023 => 'b', 0x45 => 'c'},
\\"p\q\'r", $foo, $fuz];
-
+
########
# simple usage
########
@@ -868,12 +902,12 @@ distribution for more examples.)
$Data::Dumper::Useqq = 1; # print strings in double quotes
print Dumper($boo);
-
-
+
+
########
# recursive structures
########
-
+
@c = ('c');
$c = \@c;
$b = {};
@@ -882,37 +916,52 @@ distribution for more examples.)
$b->{b} = $a->[1];
$b->{c} = $a->[2];
print Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]);
-
-
+
+
$Data::Dumper::Purity = 1; # fill in the holes for eval
print Data::Dumper->Dump([$a, $b], [qw(*a b)]); # print as @a
print Data::Dumper->Dump([$b, $a], [qw(*b a)]); # print as %b
-
-
+
+
$Data::Dumper::Deepcopy = 1; # avoid cross-refs
print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
-
-
+
+
$Data::Dumper::Purity = 0; # avoid cross-refs
print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
-
-
+
+ ########
+ # deep structures
+ ########
+
+ $a = "pearl";
+ $b = [ $a ];
+ $c = { 'b' => $b };
+ $d = [ $c ];
+ $e = { 'd' => $d };
+ $f = { 'e' => $e };
+ print Data::Dumper->Dump([$f], [qw(f)]);
+
+ $Data::Dumper::Maxdepth = 3; # no deeper than 3 refs down
+ print Data::Dumper->Dump([$f], [qw(f)]);
+
+
########
# object-oriented usage
########
-
+
$d = Data::Dumper->new([$a,$b], [qw(a b)]);
$d->Seen({'*c' => $c}); # stash a ref without printing it
$d->Indent(3);
print $d->Dump;
$d->Reset->Purity(0); # empty the seen cache
print join "----\n", $d->Dump;
-
-
+
+
########
# persistence
########
-
+
package Foo;
sub new { bless { state => 'awake' }, shift }
sub Freeze {
@@ -921,7 +970,7 @@ distribution for more examples.)
$s->{state} = 'asleep';
return bless $s, 'Foo::ZZZ';
}
-
+
package Foo::ZZZ;
sub Thaw {
my $s = shift;
@@ -929,7 +978,7 @@ distribution for more examples.)
$s->{state} = 'awake';
return bless $s, 'Foo';
}
-
+
package Foo;
use Data::Dumper;
$a = Foo->new;
@@ -940,12 +989,12 @@ distribution for more examples.)
print $c;
$d = eval $c;
print Data::Dumper->Dump([$d], ['d']);
-
-
+
+
########
# symbol substitution (useful for recreating CODE refs)
########
-
+
sub foo { print "foo speaking\n" }
*other = \&foo;
$bar = [ \&other ];
@@ -974,15 +1023,15 @@ to have, you can use the C<Seen> method to pre-seed the internal reference
table and make the dumped output point to them, instead. See L<EXAMPLES>
above.
-The C<Useqq> flag is not honored by C<Dumpxs()> (it always outputs
-strings in single quotes).
+The C<Useqq> flag makes Dump() run slower, since the XSUB implementation
+does not support it.
SCALAR objects have the weirdest looking C<bless> workaround.
=head1 AUTHOR
-Gurusamy Sarathy gsar@umich.edu
+Gurusamy Sarathy gsar@activestate.com
Copyright (c) 1996-98 Gurusamy Sarathy. All rights reserved.
This program is free software; you can redistribute it and/or
@@ -991,7 +1040,7 @@ modify it under the same terms as Perl itself.
=head1 VERSION
-Version 2.10 (31 Oct 1998)
+Version 2.11 (unreleased)
=head1 SEE ALSO
diff --git a/contrib/perl5/ext/Data/Dumper/Dumper.xs b/contrib/perl5/ext/Data/Dumper/Dumper.xs
index a3da110..990ea74 100644
--- a/contrib/perl5/ext/Data/Dumper/Dumper.xs
+++ b/contrib/perl5/ext/Data/Dumper/Dumper.xs
@@ -1,10 +1,14 @@
+#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 PATCHLEVEL < 5
+#if PERL_VERSION < 5
# ifndef PL_sv_undef
# define PL_sv_undef sv_undef
# endif
@@ -16,14 +20,15 @@
# endif
#endif
-static I32 num_q _((char *s, STRLEN slen));
-static I32 esc_q _((char *dest, char *src, STRLEN slen));
-static SV *sv_x _((SV *sv, char *str, STRLEN len, I32 n));
-static I32 DD_dump _((SV *val, char *name, STRLEN namelen, SV *retval,
- HV *seenhv, AV *postav, I32 *levelp, I32 indent,
- SV *pad, SV *xpad, SV *apad, SV *sep,
- SV *freezer, SV *toaster,
- I32 purity, I32 deepcopy, I32 quotekeys, SV *bless));
+static I32 num_q (char *s, STRLEN slen);
+static I32 esc_q (char *dest, char *src, STRLEN slen);
+static SV *sv_x (pTHX_ SV *sv, char *str, STRLEN len, I32 n);
+static I32 DD_dump (pTHX_ SV *val, char *name, STRLEN namelen, SV *retval,
+ HV *seenhv, AV *postav, I32 *levelp, I32 indent,
+ SV *pad, SV *xpad, SV *apad, SV *sep,
+ SV *freezer, SV *toaster,
+ I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
+ I32 maxdepth);
/* does a string need to be protected? */
static I32
@@ -40,11 +45,12 @@ TOP:
}
if (isIDFIRST(*s)) {
while (*++s)
- if (!isALNUM(*s))
+ if (!isALNUM(*s)) {
if (*s == ':')
goto TOP;
else
return 1;
+ }
}
else
return 1;
@@ -92,7 +98,7 @@ esc_q(register char *d, register char *s, register STRLEN slen)
/* append a repeated string to an SV */
static SV *
-sv_x(SV *sv, register char *str, STRLEN len, I32 n)
+sv_x(pTHX_ SV *sv, register char *str, STRLEN len, I32 n)
{
if (sv == Nullsv)
sv = newSVpvn("", 0);
@@ -123,10 +129,10 @@ sv_x(SV *sv, register char *str, STRLEN len, I32 n)
* efficiency raisins.) Ugggh!
*/
static I32
-DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
+DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad,
SV *apad, SV *sep, SV *freezer, SV *toaster, I32 purity,
- I32 deepcopy, I32 quotekeys, SV *bless)
+ I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth)
{
char tmpbuf[128];
U32 i;
@@ -196,7 +202,7 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
else if (realtype == SVt_PVAV)
sv_catpvn(retval, "[]", 2);
else
- sv_catpvn(retval, "''", 2);
+ sv_catpvn(retval, "do{my $o}", 9);
postentry = newSVpvn(name, namelen);
sv_catpvn(postentry, " = ", 3);
sv_catsv(postentry, othername);
@@ -248,11 +254,39 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
SvREFCNT_dec(seenentry);
}
}
-
- (*levelp)++;
- ipad = sv_x(Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp);
- if (realpack) { /* we have a blessed ref */
+ if (realpack && *realpack == 'R' && strEQ(realpack, "Regexp")) {
+ STRLEN rlen;
+ char *rval = SvPV(val, rlen);
+ char *slash = strchr(rval, '/');
+ sv_catpvn(retval, "qr/", 3);
+ while (slash) {
+ sv_catpvn(retval, rval, slash-rval);
+ sv_catpvn(retval, "\\/", 2);
+ rlen -= slash-rval+1;
+ rval = slash+1;
+ slash = strchr(rval, '/');
+ }
+ sv_catpvn(retval, rval, rlen);
+ sv_catpvn(retval, "/", 1);
+ 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)').
+ */
+ if (!purity && maxdepth > 0 && *levelp >= maxdepth) {
+ STRLEN vallen;
+ char *valstr = SvPV(val,vallen);
+ sv_catpvn(retval, "'", 1);
+ sv_catpvn(retval, valstr, vallen);
+ sv_catpvn(retval, "'", 1);
+ return 1;
+ }
+
+ if (realpack) { /* we have a blessed ref */
STRLEN blesslen;
char *blessstr = SvPV(bless, blesslen);
sv_catpvn(retval, blessstr, blesslen);
@@ -260,26 +294,31 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
if (indent >= 2) {
blesspad = apad;
apad = newSVsv(apad);
- sv_x(apad, " ", 1, blesslen+2);
+ sv_x(aTHX_ apad, " ", 1, blesslen+2);
}
}
+ (*levelp)++;
+ ipad = sv_x(aTHX_ Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp);
+
if (realtype <= SVt_PVBM) { /* scalar ref */
SV *namesv = newSVpvn("${", 2);
sv_catpvn(namesv, name, namelen);
sv_catpvn(namesv, "}", 1);
if (realpack) { /* blessed */
sv_catpvn(retval, "do{\\(my $o = ", 13);
- DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
+ DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
postav, levelp, indent, pad, xpad, apad, sep,
- freezer, toaster, purity, deepcopy, quotekeys, bless);
+ freezer, toaster, purity, deepcopy, quotekeys, bless,
+ maxdepth);
sv_catpvn(retval, ")}", 2);
} /* plain */
else {
sv_catpvn(retval, "\\", 1);
- DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
+ DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
postav, levelp, indent, pad, xpad, apad, sep,
- freezer, toaster, purity, deepcopy, quotekeys, bless);
+ freezer, toaster, purity, deepcopy, quotekeys, bless,
+ maxdepth);
}
SvREFCNT_dec(namesv);
}
@@ -288,9 +327,10 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catpvn(namesv, name, namelen);
sv_catpvn(namesv, "}", 1);
sv_catpvn(retval, "\\", 1);
- DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
+ DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
postav, levelp, indent, pad, xpad, apad, sep,
- freezer, toaster, purity, deepcopy, quotekeys, bless);
+ freezer, toaster, purity, deepcopy, quotekeys, bless,
+ maxdepth);
SvREFCNT_dec(namesv);
}
else if (realtype == SVt_PVAV) {
@@ -345,7 +385,7 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
ilen = inamelen;
sv_setiv(ixsv, ix);
- (void) sprintf(iname+ilen, "%ld", ix);
+ (void) sprintf(iname+ilen, "%"IVdf, (IV)ix);
ilen = strlen(iname);
iname[ilen++] = ']'; iname[ilen] = '\0';
if (indent >= 3) {
@@ -356,14 +396,15 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
}
sv_catsv(retval, totpad);
sv_catsv(retval, ipad);
- DD_dump(elem, iname, ilen, retval, seenhv, postav,
+ DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
levelp, indent, pad, xpad, apad, sep,
- freezer, toaster, purity, deepcopy, quotekeys, bless);
+ freezer, toaster, purity, deepcopy, quotekeys, bless,
+ maxdepth);
if (ix < ixmax)
sv_catpvn(retval, ",", 1);
}
if (ixmax >= 0) {
- SV *opad = sv_x(Nullsv, SvPVX(xpad), SvCUR(xpad), (*levelp)-1);
+ SV *opad = sv_x(aTHX_ Nullsv, SvPVX(xpad), SvCUR(xpad), (*levelp)-1);
sv_catsv(retval, totpad);
sv_catsv(retval, opad);
SvREFCNT_dec(opad);
@@ -462,16 +503,17 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
else
newapad = apad;
- DD_dump(hval, SvPVX(sname), SvCUR(sname), retval, seenhv,
+ DD_dump(aTHX_ hval, SvPVX(sname), SvCUR(sname), retval, seenhv,
postav, levelp, indent, pad, xpad, newapad, sep,
- freezer, toaster, purity, deepcopy, quotekeys, bless);
+ freezer, toaster, purity, deepcopy, quotekeys, bless,
+ maxdepth);
SvREFCNT_dec(sname);
Safefree(nkey);
if (indent >= 2)
SvREFCNT_dec(newapad);
}
if (i) {
- SV *opad = sv_x(Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp-1);
+ SV *opad = sv_x(aTHX_ Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp-1);
sv_catsv(retval, totpad);
sv_catsv(retval, opad);
SvREFCNT_dec(opad);
@@ -543,7 +585,7 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
if (SvIOK(val)) {
STRLEN len;
i = SvIV(val);
- (void) sprintf(tmpbuf, "%d", i);
+ (void) sprintf(tmpbuf, "%"IVdf, (IV)i);
len = strlen(tmpbuf);
sv_catpvn(retval, tmpbuf, len);
}
@@ -599,12 +641,12 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
SvCUR(newapad) = 0;
if (indent >= 2)
- (void)sv_x(newapad, " ", 1, SvCUR(postentry));
+ (void)sv_x(aTHX_ newapad, " ", 1, SvCUR(postentry));
- DD_dump(e, SvPVX(nname), SvCUR(nname), postentry,
+ DD_dump(aTHX_ e, SvPVX(nname), SvCUR(nname), postentry,
seenhv, postav, &nlevel, indent, pad, xpad,
newapad, sep, freezer, toaster, purity,
- deepcopy, quotekeys, bless);
+ deepcopy, quotekeys, bless, maxdepth);
SvREFCNT_dec(e);
}
}
@@ -664,28 +706,22 @@ Data_Dumper_Dumpxs(href, ...)
SV **svp;
SV *val, *name, *pad, *xpad, *apad, *sep, *tmp, *varname;
SV *freezer, *toaster, *bless;
- I32 purity, deepcopy, quotekeys;
+ I32 purity, deepcopy, quotekeys, maxdepth = 0;
char tmpbuf[1024];
I32 gimme = GIMME;
if (!SvROK(href)) { /* call new to get an object first */
- SV *valarray;
- SV *namearray;
-
- if (items == 3) {
- valarray = ST(1);
- namearray = ST(2);
- }
- else
- croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, NAME_ARY_REF)");
+ if (items < 2)
+ croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, [NAME_ARY_REF])");
ENTER;
SAVETMPS;
PUSHMARK(sp);
XPUSHs(href);
- XPUSHs(sv_2mortal(newSVsv(valarray)));
- XPUSHs(sv_2mortal(newSVsv(namearray)));
+ XPUSHs(sv_2mortal(newSVsv(ST(1))));
+ if (items >= 3)
+ XPUSHs(sv_2mortal(newSVsv(ST(2))));
PUTBACK;
i = perl_call_method("new", G_SCALAR);
SPAGAIN;
@@ -747,6 +783,8 @@ Data_Dumper_Dumpxs(href, ...)
quotekeys = SvTRUE(*svp);
if ((svp = hv_fetch(hv, "bless", 5, FALSE)))
bless = *svp;
+ if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE)))
+ maxdepth = SvIV(*svp);
postav = newAV();
if (todumpav)
@@ -795,13 +833,13 @@ Data_Dumper_Dumpxs(href, ...)
STRLEN nchars = 0;
sv_setpvn(name, "$", 1);
sv_catsv(name, varname);
- (void) sprintf(tmpbuf, "%ld", i+1);
+ (void) sprintf(tmpbuf, "%"IVdf, (IV)(i+1));
nchars = strlen(tmpbuf);
sv_catpvn(name, tmpbuf, nchars);
}
if (indent >= 2) {
- SV *tmpsv = sv_x(Nullsv, " ", 1, SvCUR(name)+3);
+ SV *tmpsv = sv_x(aTHX_ Nullsv, " ", 1, SvCUR(name)+3);
newapad = newSVsv(apad);
sv_catsv(newapad, tmpsv);
SvREFCNT_dec(tmpsv);
@@ -809,10 +847,10 @@ Data_Dumper_Dumpxs(href, ...)
else
newapad = apad;
- DD_dump(val, SvPVX(name), SvCUR(name), valstr, seenhv,
+ DD_dump(aTHX_ val, SvPVX(name), SvCUR(name), valstr, seenhv,
postav, &level, indent, pad, xpad, newapad, sep,
freezer, toaster, purity, deepcopy, quotekeys,
- bless);
+ bless, maxdepth);
if (indent >= 2)
SvREFCNT_dec(newapad);
diff --git a/contrib/perl5/ext/Data/Dumper/Todo b/contrib/perl5/ext/Data/Dumper/Todo
index 7dcd40b..bd76e65 100644
--- a/contrib/perl5/ext/Data/Dumper/Todo
+++ b/contrib/perl5/ext/Data/Dumper/Todo
@@ -8,12 +8,6 @@ The following functionality will be supported in the next few releases.
=over 4
-=item $Data::Dumper::Maxdepth I<or> $I<OBJ>->Maxdepth(I<NEWVAL>)
-
-Depth beyond which we don't venture into a structure. Has no effect when
-C<Data::Dumper::Purity> is set. (useful in debugger when we often don't
-want to see more than enough).
-
=item $Data::Dumper::Expdepth I<or> $I<OBJ>->Expdepth(I<NEWVAL>)
Dump contents explicitly up to a certain depth and then use names for
OpenPOWER on IntegriCloud