perl - 如何让 Perl 在读取用户输入时识别 Shift-Tab

标签 perl

我想编写一个 perl 脚本,将一系列消息打印到终端。

我希望能够在这些消息之间导航。过去,我输入“>”之类的内容来向前移动消息,输入“<”来向后移动消息。但是,这次我想做一些不同的事情,使用“tab”向前移动消息,使用“shift-tab”向后移动消息。

然而,Perl 似乎将“shift-tab”读作“esc”键。如何在 Perl 中捕获有关修饰键的信息?

这是我编写的一段测试代码,用于检测用户在提示符下输入的内容。

#!/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) ;
 }

  

实际上,上面的代码向我揭示了一些东西。也就是说,当我输入某些键时,它们不会被读取为单个键,而是被读取为一系列键。因此,shift-tab 被读取为 \e[Z。现在,我想知道如何处理这个问题。有什么建议么?有没有办法区分用户输入 \e 和发送 \e[Z 的按键(如 shift-tab)?

最佳答案

遵循PerlMonks discussion根据@choroba的建议,我采用了以下方法来设置读取键序列的超时阈值。

这是我的代码,其中添加了很多内容,但主要的代码指出以转义开头的序列是否已发出信号,然后设置超时以读取按键序列的其余部分。

我怀疑其中的某些方面可能是我的终端设置所特有的;我还没有花时间去探索这个问题。

#!/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) ;
 }
    
      

关于perl - 如何让 Perl 在读取用户输入时识别 Shift-Tab,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/71551032/

相关文章:

perl - 为什么将 '1' 映射到 perl 中的散列?

regex - 如何在变量中保存替换正则表达式(搜索/替换),类似于 qr//

perl - 检查程序是否正在运行,如果不在 perl 中运行它

regex - Perl 问号后跟冒号模式匹配

perl - 如何 fork Perl CGI 程序来分拆长时间运行的任务?

linux - 在 perl 中截图

r - R 是否有像 Perl 的 qw() 这样的类似引号的操作符?

perl - Perl将(s)printf输出附加到字符串

perl - 在 Perl 中解析具有重复部分的文件

perl - 从今天减去天数并比较