X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fdumpvar.pl;h=12c9e91f0ad69d0a1c6c120847082fb8eed89df4;hb=4750257bd21f5a4355221e101326277c013826ec;hp=34a9c5971b7b4615abe35d061c6b92c775384b78;hpb=eb1102fcca2230364ceadea29bd8e87ee51b15fa;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index 34a9c59..12c9e91 100644
--- a/lib/dumpvar.pl
+++ b/lib/dumpvar.pl
@@ -30,7 +30,7 @@ sub main::dumpValue {
   local $^W=0;
   (print "undef\n"), return unless defined $_[0];
   (print &stringify($_[0]), "\n"), return unless ref $_[0];
-  dumpvar::unwrap($_[0],0);
+  dumpvar::unwrap($_[0],0, $_[1]);
 }
 
 # This one is good for variable names:
@@ -115,7 +115,7 @@ sub DumpElem {
 	    join("' '", @{$v}[0..$tArrayDepth]) . "'$shortmore";
   } else {
     print "$short\n";
-    unwrap($_[0],$_[1]);
+    unwrap($_[0],$_[1],$_[2]);
   }
 }
 
@@ -123,6 +123,8 @@ sub unwrap {
     return if $DB::signal;
     local($v) = shift ; 
     local($s) = shift ; # extra no of spaces
+    local($m) = shift ; # maximum recursion depth
+    return if $m == 0;
     local(%v,@v,$sp,$value,$key,@sortKeys,$more,$shortmore,$short) ;
     local($tHashDepth,$tArrayDepth) ;
 
@@ -187,7 +189,7 @@ sub unwrap {
 	    return if $DB::signal;
 	    $value = $ {$v}{$key} ;
 	    print "$sp", &stringify($key), " => ";
-	    DumpElem $value, $s;
+	    DumpElem $value, $s, $m-1;
 	}
 	print "$sp  empty hash\n" unless @sortKeys;
 	print "$sp$more" if defined $more ;
@@ -218,7 +220,7 @@ sub unwrap {
 	    return if $DB::signal;
 	    print "$sp$num  ";
 	    if (exists $v->[$num]) {
-	        DumpElem $v->[$num], $s;
+	        DumpElem $v->[$num], $s, $m-1;
 	    } else {
 	    	print "empty slot\n";
 	    }
@@ -227,7 +229,7 @@ sub unwrap {
 	print "$sp$more" if defined $more ;  
     } elsif (  UNIVERSAL::isa($v, 'SCALAR') or ref $v eq 'REF' ) { 
 	    print "$sp-> ";
-	    DumpElem $$v, $s;
+	    DumpElem $$v, $s, $m-1;
     } elsif ( UNIVERSAL::isa($v, 'CODE') ) { 
 	    print "$sp-> ";
 	    dumpsub (0, $v);
@@ -235,19 +237,26 @@ sub unwrap {
       print "$sp-> ",&stringify($$v,1),"\n";
       if ($globPrint) {
 	$s += 3;
-	dumpglob($s, "{$$v}", $$v, 1);
+       dumpglob($s, "{$$v}", $$v, 1, $m-1);
       } elsif (defined ($fileno = fileno($v))) {
 	print( (' ' x ($s+3)) .  "FileHandle({$$v}) => fileno($fileno)\n" );
       }
     } elsif (ref \$v eq 'GLOB') {
       if ($globPrint) {
-	dumpglob($s, "{$v}", $v, 1) if $globPrint;
+       dumpglob($s, "{$v}", $v, 1, $m-1) if $globPrint;
       } elsif (defined ($fileno = fileno(\$v))) {
 	print( (' ' x $s) .  "FileHandle({$v}) => fileno($fileno)\n" );
       }
     }
 }
 
+sub matchlex {
+  (my $var = $_[0]) =~ s/.//;
+  $var eq $_[1] or 
+    ($_[1] =~ /^([!~])(.)([\x00-\xff]*)/) and 
+      ($1 eq '!') ^ (eval { $var =~ /$2$3/ });
+}
+
 sub matchvar {
   $_[0] eq $_[1] or 
     ($_[1] =~ /^([!~])(.)([\x00-\xff]*)/) and 
@@ -294,16 +303,16 @@ sub quote {
 
 sub dumpglob {
     return if $DB::signal;
-    my ($off,$key, $val, $all) = @_;
+    my ($off,$key, $val, $all, $m) = @_;
     local(*entry) = $val;
     my $fileno;
     if (($key !~ /^_</ or $dumpDBFiles) and defined $entry) {
       print( (' ' x $off) . "\$", &unctrl($key), " = " );
-      DumpElem $entry, 3+$off;
+      DumpElem $entry, 3+$off, $m;
     }
     if (($key !~ /^_</ or $dumpDBFiles) and @entry) {
       print( (' ' x $off) . "\@$key = (\n" );
-      unwrap(\@entry,3+$off) ;
+      unwrap(\@entry,3+$off,$m) ;
       print( (' ' x $off) .  ")\n" );
     }
     if ($key ne "main::" && $key ne "DB::" && %entry
@@ -311,7 +320,7 @@ sub dumpglob {
 	&& ($key !~ /^_</ or $dumpDBFiles)
 	&& !($package eq "dumpvar" and $key eq "stab")) {
       print( (' ' x $off) . "\%$key = (\n" );
-      unwrap(\%entry,3+$off) ;
+      unwrap(\%entry,3+$off,$m) ;
       print( (' ' x $off) .  ")\n" );
     }
     if (defined ($fileno = fileno(*entry))) {
@@ -324,6 +333,36 @@ sub dumpglob {
     }
 }
 
+sub dumplex {
+  return if $DB::signal;
+  my ($key, $val, $m, @vars) = @_;
+  return if @vars && !grep( matchlex($key, $_), @vars );
+  local %address;
+  my $off = 0;  # It reads better this way
+  my $fileno;
+  if (UNIVERSAL::isa($val,'ARRAY')) {
+    print( (' ' x $off) . "$key = (\n" );
+    unwrap($val,3+$off,$m) ;
+    print( (' ' x $off) .  ")\n" );
+  }
+  elsif (UNIVERSAL::isa($val,'HASH')) {
+    print( (' ' x $off) . "$key = (\n" );
+    unwrap($val,3+$off,$m) ;
+    print( (' ' x $off) .  ")\n" );
+  }
+  elsif (UNIVERSAL::isa($val,'IO')) {
+    print( (' ' x $off) .  "FileHandle($key) => fileno($fileno)\n" );
+  }
+  #  No lexical subroutines yet...
+  #  elsif (UNIVERSAL::isa($val,'CODE')) {
+  #    dumpsub($off, $$val);
+  #  }
+  else {
+    print( (' ' x $off) . &unctrl($key), " = " );
+    DumpElem $$val, 3+$off, $m;
+  }
+}
+
 sub CvGV_name_or_bust {
   my $in = shift;
   return if $skipCvGV;		# Backdoor to avoid problems if XS broken...
@@ -359,7 +398,7 @@ sub findsubs {
 }
 
 sub main::dumpvar {
-    my ($package,@vars) = @_;
+    my ($package,$m,@vars) = @_;
     local(%address,$key,$val,$^W);
     $package .= "::" unless $package =~ /::$/;
     *stab = *{"main::"};
@@ -377,7 +416,7 @@ sub main::dumpvar {
 	  if ($package ne 'dumpvar' or $key ne 'stab')
 	     and ref(\$val) eq 'GLOB';
       } else {
-	dumpglob(0,$key, $val);
+       dumpglob(0,$key, $val, 0, $m);
       }
     }
     if ($usageOnly) {