X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fperl5db.pl;h=d2bd98e654f39317a572b23fb63a1ed36256f51b;hb=8560c20dd6b2f3dfec719d4b500be45742de4507;hp=1e5724fb223b928a3111074b2c11bfc4014711d1;hpb=f8b5b99cdebd8b6c68cad87fddf11ad38bd6bcf9;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 1e5724f..d2bd98e 100644
--- 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.0402;
+$VERSION = 1.04041;
 $header = "perl5db.pl version $VERSION";
 
 # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
@@ -76,6 +76,8 @@ $header = "perl5db.pl version $VERSION";
 # LineInfo - file or pipe to print line number info to.  If it is a
 # pipe, a short "emacs like" message is used.
 #
+# RemotePort - host:port to connect to on remote host for remote debugging.
+#
 # Example $rcfile: (delete leading hashes!)
 #
 # &parse_options("NonStop=1 LineInfo=db.out");
@@ -179,7 +181,8 @@ $inhibit_exit = $option{PrintRet} = 1;
 		  TTY noTTY ReadLine NonStop LineInfo maxTraceLen
 		  recallCommand ShellBang pager tkRunning ornaments
 		  signalLevel warnLevel dieLevel inhibit_exit
-		  ImmediateStop bareStringify);
+		  ImmediateStop bareStringify
+		  RemotePort);
 
 %optionVars    = (
 		 hashDepth	=> \$dumpvar::hashDepth,
@@ -197,6 +200,7 @@ $inhibit_exit = $option{PrintRet} = 1;
 		 inhibit_exit   => \$inhibit_exit,
 		 maxTraceLen	=> \$maxtrace,
 		 ImmediateStop	=> \$ImmediateStop,
+		 RemotePort	=> \$remoteport,
 );
 
 %optionAction  = (
@@ -216,6 +220,7 @@ $inhibit_exit = $option{PrintRet} = 1;
 		  dieLevel	=> \&dieLevel,
 		  tkRunning	=> \&tkRunning,
 		  ornaments	=> \&ornaments,
+		  RemotePort	=> \&RemotePort,
 		 );
 
 %optionRequire = (
@@ -235,7 +240,11 @@ $pretype = [] unless defined $pretype;
 warnLevel($warnLevel);
 dieLevel($dieLevel);
 signalLevel($signalLevel);
-&pager(defined($ENV{PAGER}) ? $ENV{PAGER} : "|more") unless defined $pager;
+&pager((defined($ENV{PAGER}) 
+	? $ENV{PAGER}
+	: ($^O eq 'os2' 
+	   ? 'cmd /c more' 
+	   : 'more'))) unless defined $pager;
 &recallCommand("!") unless defined $prc;
 &shellBang("!") unless defined $psh;
 $maxtrace = 400 unless defined $maxtrace;
@@ -292,7 +301,10 @@ if ($notty) {
 
   #require Term::ReadLine;
 
-  if (-e "/dev/tty") {
+  if ($^O eq 'cygwin') {
+    # /dev/tty is binary. use stdin for textmode
+    undef $console;
+  } elsif (-e "/dev/tty") {
     $console = "/dev/tty";
   } elsif ($^O eq 'dos' or -e "con" or $^O eq 'MSWin32') {
     $console = "con";
@@ -309,21 +321,36 @@ if ($notty) {
     $console = undef;
   }
 
+  if ($^O eq 'epoc') {
+    $console = undef;
+  }
+
   $console = $tty if defined $tty;
 
-  if (defined $console) {
-    open(IN,"+<$console") || open(IN,"<$console") || open(IN,"<&STDIN");
-    open(OUT,"+>$console") || open(OUT,">$console") || open(OUT,">&STDERR")
-      || open(OUT,">&STDOUT");	# so we don't dongle stdout
-  } else {
-    open(IN,"<&STDIN");
-    open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout
-    $console = 'STDIN/OUT';
+  if (defined $remoteport) {
+    require IO::Socket;
+    $OUT = new IO::Socket::INET( Timeout  => '10',
+                                 PeerAddr => $remoteport,
+                                 Proto    => 'tcp',
+                               );
+    if (!$OUT) { die "Could not create socket to connect to remote host."; }
+    $IN = $OUT;
   }
-  # so open("|more") can read from STDOUT and so we don't dingle stdin
-  $IN = \*IN;
+  else {
+    if (defined $console) {
+      open(IN,"+<$console") || open(IN,"<$console") || open(IN,"<&STDIN");
+      open(OUT,"+>$console") || open(OUT,">$console") || open(OUT,">&STDERR")
+        || open(OUT,">&STDOUT");	# so we don't dongle stdout
+    } else {
+      open(IN,"<&STDIN");
+      open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout
+      $console = 'STDIN/OUT';
+    }
+    # so open("|more") can read from STDOUT and so we don't dingle stdin
+    $IN = \*IN;
 
-  $OUT = \*OUT;
+    $OUT = \*OUT;
+  }
   select($OUT);
   $| = 1;			# for DB::OUT
   select(STDOUT);
@@ -339,7 +366,7 @@ if ($notty) {
     print $OUT ("Emacs support ",
 		$emacs ? "enabled" : "available",
 		".\n");
-    print $OUT "\nEnter h or `h h' for help.\n\n";
+    print $OUT "\nEnter h or `h h' for help, run `perldoc perldebug' for more help.\n\n";
   }
 }
 
@@ -412,18 +439,18 @@ EOP
     $was_signal = $signal;
     $signal = 0;
     if ($single || ($trace & 1) || $was_signal) {
-	$term || &setterm;
 	if ($emacs) {
 	    $position = "\032\032$filename:$line:0\n";
 	    print $LINEINFO $position;
 	} elsif ($package eq 'DB::fake') {
+	  $term || &setterm;
 	  print_help(<<EOP);
 Debugged program terminated.  Use B<q> to quit or B<R> to restart,
   use B<O> I<inhibit_exit> to avoid stopping after program termination,
   B<h q>, B<h R> or B<h O> to get additional info.  
 EOP
 	  $package = 'main';
-	  $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
+	  $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
 	    "package $package;";	# this won't let them modify, alas
 	} else {
 	    $sub =~ s/\'/::/;
@@ -467,7 +494,7 @@ EOP
 	  if $single & 4;
 	$start = $line;
 	$incr = -1;		# for backward motion.
-	@typeahead = @$pretype, @typeahead;
+	@typeahead = (@$pretype, @typeahead);
       CMD:
 	while (($term || &setterm),
 	       ($term_pid == $$ or &resetterm),
@@ -640,8 +667,9 @@ EOP
 				$arrow .= 'b' if $stop;
 				$arrow .= 'a' if $action;
 				print $OUT "$i$arrow\t", $dbline[$i];
-				last if $signal;
+				$i++, last if $signal;
 			    }
+			    print $OUT "\n" unless $dbline[$i-1] =~ /\n$/;
 			}
 			$start = $i; # remember in case they want more
 			$start = $max if $start > $max;
@@ -677,7 +705,7 @@ EOP
 			
 			for ($i = 1; $i <= $max; $i++) {
 			    if (defined $dbline{$i}) {
-			        print "$file:\n" unless $was++;
+			        print $OUT "$file:\n" unless $was++;
 				print $OUT " $i:\t", $dbline[$i];
 				($stop,$action) = split(/\0/, $dbline{$i});
 				print $OUT "   break if (", $stop, ")\n"
@@ -1046,7 +1074,7 @@ EOP
 			pop(@hist) if length($cmd) > 1;
 			$i = $1 ? ($#hist-($2?$2:1)) : ($2?$2:$#hist);
 			$cmd = $hist[$i];
-			print $OUT $cmd;
+			print $OUT $cmd, "\n";
 			redo CMD; };
 		    $cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do {
 			&system($1);
@@ -1062,7 +1090,7 @@ EOP
 			    next CMD;
 			}
 			$cmd = $hist[$i];
-			print $OUT $cmd;
+			print $OUT $cmd, "\n";
 			redo CMD; };
 		    $cmd =~ /^$sh$/ && do {
 			&system($ENV{SHELL}||"/bin/sh");
@@ -1513,7 +1541,15 @@ sub readline {
   }
   local $frame = 0;
   local $doret = -2;
-  $term->readline(@_);
+  if (ref $OUT and UNIVERSAL::isa($OUT, 'IO::Socket::INET')) {
+    print $OUT @_;
+    my $stuff;
+    $IN->recv( $stuff, 2048 );
+    $stuff;
+  }
+  else {
+    $term->readline(@_);
+  }
 }
 
 sub dump_option {
@@ -1661,6 +1697,14 @@ sub ReadLine {
     $rl;
 }
 
+sub RemotePort {
+    if ($term) {
+        &warn("Too late to set RemotePort, enabled on next 'R'!\n") if @_;
+    }
+    $remoteport = shift if @_;
+    $remoteport;
+}
+
 sub tkRunning {
     if ($ {$term->Features}{tkRunning}) {
         return $term->tkRunning(@_);
@@ -1747,13 +1791,7 @@ sub list_versions {
     } 
     $version{$file} .= $INC{$file};
   }
-  do 'dumpvar.pl' unless defined &main::dumpValue;
-  if (defined &main::dumpValue) {
-    local $frame = 0;
-    &main::dumpValue(\%version);
-  } else {
-    print $OUT "dumpvar.pl not available.\n";
-  }
+  dumpit($OUT,\%version);
 }
 
 sub sethelp {
@@ -1817,6 +1855,7 @@ B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]...
     I<signalLevel> I<warnLevel> I<dieLevel>:	level of verbosity;
     I<inhibit_exit>		Allows stepping off the end of the script.
     I<ImmediateStop>		Debugger should stop as early as possible.
+    I<RemotePort>:		Remote hostname:port for remote debugging
   The following options affect what happens with B<V>, B<X>, and B<x> commands:
     I<arrayDepth>, I<hashDepth>:	print only first N elements ('' for all);
     I<compactDump>, I<veryCompact>:	change style of array and hash dump;
@@ -1833,7 +1872,8 @@ B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]...
 	 I<ornaments> affects screen appearance of the command line.
 		During startup options are initialized from \$ENV{PERLDB_OPTS}.
 		You can put additional initialization options I<TTY>, I<noTTY>,
-		I<ReadLine>, and I<NonStop> there (or use `B<R>' after you set them).
+		I<ReadLine>, I<NonStop>, and I<RemotePort> there (or use
+		`B<R>' after you set them).
 B<<> I<expr>		Define Perl command to run before each prompt.
 B<<<> I<expr>		Add to the list of Perl commands to run before each prompt.
 B<>> I<expr>		Define Perl command to run after each prompt.
@@ -1861,6 +1901,8 @@ B<R>		Pure-man-restart of debugger, some of debugger state
 		history, breakpoints and actions, debugger B<O>ptions 
 		and the following command-line options: I<-w>, I<-I>, I<-e>.
 B<h> [I<db_command>]	Get help [on a specific debugger command], enter B<|h> to page.
+		Complete description of debugger is available in B<perldebug>
+		section of Perl documention
 B<h h>		Summary of debugger commands.
 B<q> or B<^D>		Quit. Set B<\$DB::finished = 0> to debug global destruction.
 
@@ -1870,18 +1912,17 @@ I<List/search source lines:>               I<Control script execution:>
   B<l> [I<ln>|I<sub>]  List source code            B<T>           Stack trace
   B<-> or B<.>      List previous/current line  B<s> [I<expr>]    Single step [in expr]
   B<w> [I<line>]    List around line            B<n> [I<expr>]    Next, steps over subs
-  B<f> I<filename>  View source in file         <B<CR>>        Repeat last B<n> or B<s>
+  B<f> I<filename>  View source in file         <B<CR>/B<Enter>>  Repeat last B<n> or B<s>
   B</>I<pattern>B</> B<?>I<patt>B<?>   Search forw/backw    B<r>           Return from subroutine
   B<v>	      Show versions of modules    B<c> [I<ln>|I<sub>]  Continue until position
 I<Debugger controls:>                        B<L>           List break/watch/actions
   B<O> [...]     Set debugger options        B<t> [I<expr>]    Toggle trace [trace expr]
-  B<<>[B<<>] or B<{>[B<{>] [I<cmd>]   Do before prompt   B<b> [I<ln>|I<event>] [I<cnd>]  Set breakpoint
-  B<>>[B<>>] [I<cmd>]  Do after prompt             B<b> I<sub> [I<cnd>] Set breakpoint for sub
+  B<<>[B<<>]|B<{>[B<{>]|B<>>[B<>>] [I<cmd>] Do pre/post-prompt B<b> [I<ln>|I<event>|I<sub>] [I<cnd>] Set breakpoint
   B<$prc> [I<N>|I<pat>]   Redo a previous command     B<d> [I<ln>] or B<D> Delete a/all breakpoints
   B<H> [I<-num>]    Display last num commands   B<a> [I<ln>] I<cmd>  Do cmd before line
   B<=> [I<a> I<val>]   Define/list an alias        B<W> I<expr>      Add a watch expression
   B<h> [I<db_cmd>]  Get help on command         B<A> or B<W>      Delete all actions/watch
-  B<|>[B<|>]I<dbcmd>   Send output to pager        B<$psh>\[B<$psh>\] I<syscmd> Run cmd in a subprocess
+  B<|>[B<|>]I<db_cmd>  Send output to pager        B<$psh>\[B<$psh>\] I<syscmd> Run cmd in a subprocess
   B<q> or B<^D>     Quit			  B<R>	      Attempt a restart
 I<Data Examination:>	      B<expr>     Execute perl code, also see: B<s>,B<n>,B<t> I<expr>
   B<x>|B<m> I<expr>	Evals expr in array context, dumps the result or lists methods.
@@ -1889,6 +1930,7 @@ I<Data Examination:>	      B<expr>     Execute perl code, also see: B<s>,B<n>,B<
   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>]\".
+I<More help for> B<db_cmd>I<:>  Type B<h> I<cmd_letter>  Run B<perldoc perldebug> for more help.
 END_SUM
 				# ')}}; # Fix balance of Emacs parsing
 }