[PATCH]5.005_60 (Data::Dumper) - implements Maxdepth setting

[p5pRT]

Migrated from rt.perl.org#1171 (status was 'resolved')

Searchable as RT1171$

[p5pRT]

From jpnolan@Op.Net

This feature is useful for debugging or development. It makes it
easier to isolate and dump structures which contain references
to other large or extensive structures.

The following files are updated​:

  t/lib/dumper.t
  ext/Data/Dumper/Changes
  ext/Data/Dumper/Dumper.pm
  ext/Data/Dumper/Dumper.xs
  ext/Data/Dumper/Todo

I'm not sure whether this type of patch is appropriate for
submission at this stage of development. My apologies if
this is the wrong time.

--J.Nolan

Apply this patch as folllows​: patch -d perl5.005_60 -p1 < patchfile

diff -rc perl5.005_60/ext/Data/Dumper/Changes perl5.005_60.new/ext/Data/Dumper/Changes
*** perl5.005_60/ext/Data/Dumper/Changes Wed Aug 4 18​:36​:09 1999
--- perl5.005_60.new/ext/Data/Dumper/Changes Wed Aug 4 18​:39​:30 1999
***************
*** 6,11 ****
--- 6,15 ----
 
  =over 8
 
+ =item 2.11 (4 August 1998)
+
+ Implement $Data​::Dumper​::Maxdepth, which was on the Todo list.
+
  =item 2.10 (31 Oct 1998)
 
  Bugfixes for dumping related undef values, globs, and better double
diff -rc perl5.005_60/ext/Data/Dumper/Dumper.pm perl5.005_60.new/ext/Data/Dumper/Dumper.pm
*** perl5.005_60/ext/Data/Dumper/Dumper.pm Wed Aug 4 18​:36​:09 1999
--- perl5.005_60.new/ext/Data/Dumper/Dumper.pm Wed Aug 4 18​:39​:30 1999
***************
*** 9,15 ****
 
  package Data​::Dumper;
 
! $VERSION = $VERSION = '2.101';
 
  #$| = 1;
 
--- 9,15 ----
 
  package Data​::Dumper;
 
! $VERSION = $VERSION = '2.11';
 
  #$| = 1;
 
***************
*** 39,45 ****
  $Quotekeys = 1 unless defined $Quotekeys;
  $Bless = "bless" unless defined $Bless;
  #$Expdepth = 0 unless defined $Expdepth;
! #$Maxdepth = 0 unless defined $Maxdepth;
 
  #
  # expects an arrayref of values to be dumped.
--- 39,45 ----
  $Quotekeys = 1 unless defined $Quotekeys;
  $Bless = "bless" unless defined $Bless;
  #$Expdepth = 0 unless defined $Expdepth;
! $Maxdepth = 0 unless defined $Maxdepth;
 
  #
  # expects an arrayref of values to be dumped.
