From: Peter Scott <Peter@PSDT.com>
Date: Tue, 19 Mar 2002 12:28:52 +0000 (-0800)
Subject: List lexicals from debugger
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a7b657eec5c9a956f5411ffb5c1dacbd8d5b6c1b;p=p5sagit%2Fp5-mst-13.2.git

List lexicals from debugger
Message-id: <4.3.2.7.2.20020319101746.00aa7aa0@shell2.webquarry.com>

p4raw-id: //depot/perl@15363
---

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...
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 158510d..fd925b5 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2809,6 +2809,7 @@ I<Data Examination:>     B<expr>     Execute perl code, also see: B<s>,B<n>,B<t>
   B<S> [[B<!>]I<pat>]     List subroutine names [not] matching pattern
   B<V> [I<Pk> [I<Vars>]]  List Variables in Package.  Vars can be ~pattern or !pattern.
   B<X> [I<Vars>]       Same as \"B<V> I<current_package> [I<Vars>]\".
+  B<y> [I<n> [I<Vars>]]   List lexicals in higher scope <n>.  Vars same as B<V>.
 For more help, type B<h> I<cmd_letter>, or run B<$doccmd perldebug> for all docs.
 END_SUM
 				# ')}}; # Fix balance of vi % matching
@@ -2976,6 +2977,7 @@ I<Data Examination:>     B<expr>     Execute perl code, also see: B<s>,B<n>,B<t>
   B<S> [[B<!>]I<pat>]     List subroutine names [not] matching pattern
   B<V> [I<Pk> [I<Vars>]]  List Variables in Package.  Vars can be ~pattern or !pattern.
   B<X> [I<Vars>]       Same as \"B<V> I<current_package> [I<Vars>]\".
+  B<y> [I<n> [I<Vars>]]   List lexicals in higher scope <n>.  Vars same as B<V>.
 For more help, type B<h> I<cmd_letter>, or run B<$doccmd perldebug> for all docs.
 END_SUM
 				# ')}}; # Fix balance of vi % matching
diff --git a/pod/perldebug.pod b/pod/perldebug.pod
index 5d0ef3f..45c2420 100644
--- a/pod/perldebug.pod
+++ b/pod/perldebug.pod
@@ -114,6 +114,16 @@ This is similar to calling the C<x> command on each applicable var.
 
 Same as C<V currentpackage [vars]>.
 
+=item y [level [vars]]
+
+Display all (or some) lexical variables (mnemonic: C<mY> variables)
+in the current scope or I<level> scopes higher.  You can limit the
+variables that you see with I<vars> which works exactly as it does
+for the C<V> and C<X> commands.  Requires the C<PadWalker> module
+version 0.08 or higher; will warn if this isn't installed.  Output
+is pretty-printed in the same style as for C<V> and the format is
+controlled by the same options.
+
 =item T
 
 Produce a stack backtrace.  See below for details on its output.