How to get Perl to recognize shift-tab when reading user input

Question

I want to write a perl script that prints a series of messages to the terminal.

I want to be able to navigate between these messages. In the past, I've entered something like ">" to move forward a message and "<" to move back a message. But, I'd like to do something a bit different this time using "tab" to move forward a message and "shift-tab" to move back a message.

However, Perl seems to read "shift-tab" the same as the "esc" key. How do you capture information about modifier keys in Perl?

Here's a snippet of test code I wrote to detect what the user entered at the prompt.

#!/usr/bin/perl
use strict;
use warnings;
use Term::ReadKey;

my $response = "";
my $continue = 0;
eval {
   local $SIG{ALRM} = sub { 
      ReadMode 'normal';
      print "\n ... timed out ...\n";
      die 'Timed Out'; 
    };
   ReadMode 'cbreak';
   while ( $continue == 0 )
 {
   alarm 4;
   print "Enter your key: ";
   my $key   = Term::ReadKey::ReadKey(0);
   $response = $key;
 KEY:{
      if ( $key eq "\n"   ) { print "return entered\n"; $continue = 1; last KEY;}
      if ( $key eq "\t"   ) { print "tab entered\n";               last KEY;}
      if ( $key eq "\e"   ) { print "escape entered\n";            last KEY;}           
      if ( $key eq "\x7f" ) { print "backspace entered\n";         last KEY;}           
      if ( $key eq ">"    ) { print "forward page\n";                  last KEY;}
      if ( $key eq "<"    ) { print "forward page\n";                  last KEY;}
      print "You entered something else\n";
    }
 }
   ReadMode(0) ;
 }

  