***************
*** 74,80 ****
  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
  };
 
  if ($Indent > 0) {
--- 74,80 ----
  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
  };
 
  if ($Indent > 0) {
***************
*** 213,218 ****
--- 213,229 ----
 
  if ($type) {
 
+ # If purity is not set and maxdepth is set, then check depth​:
+ # return if we have reached maximum depth. Return a string
+ # describing the thing we are currently examining
+ # at this depth (i.e., $type).
+ #
+ if (not($s->{purity}) and $s->{maxdepth} > 0) {
+ if ($s->{level} >= $s->{maxdepth}) {
+ return $type;
+ }
+ }
+
  # prep it, if it looks like an object
  if ($type =~ /[a-z_​:]/) {
  my $freezer = $s->{freezer};
***************
*** 519,524 ****
--- 530,541 ----
  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",
***************
*** 822,827 ****
--- 839,852 ----
  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
***************
*** 904,909 ****
--- 929,949 ----
  $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
***************
*** 999,1005 ****
 
  =head1 VERSION
 
! Version 2.10 (31 Oct 1998)
 
  =head1 SEE ALSO
 
--- 1039,1045 ----
 
  =head1 VERSION
 
! Version 2.11 (4 Aug 1999)
 
  =head1 SEE ALSO
 
diff -rc perl5.005_60/ext/Data/Dumper/Dumper.xs perl5.005_60.new/ext/Data/Dumper/Dumper.xs
*** perl5.005_60/ext/Data/Dumper/Dumper.xs Wed Aug 4 18​:36​:09 1999
--- perl5.005_60.new/ext/Data/Dumper/Dumper.xs Wed Aug 4 18​:39​:30 1999
***************
*** 27,33 ****
  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);
 
  /* does a string need to be protected? */
  static I32
--- 27,34 ----
  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
***************
*** 130,136 ****
  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)
  {
  char tmpbuf[128];
  U32 i;
--- 131,137 ----
  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)
  {
  char tmpbuf[128];
  U32 i;
***************
*** 154,159 ****
--- 155,183 ----
  mg_get(val);
  if (SvROK(val)) {
 
+ /* If purity is not set and maxdepth is set, then check depth​:
+ * if we have reached maximum depth, then don't follow this ref;
+ * instead just return.
+ */
+ if (!purity && maxdepth > 0)
+ {
+ if ((*levelp) >= maxdepth)
+ {
+ char * open_parens;
+
+ /* Get the stringified value of the ref */
+ (void) sprintf(tmpbuf, "%s", SvPV(val,PL_na),strlen(SvPV(val,PL_na)) );
+
+ /* Eliminate the address value by truncating the string */
+ open_parens = strchr(tmpbuf, '(');
+ if (open_parens != NULL) *open_parens = '\0';
+
+ /* Make this string the return value. */
+ sv_catpvn(retval, tmpbuf, strlen(tmpbuf));
+ return 0;
+ }
+ }
+
  if (SvOBJECT(SvRV(val)) && freezer &&
  SvPOK(freezer) && SvCUR(freezer))
  {
***************
*** 294,307 ****
  sv_catpvn(retval, "do{\\(my $o = ", 13);
  DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
  postav, levelp, indent, pad, xpad, apad, sep,
! freezer, toaster, purity, deepcopy, quotekeys, bless);
  sv_catpvn(retval, ")}", 2);
  } /* plain */
  else {
  sv_catpvn(retval, "\\", 1);
  DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
  postav, levelp, indent, pad, xpad, apad, sep,
! freezer, toaster, purity, deepcopy, quotekeys, bless);
  }
  SvREFCNT_dec(namesv);
  }
--- 318,333 ----
  sv_catpvn(retval, "do{\\(my $o = ", 13);
  DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
  postav, levelp, indent, pad, xpad, apad, sep,
! freezer, toaster, purity, deepcopy, quotekeys, bless,
! maxdepth);
  sv_catpvn(retval, ")}", 2);
  } /* plain */
  else {
  sv_catpvn(retval, "\\", 1);
  DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
  postav, levelp, indent, pad, xpad, apad, sep,
! freezer, toaster, purity, deepcopy, quotekeys, bless,
! maxdepth);
  }
  SvREFCNT_dec(namesv);
  }
***************
*** 312,318 ****
  sv_catpvn(retval, "\\", 1);
  DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
  postav, levelp, indent, pad, xpad, apad, sep,
! freezer, toaster, purity, deepcopy, quotekeys, bless);
  SvREFCNT_dec(namesv);
  }
  else if (realtype == SVt_PVAV) {
--- 338,345 ----
  sv_catpvn(retval, "\\", 1);
  DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
  postav, levelp, indent, pad, xpad, apad, sep,
! freezer, toaster, purity, deepcopy, quotekeys, bless,
! maxdepth);
  SvREFCNT_dec(namesv);
  }
  else if (realtype == SVt_PVAV) {
***************
*** 380,386 ****
  sv_catsv(retval, ipad);
  DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
  levelp, indent, pad, xpad, apad, sep,
! freezer, toaster, purity, deepcopy, quotekeys, bless);
  if (ix < ixmax)
  sv_catpvn(retval, ",", 1);
  }
--- 407,414 ----
  sv_catsv(retval, ipad);
  DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
  levelp, indent, pad, xpad, apad, sep,
! freezer, toaster, purity, deepcopy, quotekeys, bless,
! maxdepth);
  if (ix < ixmax)
  sv_catpvn(retval, ",", 1);
  }
***************
*** 486,492 ****
 
  DD_dump(aTHX_ hval, SvPVX(sname), SvCUR(sname), retval, seenhv,
  postav, levelp, indent, pad, xpad, newapad, sep,
! freezer, toaster, purity, deepcopy, quotekeys, bless);
  SvREFCNT_dec(sname);
  Safefree(nkey);
  if (indent >= 2)
--- 514,521 ----
 
  DD_dump(aTHX_ hval, SvPVX(sname), SvCUR(sname), retval, seenhv,
  postav, levelp, indent, pad, xpad, newapad, sep,
! freezer, toaster, purity, deepcopy, quotekeys, bless,
! maxdepth);
  SvREFCNT_dec(sname);
  Safefree(nkey);
  if (indent >= 2)
