diff options
Diffstat (limited to 'contrib/perl5/ext/Data')
-rw-r--r-- | contrib/perl5/ext/Data/Dumper/Changes | 15 | ||||
-rw-r--r-- | contrib/perl5/ext/Data/Dumper/Dumper.pm | 195 | ||||
-rw-r--r-- | contrib/perl5/ext/Data/Dumper/Dumper.xs | 142 | ||||
-rw-r--r-- | contrib/perl5/ext/Data/Dumper/Todo | 6 |
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 |