X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fperl5db.pl;h=ab9c48da60f3195665bf6e3d1657478b55b43f55;hb=afc46004557cada88060a20d235b3f5e6303a4ac;hp=ef1f89b56847ee8f5dba71260bb744d35f800650;hpb=2526eab871b5e504cc8645d558fcc31f5c6fe1d8;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index ef1f89b..ab9c48d 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.12;
+$VERSION = 1.13;
 $header = "perl5db.pl version $VERSION";
 
 #
@@ -252,7 +252,8 @@ $header = "perl5db.pl version $VERSION";
 # Changes: 1.12: May 24, 2001  Daniel Lewart <d-lewart@uiuc.edu>
 #   + Fixed warnings generated by "O" (Show debugger options)
 #   + Fixed warnings generated by "p 42" (Print expression)
-
+# Changes: 1.13: Jun 19, 2001 Scott.L.Miller@compaq.com
+#   + Added windowSize option 
 ####################################################################
 
 # Needed for the statement after exec():
@@ -290,7 +291,7 @@ $inhibit_exit = $option{PrintRet} = 1;
 		  recallCommand ShellBang pager tkRunning ornaments
 		  signalLevel warnLevel dieLevel inhibit_exit
 		  ImmediateStop bareStringify CreateTTY
-		  RemotePort);
+		  RemotePort windowSize);
 
 %optionVars    = (
 		 hashDepth	=> \$dumpvar::hashDepth,
@@ -310,6 +311,7 @@ $inhibit_exit = $option{PrintRet} = 1;
 		 maxTraceLen	=> \$maxtrace,
 		 ImmediateStop	=> \$ImmediateStop,
 		 RemotePort	=> \$remoteport,
+		 windowSize	=> \$window,
 );
 
 %optionAction  = (
@@ -340,8 +342,8 @@ $inhibit_exit = $option{PrintRet} = 1;
 
 # These guys may be defined in $ENV{PERL5DB} :
 $rl		= 1	unless defined $rl;
-$warnLevel	= 0	unless defined $warnLevel;
-$dieLevel	= 0	unless defined $dieLevel;
+$warnLevel	= 1	unless defined $warnLevel;
+$dieLevel	= 1	unless defined $dieLevel;
 $signalLevel	= 1	unless defined $signalLevel;
 $pre		= []	unless defined $pre;
 $post		= []	unless defined $post;
@@ -502,6 +504,10 @@ if ($notty) {
     $console = undef;
   }
 
+  if ($^O eq 'NetWare') {
+	$console = undef;
+  }
+
   # Around a bug:
   if (defined $ENV{OS2_SHELL} and ($slave_editor or $ENV{WINDOWID})) { # In OS/2
     $console = undef;
@@ -540,15 +546,13 @@ if ($notty) {
 
     $OUT = \*OUT;
   }
-  select($OUT);
+  my $previous = select($OUT);
   $| = 1;			# for DB::OUT
-  select(STDOUT);
+  select($previous);
 
   $LINEINFO = $OUT unless defined $LINEINFO;
   $lineinfo = $console unless defined $lineinfo;
 
-  $| = 1;			# for real STDOUT
-
   $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
   unless ($runnonstop) {
     if ($term_pid eq '-1') {
@@ -885,6 +889,7 @@ EOP
 			    $i = $end;
 			} else {
 			    for (; $i <= $end; $i++) {
+				my ($stop,$action);
 				($stop,$action) = split(/\0/, $dbline{$i}) if
 				    $dbline{$i};
 			        $arrow = ($i==$line 
@@ -1221,7 +1226,7 @@ EOP
 			  *dbline = $main::{'_<' . $file};
 			  next unless %dbline or $postponed_file{$file};
 			  (push @hard, $file), next 
-			    if $file =~ /^\(eval \d+\)$/;
+			    if $file =~ /^\(\w*eval/;
 			  my @add;
 			  @add = %{$postponed_file{$file}}
 			    if $postponed_file{$file};
@@ -2144,7 +2149,7 @@ sub parse_options {
     # too dangerous to let intuitive usage overwrite important things
     # defaultion should never be the default
     my %opt_needs_val = map { ( $_ => 1 ) } qw{
-        arrayDepth hashDepth LineInfo maxTraceLen ornaments
+        arrayDepth hashDepth LineInfo maxTraceLen ornaments windowSize
         pager quote ReadLine recallCommand RemotePort ShellBang TTY
     };
     while (length) {
@@ -2677,7 +2682,8 @@ sub dbdie {
   if ($dieLevel < 2) {
     die @_ if $^S;		# in eval propagate
   }
-  eval { require Carp } if defined $^S;	# If error/warning during compilation,
+  # No need to check $^S, eval is much more robust nowadays
+  eval { require Carp }; #if defined $^S;# If error/warning during compilation,
                                 	# require may be broken.
 
   die(@_, "\nCannot print stack trace, load with -MCarp option to see stack")
@@ -2687,7 +2693,13 @@ sub dbdie {
   # inside DB::DB, but not in Carp).
   my ($mysingle,$mytrace) = ($single,$trace);
   $single = 0; $trace = 0;
-  my $mess = Carp::longmess(@_);
+  my $mess = "@_";
+  { 
+    package Carp;		# Do not include us in the list
+    eval {
+      $mess = Carp::longmess(@_);
+    };
+  }
   ($single,$trace) = ($mysingle,$mytrace);
   die $mess;
 }
@@ -2803,7 +2815,7 @@ sub methods_via {
 }
 
 sub setman { 
-    $doccmd = $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|riscos|MacOS)\z/s
+    $doccmd = $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|riscos|MacOS|NetWare)\z/s
 		? "man"             # O Happy Day!
 		: "perldoc";        # Alas, poor unfortunates
 }