***************
*** 626,632 ****
  DD_dump(aTHX_ e, SvPVX(nname), SvCUR(nname), postentry,
  seenhv, postav, &nlevel, indent, pad, xpad,
  newapad, sep, freezer, toaster, purity,
! deepcopy, quotekeys, bless);
  SvREFCNT_dec(e);
  }
  }
--- 655,661 ----
  DD_dump(aTHX_ e, SvPVX(nname), SvCUR(nname), postentry,
  seenhv, postav, &nlevel, indent, pad, xpad,
  newapad, sep, freezer, toaster, purity,
! deepcopy, quotekeys, bless, maxdepth);
  SvREFCNT_dec(e);
  }
  }
***************
*** 686,692 ****
  SV **svp;
  SV *val, *name, *pad, *xpad, *apad, *sep, *tmp, *varname;
  SV *freezer, *toaster, *bless;
! I32 purity, deepcopy, quotekeys;
  char tmpbuf[1024];
  I32 gimme = GIMME;
 
--- 715,721 ----
  SV **svp;
  SV *val, *name, *pad, *xpad, *apad, *sep, *tmp, *varname;
  SV *freezer, *toaster, *bless;
! I32 purity, deepcopy, quotekeys, maxdepth;
  char tmpbuf[1024];
  I32 gimme = GIMME;
 
***************
*** 769,774 ****
--- 798,805 ----
  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)
***************
*** 834,840 ****
  DD_dump(aTHX_ val, SvPVX(name), SvCUR(name), valstr, seenhv,
  postav, &level, indent, pad, xpad, newapad, sep,
  freezer, toaster, purity, deepcopy, quotekeys,
! bless);
 
  if (indent >= 2)
  SvREFCNT_dec(newapad);
--- 865,871 ----
  DD_dump(aTHX_ val, SvPVX(name), SvCUR(name), valstr, seenhv,
  postav, &level, indent, pad, xpad, newapad, sep,
  freezer, toaster, purity, deepcopy, quotekeys,
! bless, maxdepth);
 
  if (indent >= 2)
  SvREFCNT_dec(newapad);
diff -rc perl5.005_60/ext/Data/Dumper/Todo perl5.005_60.new/ext/Data/Dumper/Todo
*** perl5.005_60/ext/Data/Dumper/Todo Wed Aug 4 18​:36​:09 1999
--- perl5.005_60.new/ext/Data/Dumper/Todo Wed Aug 4 18​:39​:30 1999
***************
*** 8,19 ****
 
  =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
--- 8,13 ----
diff -rc perl5.005_60/t/lib/dumper.t perl5.005_60.new/t/lib/dumper.t
*** perl5.005_60/t/lib/dumper.t Wed Aug 4 18​:36​:56 1999
--- perl5.005_60.new/t/lib/dumper.t Wed Aug 4 18​:39​:09 1999
***************
*** 35,45 ****
 
  if (defined &Data​::Dumper​::Dumpxs) {
  print "### XS extension loaded, will run XS tests\n";
! $TMAX = 162; $XS = 1;
  }
  else {
  print "### XS extensions not loaded, will NOT run XS tests\n";
! $TMAX = 81; $XS = 0;
  }
 
  print "1..$TMAX\n";
--- 35,45 ----
 
  if (defined &Data​::Dumper​::Dumpxs) {
  print "### XS extension loaded, will run XS tests\n";
! $TMAX = 174; $XS = 1;
  }
  else {
  print "### XS extensions not loaded, will NOT run XS tests\n";
! $TMAX = 87; $XS = 0;
  }
 
  print "1..$TMAX\n";
***************
*** 700,704 ****
--- 700,751 ----
 
  TEST q(Data​::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
  TEST q(Data​::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
+ if $XS;
+ }
+
+ {
+ $f = "pearl";
+ $e = [ $f ];
+ $d = { 'e' => $e };
+ $c = [ $d ];
+ $b = { 'c' => $c };
+ $a = { 'b' => $b };
+
+ ############# 163
+ ##
+ $WANT = <<'EOT';
+ #$a = {
+ # b => {
+ # c => [
+ # {
+ # e => ARRAY
+ # }
+ # ]
+ # }
+ #};
+ #$b = $a->{b};
+ #$c = $a->{b}{c};
+ EOT
+
+ TEST q(Data​::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;);
+ TEST q(Data​::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;)
+ if $XS;
+
+ ############# 169
+ ##
+ $WANT = <<'EOT';
+ #$a = {
+ # b => HASH
+ #};
+ #$b = {
+ # c => ARRAY
+ #};
+ #$c = [
+ # HASH
+ #];
+ EOT
+
+ TEST q(Data​::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;);
+ TEST q(Data​::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;)
  if $XS;
  }