Implement get_fork_TTY for tmux

Perl · May 28, 2014 · babb663 · babb663
1 parent 723edb9
commit babb663
Showing 1 changed file with 42 additions and 0 deletions.
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
@@ -1331,6 +1331,9 @@ sub is_safe_file {
     {
         *get_fork_TTY = \&xterm_get_fork_TTY;    # use the xterm version
     }
+    elsif ( $ENV{TMUX} ) {
+        *get_fork_TTY = \&tmux_get_fork_TTY;
+    }
     elsif ( $^O eq 'os2' ) {                     # If this is OS/2,
         *get_fork_TTY = \&os2_get_fork_TTY;      # use the OS/2 version
     }
@@ -7077,6 +7080,45 @@ sub macosx_get_fork_TTY
     return $tty;
 }
 
+=head3 C<tmux_get_fork_TTY>
+
+Creates a split window for subprocesses when a process running under the
+perl debugger in Tmux forks.
+
+=cut
+
+sub tmux_get_fork_TTY {
+    return unless $ENV{TMUX};
+
+    my $pipe;
+
+    my $status = open $pipe, '-|', 'tmux', 'split-window',
+        '-P', '-F', '#{pane_tty}', 'sleep 100000';
+
+    if ( !$status ) {
+        return;
+    }
+
+    my $tty = <$pipe>;
+    close $pipe;
+
+    if ( $tty ) {
+        chomp $tty;
+
+        if ( !defined $term ) {
+            require Term::ReadLine;
+            if ( !$rl ) {
+                $term = Term::ReadLine::Stub->new( 'perldb', $IN, $OUT );
+            }
+            else {
+                $term = Term::ReadLine->new( 'perldb', $IN, $OUT );
+            }
+        }
+    }
+
+    return $tty;
+}
+
 =head2 C<create_IN_OUT($flags)>
 
 Create a new pair of filehandles, pointing to a new TTY. If impossible,