[Summary view] [Print] [Text view]

   1  # HotKey.pm
   2  
   3  # Fetches a single keystroke under Unix.  Stolen from Perl FAQ
   4  # (section 8) and hacked up a bit.
   5  
   6  package Unattend::HotKey;
   7  
   8  @ISA = qw(Exporter);
   9  @EXPORT = qw(cbreak cooked readkey read_secret);
  10  
  11  use warnings;
  12  use strict;
  13  use POSIX qw(:termios_h);
  14  
  15  my $fd_stdin = fileno(STDIN);
  16  
  17  # Save original terminal settings
  18  my $oterm     = POSIX::Termios->new();
  19  $oterm->getattr($fd_stdin);
  20  
  21  # Create CBREAK settings
  22  my $cterm     = POSIX::Termios->new();
  23  $cterm->getattr($fd_stdin);
  24  
  25  my $echo     = ECHO | ICANON;
  26  
  27  $cterm->setlflag(~$echo & $cterm->getlflag());
  28  $cterm->setcc(VTIME, 0);
  29  $cterm->setcc(VMIN, 1);
  30  
  31  sub cbreak {
  32      $cterm->setattr($fd_stdin, TCSANOW);
  33  }
  34  
  35  sub cooked {
  36      $oterm->setattr($fd_stdin, TCSANOW);
  37  }
  38  
  39  sub readkey {
  40      my $key = '';
  41      cbreak();
  42      sysread(STDIN, $key, 1);
  43      cooked();
  44      return $key;
  45  }
  46  
  47  sub read_secret ($) {
  48      my ($max_length) = @_;
  49  
  50      my $ret = '';
  51      my $key = '';
  52  
  53      cbreak ();
  54  
  55      while (1) {
  56          sysread (STDIN, $key, 1);
  57  
  58          if ($key eq chr(10)) {
  59              last;
  60          }
  61          elsif ($key eq chr(8) || $key eq chr(127)) {
  62              length $ret > 0
  63                  or next;
  64              $ret = substr $ret, 0, -1;
  65              print chr(8), ' ', chr(8);
  66          }
  67          else {
  68              length $ret < $max_length
  69                  or next;
  70              $ret .= $key;
  71              print '*';
  72          }
  73      }
  74  
  75      cooked ();
  76  
  77      print "\n";
  78      return $ret;
  79  }
  80  
  81  END { cooked() }
  82  
  83  1;