X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fdumpvar.pl;h=12c9e91f0ad69d0a1c6c120847082fb8eed89df4;hb=13ef5feb3a8e2368992adc7df8455949512b60b3;hp=2fb1f695ce033f78d246bfa136acd5d99b048f6e;hpb=3a4b996c622ca8a2cd8d468317fb869865ee25b2;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index 2fb1f69..12c9e91 100644
--- a/lib/dumpvar.pl
+++ b/lib/dumpvar.pl
@@ -250,6 +250,13 @@ sub unwrap {
     }
 }
 
+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 
@@ -326,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...