Upgrade to Text::ParseWords 3.27

[perl5.git] / lib / perl5db.pl

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index db0943c..d5d3c08 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -1363,7 +1363,9 @@ running interactively, this is C<.perldb>; if not, it's C<perldb.ini>.
 # As noted, this test really doesn't check accurately that the debugger
 # is running at a terminal or not.
 
-if ( -e "/dev/tty" ) {                      # this is the wrong metric!
+my $dev_tty = '/dev/tty';
+   $dev_tty = 'TT:' if ($^O eq 'VMS');
+if ( -e $dev_tty ) {                      # this is the wrong metric!
     $rcfile = ".perldb";
 }
 else {
@@ -3637,10 +3639,10 @@ sub sub {
                print "creating new thread\n"; 
        }
 
-    # If the last ten characters are C'::AUTOLOAD', note we've traced
+    # If the last ten characters are '::AUTOLOAD', note we've traced
     # into AUTOLOAD for $sub.
     if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
-        $al = " for $$sub";
+        $al = " for $$sub" if defined $$sub;
     }
 
     # We stack the stack pointer and then increment it to protect us
@@ -6100,6 +6102,16 @@ qq[3>&1 xterm -title "Daughter Perl debugger $pids $name" -e sh -c 'tty 1>&3;\
 
     $pidprompt = '';    # Shown anyway in titlebar
 
+    # We need $term defined or we can not switch to the newly created xterm
+    if ($tty ne '' && !defined $term) {
+        eval { require Term::ReadLine } or die $@;
+        if ( !$rl ) {
+            $term = new Term::ReadLine::Stub 'perldb', $IN, $OUT;
+        }
+        else {
+            $term = new Term::ReadLine 'perldb', $IN, $OUT;
+        }
+    }
     # There's our new TTY.
     return $tty;
 } ## end sub xterm_get_fork_TTY
@@ -6140,21 +6152,38 @@ a new window.
 # it creates, but since it appears frontmost and windows are enumerated
 # front to back, we can use "first window" === "window 1".
 #
-# There's no direct accessor for the tty device name, so we fiddle
-# with the window title options until it says what we want.
-#
 # Since "do script" is implemented by supplying the argument (plus a
 # return character) as terminal input, there's a potential race condition
 # where the debugger could beat the shell to reading the command.
 # To prevent this, we wait for the screen to clear before proceeding.
 #
-# Tested and found to be functional in Mac OS X 10.3.9 and 10.4.8.
+# 10.3 and 10.4:
+# There's no direct accessor for the tty device name, so we fiddle
+# with the window title options until it says what we want.
+#
+# 10.5:
+# There _is_ a direct accessor for the tty device name, _and_ there's
+# a new possible component of the window title (the name of the settings
+# set).  A separate version is needed.
 
-sub macosx_get_fork_TTY
-{
-    my($pipe,$tty);
+my @script_versions=
 
-    return unless open($pipe,'-|','/usr/bin/osascript','-e',<<'__SCRIPT__');
+    ([237, <<'__LEOPARD__'],
+tell application "Terminal"
+    do script "clear;exec sleep 100000"
+    tell first tab of first window
+        copy tty to thetty
+        set custom title to "forked perl debugger"
+        set title displays custom title to true
+        repeat while (length of first paragraph of (get contents)) > 0
+            delay 0.1
+        end repeat
+    end tell
+end tell
+thetty
+__LEOPARD__
+
+     [100, <<'__JAGUAR_TIGER__'],
 tell application "Terminal"
     do script "clear;exec sleep 100000"
     tell first window
@@ -6164,16 +6193,31 @@ tell application "Terminal"
         set title displays device name to true
         set title displays custom title to true
         set custom title to ""
-        copy name to thetitle
+        copy "/dev/" & name to thetty
         set custom title to "forked perl debugger"
         repeat while (length of first paragraph of (get contents)) > 0
             delay 0.1
         end repeat
     end tell
 end tell
-"/dev/" & thetitle
-__SCRIPT__
+thetty
+__JAGUAR_TIGER__
 
+);
+
+sub macosx_get_fork_TTY
+{
+    my($version,$script,$pipe,$tty);
+
+    return unless $version=$ENV{TERM_PROGRAM_VERSION};
+    foreach my $entry (@script_versions) {
+       if ($version>=$entry->[0]) {
+           $script=$entry->[1];
+           last;
+       }
+    }
+    return unless defined($script);
+    return unless open($pipe,'-|','/usr/bin/osascript','-e',$script);
     $tty=readline($pipe);
     close($pipe);
     return unless defined($tty) && $tty =~ m(^/dev/);
@@ -6734,18 +6778,6 @@ we go ahead and set C<$console> and C<$tty> to the file indicated.
 
 sub TTY {
 
-    # With VMS we can get here with $term undefined, so we do not
-    # switch to this terminal.  There may be a better place to make
-    # sure that $term is defined on VMS
-    if ( @_ and ($^O eq 'VMS') and !defined($term) ) {
-       eval { require Term::ReadLine } or die $@;
-        if ( !$rl ) {
-           $term = new Term::ReadLine::Stub 'perldb', $IN, $OUT;
-       }
-       else {
-           $term = new Term::ReadLine 'perldb', $IN, $OUT;
-       }
-    }
     if ( @_ and $term and $term->Features->{newTTY} ) {
 
         # This terminal supports switching to a new TTY.
@@ -7703,6 +7735,8 @@ sub warnLevel {
         }
         elsif ($prevwarn) {
             $SIG{__WARN__} = $prevwarn;
+        } else {
+            undef $SIG{__WARN__};
         }
     } ## end if (@_)
     $warnLevel;
@@ -7744,6 +7778,9 @@ sub dieLevel {
         elsif ($prevdie) {
             $SIG{__DIE__} = $prevdie;
             print $OUT "Default die handler restored.\n";
+        } else {
+            undef $SIG{__DIE__};
+            print $OUT "Die handler removed.\n";
         }
     } ## end if (@_)
     $dieLevel;