more m//s and $ vs \z fixups (from Greg Bacon)

[p5sagit/p5-mst-13.2.git] / lib / perl5db.pl

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index aff5c68..de75bd7 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2,7 +2,7 @@ package DB;
 
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 
-$VERSION = 1.04041;
+$VERSION = 1.05;
 $header = "perl5db.pl version $VERSION";
 
 # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
@@ -597,13 +597,21 @@ EOP
                          }
                      };
                    $cmd =~ s/^l\s+-\s*$/-/;
-                   $cmd =~ /^l\b\s*([\':A-Za-z_][\':\w]*)/ && do {
+                   $cmd =~ /^([lb])\b\s*(\$.*)/s && do {
+                       $evalarg = $2;
+                       my ($s) = &eval;
+                       print($OUT "Error: $@\n"), next CMD if $@;
+                       $s = CvGV_name($s);
+                       print($OUT "Interpreted as: $1 $s\n");
+                       $cmd = "$1 $s";
+                   };
+                   $cmd =~ /^l\b\s*([\':A-Za-z_][\':\w]*(\[.*\])?)/s && do {
                        $subname = $1;
                        $subname =~ s/\'/::/;
                        $subname = $package."::".$subname 
                          unless $subname =~ /::/;
                        $subname = "main".$subname if substr($subname,0,2) eq "::";
-                       @pieces = split(/:/,find_sub($subname));
+                       @pieces = split(/:/,find_sub($subname) || $sub{$subname});
                        $subrange = pop @pieces;
                        $file = join(':', @pieces);
                        if ($file ne $filename) {
@@ -784,7 +792,7 @@ EOP
                        $postponed{$subname} = $break 
                          ? "break +0 if $cond" : "compile";
                        next CMD; };
-                   $cmd =~ /^b\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do {
+                   $cmd =~ /^b\b\s*([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/ && do {
                        $subname = $1;
                        $cond = $2 || '1';
                        $subname =~ s/\'/::/;
@@ -1813,6 +1821,7 @@ B<l> I<min>B<+>I<incr>    List I<incr>+1 lines starting at I<min>.
 B<l> I<min>B<->I<max>  List lines I<min> through I<max>.
 B<l> I<line>           List single I<line>.
 B<l> I<subname>        List first window of lines from subroutine.
+B<l> I<$var>   List first window of lines from subroutine referenced by I<$var>.
 B<l>           List next window of lines.
 B<->           List previous window of lines.
 B<w> [I<line>] List window around I<line>.
@@ -1835,6 +1844,7 @@ B<b> [I<line>] [I<condition>]
                I<condition> breaks if it evaluates to true, defaults to '1'.
 B<b> I<subname> [I<condition>]
                Set breakpoint at first line of subroutine.
+B<b> I<$var>   Set breakpoint at first line of subroutine referenced by I<$var>.
 B<b> B<load> I<filename> Set breakpoint on `require'ing the given file.
 B<b> B<postpone> I<subname> [I<condition>]
                Set breakpoint at first line of subroutine after 
@@ -2063,10 +2073,31 @@ sub signalLevel {
   $signalLevel;
 }
 
+sub CvGV_name {
+  my $in = shift;
+  my $name = CvGV_name_or_bust($in);
+  defined $name ? $name : $in;
+}
+
+sub CvGV_name_or_bust {
+  my $in = shift;
+  return if $skipCvGV;         # Backdoor to avoid problems if XS broken...
+  $in = \&$in;                 # Hard reference...
+  eval {require Devel::Peek; 1} or return;
+  my $gv = Devel::Peek::CvGV($in) or return;
+  *$gv{PACKAGE} . '::' . *$gv{NAME};
+}
+
 sub find_sub {
   my $subr = shift;
-  return unless defined &$subr;
   $sub{$subr} or do {
+    return unless defined &$subr;
+    my $name = CvGV_name_or_bust($subr);
+    my $data;
+    $data = $sub{$name} if defined $name;
+    return $data if defined $data;
+
+    # Old stupid way...
     $subr = \&$subr;           # Hard reference
     my $s;
     for (keys %sub) {