diff options
author | Peter Scott <Peter@PSDT.com> | 2002-03-19 04:28:52 -0800 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2002-03-20 14:38:23 +0000 |
commit | a7b657eec5c9a956f5411ffb5c1dacbd8d5b6c1b (patch) | |
tree | 8729e67bf0c9067b14f2b739c40d129ab3fee1f5 /lib/dumpvar.pl | |
parent | 011f8d22855f3e69d20d9a6808fe8d9789c166af (diff) | |
download | perl-a7b657eec5c9a956f5411ffb5c1dacbd8d5b6c1b.tar.gz |
List lexicals from debugger
Message-id: <4.3.2.7.2.20020319101746.00aa7aa0@shell2.webquarry.com>
p4raw-id: //depot/perl@15363
Diffstat (limited to 'lib/dumpvar.pl')
-rw-r--r-- | lib/dumpvar.pl | 37 |
1 files changed, 37 insertions, 0 deletions
diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl index 2fb1f695ce..12c9e91f0a 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... |