Actually, the above code revealed something to me. Namely, when I enter certain keys, they're not read as a single key but as a sequence of keys. So, shift-tab is being read as \e[Z. Now, I'm wondering how to work with this. Any suggestions? Is there a way to distinguish between the user entering \e and a key (like shift-tab) sending \e[Z?

Answer 1

Following the PerlMonks discussion suggested by @choroba, I adopted the following approach to set a time-out threshold for reading a sequence of keys.

Here is my code with a lot of additions, but the primary one notes whether a sequence starting with the escape was signaled and then set a time-out to read the remainder of the key sequence.

I suspect that some aspects of this may be particular to my terminal settings; I haven't yet taken the time to explore that.

#!/usr/bin/perl
use strict;
use warnings;
use Term::ReadKey;

use Time::HiRes qw/usleep ualarm/;

my $continue = 0;
eval {
   local $SIG{ALRM} = sub { 
      ReadMode 'normal';
      print "\n ... timed out ...\n";
      die 'Timed Out'; 
    };
   ReadMode 'cbreak';
   while ( $continue == 0 )
     {
       print "Enter your key: ";
       my $key = "";
       my $alt = "";
       $key   = Term::ReadKey::ReadKey(0);
       if ( $key eq "\e" )
         {
           eval {
              local $SIG{ALRM} = sub {
                 ## print "too fast\n";
                 die "";
               };
              ualarm(100);
              while ( 1 )
                {
                  $key .= Term::ReadKey::ReadKey(0);
                }
            };
           $alt = $key;
           $alt =~ s/^\e/{E}/;
         }
       alarm 5;
     KEY:{
          if ( $key eq "\eOP"        ) { printf "%8s -> %-7s \n" ,  "F1",         $alt; last KEY; }
          if ( $key eq "\eOQ"        ) { printf "%8s -> %-7s \n" ,  "F2",         $alt; last KEY; }
          if ( $key eq "\eOR"        ) { printf "%8s -> %-7s \n" ,  "F3",         $alt; last KEY; }
          if ( $key eq "\eOS"        ) { printf "%8s -> %-7s \n" ,  "F4",         $alt; last KEY; }
          if ( $key eq "\e[15~"      ) { printf "%8s -> %-7s \n" ,  "F5",         $alt; last KEY; }
          if ( $key eq "\e[17~"      ) { printf "%8s -> %-7s \n" ,  "F6",         $alt; last KEY; }
          if ( $key eq "\e[18~"      ) { printf "%8s -> %-7s \n" ,  "F7",         $alt; last KEY; }
          if ( $key eq "\e[19~"      ) { printf "%8s -> %-7s \n" ,  "F8",         $alt; last KEY; }
          if ( $key eq "\e[20~"      ) { printf "%8s -> %-7s \n" ,  "F9",         $alt; last KEY; }
          if ( $key eq "\e[21~"      ) { printf "%8s -> %-7s \n" , "F10",         $alt; last KEY; }
          if ( $key eq "\e[23~"      ) { printf "%8s -> %-7s \n" , "F11",         $alt; last KEY; }
          if ( $key eq "\e[24~"      ) { printf "%8s -> %-7s \n" , "F12",         $alt; last KEY; }
          if ( $key eq "\e[25~"      ) { printf "%8s -> %-7s \n" , "F13",         $alt; last KEY; }
          if ( $key eq "\e[26~"      ) { printf "%8s -> %-7s \n" , "F14",         $alt; last KEY; }
          if ( $key eq "\e[28~"      ) { printf "%8s -> %-7s \n" , "F15",         $alt; last KEY; }
          if ( $key eq "\e[29~"      ) { printf "%8s -> %-7s \n" , "F16",         $alt; last KEY; }
          if ( $key eq "\e[31~"      ) { printf "%8s -> %-7s \n" , "F17",         $alt; last KEY; }
          if ( $key eq "\e[32~"      ) { printf "%8s -> %-7s \n" , "F18",         $alt; last KEY; }
          if ( $key eq "\e[Z"        ) { printf "%8s -> %-7s \n" , "shft-tab",    $alt; last KEY; }
          
          if ( $key eq "\e[A"        ) { printf "%8s -> %-7s \n" , "up",          $alt; last KEY; }
          if ( $key eq "\e[B"        ) { printf "%8s -> %-7s \n" , "down",        $alt; last KEY; }
          if ( $key eq "\e[C"        ) { printf "%8s -> %-7s \n" , "right",       $alt; last KEY; }
          if ( $key eq "\e[D"        ) { printf "%8s -> %-7s \n" , "left",        $alt; last KEY; }
          
          if ( $key eq "\e[1;2D"     ) { printf "%8s -> %-7s \n" , "sht-left",    $alt; last KEY; }
          if ( $key eq "\e[1;2C"     ) { printf "%8s -> %-7s \n" , "sht-right",   $alt; last KEY; }
          
          if ( $key eq "\e[1;5D"     ) { printf "%8s -> %-7s \n" , "cnt-left",    $alt; last KEY; }
          if ( $key eq "\e[1;5C"     ) { printf "%8s -> %-7s \n" , "cnt-right",   $alt; last KEY; }
          
          if ( $key eq "\eb"         ) { printf "%8s -> %-7s \n" , "opt-left",    $alt; last KEY; }
          if ( $key eq "\ef"         ) { printf "%8s -> %-7s \n" , "opt-right",   $alt; last KEY; }
          
          if ( $key eq "\e"          ) { printf "%8s -> %-7s\n", "ESC", "{E}";  last KEY;}           
          
          if ( $key eq "\n"            ) { print "return entered\n"; $continue = 1;       last KEY;}
          if ( $key eq "\t"            ) { print "tab entered\n";                         last KEY;}
          if ( $key eq "\x7f"          ) { print "backspace entered\n";                   last KEY;}           
          if ( $key eq ">"             ) { print "forward page\n";                        last KEY;}
          if ( $key eq "<"             ) { print "backward page\n";                       last KEY;}
          if ( $key =~ /^[a-zA-Z]$/    ) { printf "Alphabet \"%s\"\n",$key;               last KEY; }
          if ( $key =~ /^[[:digit:]]$/ ) { printf "Numeric \"%s\"\n",$key;                last KEY; }
          if ( $key =~ /^[[:punct:]]$/ ) { printf "Punctuation \"%s\"\n",$key;            last KEY; }
          if ( length($key) > 1      ) 
            { 
              $key =~ s/^\e/{E}/;
              printf "something long: \"%s\"\n",$key;  
              last KEY;
            }
          if ( ord($key) == 1 ) { print "Cntr-A (Start of heading)\n";        last KEY; }
          if ( ord($key) == 2 ) { print "Cntr-B (Start of text)\n";           last KEY; }
          if ( ord($key) == 3 ) { print "Cntr-C [=== quit your program ]\n";  last KEY; }
          if ( ord($key) == 4 ) { print "Cntr-D [=== quit your terminal ]\n"; last KEY; }
          if ( ord($key) == 5 ) { print "Cntr-E (Enquiry)\n";                 last KEY; }
          if ( ord($key) == 6 ) { print "Cntr-F (Acknowledge)\n";             last KEY; }
          if ( ord($key) == 7 ) { print "Cntr-G (Ring terminal bell)\n";      last KEY; }
          if ( ord($key) == 8 ) { print "Cntr-H (backspace)\n";               last KEY; }
          
          print "You entered something else: $key\n";
        }
     }
   ReadMode(0) ;
 }