modified suggested patch to handle cross-refs and qr// objects

correctly; unfollowed refs are represented as simple string
value, not just the bare type; $VERSION stays the same until
it is ready for prime time (avoids CPAN confustication)
	Message-Id: <199908050021.UAA09693@monet.op.net>
	Subject: [ID 19990804.006] [PATCH]5.005_60 (Data::Dumper) - implements Maxdepth setting

p4raw-id: //depot/perl@4078

4 files changed, 124 insertions, 54 deletions

diff --git a/ext/Data/Dumper/Changes b/ext/Data/Dumper/Changes
index 9a96edab8d..161aba940b 100644
--- a/ext/Data/Dumper/Changes
+++ b/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/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm
index 3828d7b390..4705669e6d 100644
--- a/ext/Data/Dumper/Dumper.pm
+++ b/ext/Data/Dumper/Dumper.pm
@@ -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) {
@@ -221,7 +221,7 @@ sub _dump {
 
     ($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)) {
@@ -259,17 +259,28 @@ sub _dump {
       }
     }
 
-    if ($realpack) {
-      if ($realpack eq 'Regexp') {
+    if ($realpack and $realpack eq 'Regexp') {
 	$out = "$val";
 	$out =~ s,/,\\/,g;
 	return "qr/$out/";
-      }
-      else {          # we have a blessed ref
-	$out = $s->{'bless'} . '( ';
-	$blesspad = $s->{apad};
-	$s->{apad} .= '       ' if ($s->{indent} >= 2);
-      }
+    }
+
+    # 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'];
+    }
+
+    # we have a blessed ref
+    if ($realpack) {
+      $out = $s->{'bless'} . '( ';
+      $blesspad = $s->{apad};
+      $s->{apad} .= '       ' if ($s->{indent} >= 2);
     }
 
     $s->{level}++;
@@ -519,6 +530,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",
@@ -822,6 +839,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
@@ -904,6 +929,21 @@ distribution for more examples.)
     $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,7 +1039,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/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index 3cbc7c5412..054e0a970d 100644
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -27,7 +27,8 @@ 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 purity, I32 deepcopy, I32 quotekeys, SV *bless,
+		    I32 maxdepth);
 
 /* does a string need to be protected? */
 static I32
@@ -130,7 +131,7 @@ 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 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth)
 {
     char tmpbuf[128];
     U32 i;
@@ -253,33 +254,46 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 	    }
 	}
 
-	if (realpack) {
-	    if (*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 (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, '/');
 	    }
-	    else {				/* we have a blessed ref */
-		STRLEN blesslen;
-		char *blessstr = SvPV(bless, blesslen);
-		sv_catpvn(retval, blessstr, blesslen);
-		sv_catpvn(retval, "( ", 2);
-		if (indent >= 2) {
-		    blesspad = apad;
-		    apad = newSVsv(apad);
-		    sv_x(aTHX_ apad, " ", 1, blesslen+2);
-		}
+	    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);
+	    sv_catpvn(retval, "( ", 2);
+	    if (indent >= 2) {
+		blesspad = apad;
+		apad = newSVsv(apad);
+		sv_x(aTHX_ apad, " ", 1, blesslen+2);
 	    }
 	}
 
@@ -294,14 +308,16 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		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);
+			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);
+			freezer, toaster, purity, deepcopy, quotekeys, bless,
+			maxdepth);
 	    }
 	    SvREFCNT_dec(namesv);
 	}
@@ -312,7 +328,8 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 	    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);
+		    freezer, toaster, purity, deepcopy, quotekeys, bless,
+		    maxdepth);
 	    SvREFCNT_dec(namesv);
 	}
 	else if (realtype == SVt_PVAV) {
@@ -380,7 +397,8 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		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);
+			freezer, toaster, purity, deepcopy, quotekeys, bless,
+			maxdepth);
 		if (ix < ixmax)
 		    sv_catpvn(retval, ",", 1);
 	    }
@@ -486,7 +504,8 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *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)
@@ -626,7 +645,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 			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);
 		    }
 		}
@@ -686,7 +705,7 @@ 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;
 	    char tmpbuf[1024];
 	    I32 gimme = GIMME;
 
@@ -769,6 +788,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)
@@ -834,7 +855,7 @@ Data_Dumper_Dumpxs(href, ...)
 		    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/ext/Data/Dumper/Todo b/ext/Data/Dumper/Todo
index 7dcd40b8e3..bd76e65b03 100644
--- a/ext/Data/Dumper/Todo
+++ b/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