Forked patch for 22426

I WANT THIS DAMN DEBUGGER MESS SORTED.
Blame is irrelevant. Only cause, solution and lessons to learn.
(plus don't think it had anything to do with Richard)

       Subject: [PATCH] debugger (5.8.x and 5.9.x)
       Message-Id: <200403031610.25080.richard.foley@rfi.net>

p4raw-id: //depot/maint-5.8/perl@22460

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index e60d692..513eda8 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -189,7 +189,7 @@ that will be executed (in the debugger's context) after the debugger has
 initialized itself.
 
 Next, it checks the C<PERLDB_OPTS> environment variable and treats its 
-contents as the argument of a debugger <C<O> command.
+contents as the argument of a debugger <C<o> command.
 
 =head2 STARTUP-ONLY OPTIONS
 
@@ -492,7 +492,7 @@ package DB;
 use IO::Handle;
 
 # Debugger for Perl 5.00x; perl5db.pl patch level:
-$VERSION = 1.23;
+$VERSION = 1.24;
 
 $header  = "perl5db.pl version $VERSION";
 
@@ -671,7 +671,7 @@ sub eval {
 # wise to read the perldebguts man page or risk the ire of dragons.
 #
 # (It should be noted that perldebguts will tell you a lot about
-# the uderlying mechanics of how the debugger interfaces into the
+# the underlying mechanics of how the debugger interfaces into the
 # Perl interpreter, but not a lot about the debugger itself. The new
 # comments in this code try to address this problem.)
 
@@ -902,7 +902,10 @@ sub eval {
 #   + Flush stdout/stderr before the debugger prompt is printed.
 # Changes: 1.23: Dec 21, 2003 Dominique Quatravaux
 #   + Fix a side-effect of bug #24674 in the perl debugger ("odd taint bug")
-
+# Changes: 1.24: Mar 03, 2004 Richard Foley <richard.foley@rfi.net>
+#   + Added command to save all debugger commands for sourcing later.
+#   + Added command to display parent inheritence tree of given class.
+#   + Fixed minor newline in history bug.
 ####################################################################
 
 =head1 DEBUGGER INITIALIZATION
@@ -2079,8 +2082,9 @@ it up.
 
             # Empty input means repeat the last command.
             $cmd =~ /^$/ && ($cmd = $laststep);
+                       chomp($cmd); # get rid of the annoying extra newline
             push (@hist, $cmd) if length($cmd) > 1;
-
+            push (@truehist, $cmd);
 
           # This is a restart point for commands that didn't arrive
           # via direct user input. It allows us to 'redo PIPE' to
@@ -2385,7 +2389,7 @@ deal with them instead of processing them in-line.
 
                 # All of these commands were remapped in perl 5.8.0;
                 # we send them off to the secondary dispatcher (see below). 
-                $cmd =~ /^([aAbBhlLMoOvwW]\b|[<>\{]{1,2})\s*(.*)/so && do {
+                $cmd =~ /^([aAbBhilLMoOvwW]\b|[<>\{]{1,2})\s*(.*)/so && do {
                     &cmd_wrapper($1, $2, $line);
                     next CMD;
                 };
@@ -3224,6 +3228,29 @@ pick it up.
                     next CMD;
                 };
 
+=head4 C<save> - send current history to a file
+
+Takes the complete history, (not the shrunken version you see with C<H>),
+and saves it to the given filename, so it can be replayed using C<source>.
+
+Note that all C<^(save|source)>'s are commented out with a view to minimise recursion.
+
+=cut
+
+                               # save source - write commands to a file for later use
+                $cmd =~ /^save\s*(.*)$/ && do {
+                                       my $file = $1 || '.perl5dbrc'; # default?
+                    if (open my $fh, "> $file") {
+                                               # chomp to remove extraneous newlines from source'd files 
+                                               chomp(my @truelist = map { m/^\s*(save|source)/ ? "#$_": $_ } @truehist);
+                                               print $fh join("\n", @truelist); 
+                                               print "commands saved in $file\n";
+                    } else {
+                        &warn("Can't save debugger commands in '$1': $!\n");
+                    }
+                    next CMD;
+                };
+
 =head4 C<|, ||> - pipe output through the pager.
 
 FOR C<|>, we save C<OUT> (the debugger's output filehandle) and C<STDOUT>
@@ -4535,6 +4562,30 @@ sub cmd_h {
     }
 } ## end sub cmd_h
 
+=head3 C<cmd_i> - inheritance display
+
+Display the (nested) parentage of the module or object given.
+
+=cut
+
+sub cmd_i {
+    my $cmd  = shift;
+    my $line = shift;
+       eval { require Class::ISA };
+       if ($@) { 
+               &warn($@ =~ /locate/ ? "Class::ISA module not found - please install\n" : $@);
+       } else {
+               ISA:
+               foreach my $isa (split(/\s+/, $line)) {
+                 no strict 'refs'; 
+                 print join(', ', map { # snaffled unceremoniously from Class::ISA
+                               "$_".(defined(${"$_\::VERSION"}) ? ' '.${"$_\::VERSION"} : undef)
+                         } Class::ISA::self_and_super_path($isa));
+                 print "\n";
+               }
+       }
+} ## end sub cmd_i
+
 =head3 C<cmd_l> - list lines (command)
 
 Most of the command is taken up with transforming all the different line
@@ -6769,6 +6820,7 @@ B<m> I<expr>              Evals expression in list context, prints methods callable
                on the first element of the result.
 B<m> I<class>          Prints methods callable via the given class.
 B<M>           Show versions of loaded modules.
+B<i> I<class>       Prints nested parents of given class.
 B<y> [I<n> [I<Vars>]]   List lexicals in higher scope <n>.  Vars same as B<V>.
 
 B<<> ?                 List Perl commands to run before each prompt.
@@ -6797,6 +6849,7 @@ B<$psh> [I<cmd>]  Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")."
       . "
                See 'B<O> I<shellBang>' too.
 B<source> I<file>              Execute I<file> containing debugger commands (may nest).
+B<save> I<file>       Save current debugger session (actual history) to I<file>.
 B<H> I<-number>        Display last number commands (default all).
 B<p> I<expr>           Same as \"I<print {DB::OUT} expr>\" in current package.
 B<|>I<dbcmd>           Run debugger command, piping DB::OUT to current pager.
@@ -6879,7 +6932,7 @@ I<Data Examination:>     B<expr>     Execute perl code, also see: B<s>,B<n>,B<t>
   B<p> I<expr>         Print expression (uses script's current package).
   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<X> [I<Vars>]       Same as \"B<V> I<current_package> [I<Vars>]\".  B<i> I<class> inheritance tree.
   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
@@ -7680,6 +7733,7 @@ BEGIN {    # This does not compile, alas. (XXX eh?)
     $sh      = '!';         # Shell escape (does not work)
     $rc      = ',';         # Recall command (does not work)
     @hist    = ('?');       # Show history (does not work)
+       @truehist=();           # Can be saved for replay (per session)
 
     # This defines the point at which you get the 'deep recursion' 
     # warning. It MUST be defined or the debugger will not load.