home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / ReadKey.pm < prev    next >
Text File  |  2002-07-28  |  15KB  |  545 lines
  1. #
  2. #  $Id: ReadKey.pm,v 1.7 2002/07/28 12:01:18 gellyfish Exp $
  3. # 
  4.  
  5. =head1 NAME
  6.  
  7. Term::ReadKey - A perl module for simple terminal control
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.     use Term::ReadKey;
  12.     ReadMode 4; # Turn off controls keys
  13.     while (not defined ($key = ReadKey(-1)) {
  14.         # No key yet
  15.     }
  16.     print "Get key $key\n";
  17.     ReadMode 0; # Reset tty mode before exiting
  18.  
  19. =head1 DESCRIPTION
  20.  
  21. Term::ReadKey is a compiled perl module dedicated to providing simple
  22. control over terminal driver modes (cbreak, raw, cooked, etc.,) support for
  23. non-blocking reads, if the architecture allows, and some generalized handy
  24. functions for working with terminals. One of the main goals is to have the
  25. functions as portable as possible, so you can just plug in "use
  26. Term::ReadKey" on any architecture and have a good likelyhood of it working.
  27.  
  28. =over 8
  29.  
  30. =item ReadMode MODE [, Filehandle]
  31.  
  32. Takes an integer argument, which can currently be one of the following 
  33. values:
  34.  
  35.     0    Restore original settings.
  36.     1    Change to cooked mode.
  37.     2     Change to cooked mode with echo off. 
  38.           (Good for passwords)
  39.     3    Change to cbreak mode.
  40.     4    Change to raw mode.
  41.     5    Change to ultra-raw mode. 
  42.           (LF to CR/LF translation turned off) 
  43.           
  44.     Or, you may use the synonyms:
  45.     
  46.     restore
  47.     normal
  48.     noecho
  49.     cbreak
  50.     raw
  51.     ultra-raw
  52.  
  53. These functions are automatically applied to the STDIN handle if no
  54. other handle is supplied. Modes 0 and 5 have some special properties
  55. worth mentioning: not only will mode 0 restore original settings, but it
  56. cause the next ReadMode call to save a new set of default settings. Mode
  57. 5 is similar to mode 4, except no CR/LF translation is performed, and if
  58. possible, parity will be disabled (only if not being used by the terminal,
  59. however. It is no different from mode 4 under Windows.)
  60.  
  61. If you are executing another program that may be changing the terminal mode,
  62. you will either want to say
  63.  
  64.     ReadMode 1
  65.     system('someprogram');
  66.     ReadMode 1;
  67.     
  68. which resets the settings after the program has run, or:
  69.  
  70.     $somemode=1;
  71.     ReadMode 0;
  72.     system('someprogram');
  73.     ReadMode 1;
  74.     
  75. which records any changes the program may have made, before resetting the
  76. mode.
  77.  
  78. =item ReadKey MODE [, Filehandle]
  79.  
  80. Takes an integer argument, which can currently be one of the following 
  81. values:
  82.  
  83.     0    Perform a normal read using getc
  84.     -1   Perform a non-blocked read
  85.     >0     Perform a timed read
  86.  
  87. (If the filehandle is not supplied, it will default to STDIN.) If there is
  88. nothing waiting in the buffer during a non-blocked read, then undef will be
  89. returned. Note that if the OS does not provide any known mechanism for
  90. non-blocking reads, then a C<ReadKey -1> can die with a fatal error. This
  91. will hopefully not be common.
  92.  
  93. If MODE is greater then zero, then ReadKey will use it as a timeout value in
  94. seconds (fractional seconds are allowed), and won't return C<undef> until
  95. that time expires. (Note, again, that some OS's may not support this timeout
  96. behaviour.) If MODE is less then zero, then this is treated as a timeout
  97. of zero, and thus will return immediately if no character is waiting. A MODE
  98. of zero, however, will act like a normal getc.
  99.  
  100. There are currently some limitations with this call under Windows. It may be
  101. possible that non-blocking reads will fail when reading repeating keys from
  102. more then one console.
  103.  
  104. =item ReadLine MODE [, Filehandle]
  105.  
  106. Takes an integer argument, which can currently be one of the following 
  107. values:
  108.  
  109.     0    Perform a normal read using scalar(<FileHandle>)
  110.     -1   Perform a non-blocked read
  111.     >0     Perform a timed read
  112.  
  113. If there is nothing waiting in the buffer during a non-blocked read, then
  114. undef will be returned. Note that if the OS does not provide any known
  115. mechanism for non-blocking reads, then a C<ReadLine 1> can die with a fatal
  116. error. This will hopefully not be common. Note that a non-blocking test is
  117. only performed for the first character in the line, not the entire line.
  118. This call will probably B<not> do what you assume, especially with
  119. ReadMode's higher then 1. For example, pressing Space and then Backspace
  120. would appear to leave you where you started, but any timeouts would now
  121. be suspended.
  122.  
  123. This call is currently not available under Windows.
  124.  
  125. =item GetTerminalSize [Filehandle]
  126.  
  127. Returns either an empty array if this operation is unsupported, or a four
  128. element array containing: the width of the terminal in characters, the
  129. height of the terminal in character, the width in pixels, and the height in
  130. pixels. (The pixel size will only be valid in some environments.)
  131.  
  132. Under Windows, this function must be called with an "output" filehandle,
  133. such as STDOUT, or a handle opened to CONOUT$.
  134.  
  135. =item SetTerminalSize WIDTH,HEIGHT,XPIX,YPIX [, Filehandle]
  136.  
  137. Return -1 on failure, 0 otherwise. Note that this terminal size is only for
  138. B<informative> value, and changing the size via this mechanism will B<not>
  139. change the size of the screen. For example, XTerm uses a call like this when
  140. it resizes the screen. If any of the new measurements vary from the old, the
  141. OS will probably send a SIGWINCH signal to anything reading that tty or pty.
  142.  
  143. This call does not work under Windows.
  144.  
  145. =item GetSpeeds [, Filehandle]
  146.  
  147. Returns either an empty array if the operation is unsupported, or a two
  148. value array containing the terminal in and out speeds, in B<decimal>. E.g,
  149. an in speed of 9600 baud and an out speed of 4800 baud would be returned as
  150. (9600,4800). Note that currently the in and out speeds will always be
  151. identical in some OS's. No speeds are reported under Windows.
  152.  
  153. =item GetControlChars [, Filehandle]
  154.  
  155. Returns an array containing key/value pairs suitable for a hash. The pairs
  156. consist of a key, the name of the control character/signal, and the value
  157. of that character, as a single character. This call does nothing under Windows.
  158.  
  159. Each key will be an entry from the following list:
  160.  
  161.     DISCARD
  162.     DSUSPEND
  163.     EOF
  164.     EOL
  165.     EOL2
  166.     ERASE
  167.     ERASEWORD
  168.     INTERRUPT
  169.     KILL
  170.     MIN
  171.     QUIT
  172.     QUOTENEXT
  173.     REPRINT
  174.     START
  175.     STATUS
  176.     STOP
  177.     SUSPEND
  178.     SWITCH
  179.     TIME
  180.  
  181. Thus, the following will always return the current interrupt character,
  182. regardless of platform.
  183.  
  184.     %keys = GetControlChars;
  185.     $int = $keys{INTERRUPT};
  186.  
  187. =item SetControlChars [, Filehandle]
  188.  
  189. Takes an array containing key/value pairs, as a hash will produce. The pairs
  190. should consist of a key that is the name of a legal control
  191. character/signal, and the value should be either a single character, or a
  192. number in the range 0-255. SetControlChars will die with a runtime error if
  193. an invalid character name is passed or there is an error changing the
  194. settings. The list of valid names is easily available via
  195.  
  196.     %cchars = GetControlChars();
  197.     @cnames = keys %cchars;
  198.  
  199. This call does nothing under Windows.
  200.  
  201. =back
  202.  
  203. =head1 AUTHOR
  204.  
  205. Kenneth Albanowski <kjahds@kjahds.com>
  206.  
  207. Currently maintained by Jonathan Stowe <jns@gellyfish.com>
  208.  
  209. =cut
  210.  
  211. package Term::ReadKey;
  212.  
  213.  
  214. $VERSION = '2.21';
  215.  
  216. require Exporter;
  217. require AutoLoader;
  218. require DynaLoader;
  219. use Carp;
  220.  
  221. @ISA = qw(Exporter AutoLoader DynaLoader);
  222.  
  223. # Items to export into callers namespace by default
  224. # (move infrequently used names to @EXPORT_OK below)
  225.  
  226. @EXPORT =  qw(
  227.           ReadKey 
  228.               ReadMode 
  229.               ReadLine 
  230.               GetTerminalSize 
  231.               SetTerminalSize
  232.           GetSpeed 
  233.               GetControlChars 
  234.               SetControlChars
  235.              );
  236.  
  237.  
  238. @EXPORT_OK = qw();
  239.  
  240. bootstrap Term::ReadKey;
  241.  
  242. # Preloaded methods go here.  Autoload methods go after __END__, and are
  243. # processed by the autosplit program.
  244.  
  245.  
  246. # Should we use LINES and COLUMNS to try and get the terminal size?
  247. # Change this to zero if you have systems where these are commonly
  248. # set to erroneous values. (But if either are nero zero, they won't be
  249. # used anyhow.)
  250.  
  251. $UseEnv = 1;
  252.  
  253.  
  254. %modes=( original    => 0, 
  255.          restore     => 0, 
  256.          normal      => 1, 
  257.          noecho      => 2, 
  258.      cbreak      => 3, 
  259.          raw         => 4, 
  260.          'ultra-raw' => 5);
  261.  
  262. sub ReadMode {
  263.     my($mode) = $modes{$_[0]};
  264.     my($fh) = normalizehandle((@_>1?$_[1]:\*STDIN));
  265.     if(defined($mode))
  266.         { SetReadMode($mode,$fh) } 
  267.     elsif( $_[0] =~ /^\d/)
  268.         { SetReadMode($_[0],$fh) }
  269.     else
  270.         { croak("Unknown terminal mode `$_[0]'"); }
  271. }
  272.  
  273. sub normalizehandle {
  274.     my($file) = @_;
  275. #    print "Handle = $file\n";
  276.     if(ref($file)) { return $file; } # Reference is fine
  277. #    if($file =~ /^\*/) { return $file; } # Type glob is good
  278.     if (ref(\$file) eq 'GLOB') { return $file; } # Glob is good
  279. #    print "Caller = ",(caller(1))[0],"\n";
  280.     return \*{((caller(1))[0])."::$file"};
  281. }
  282.  
  283.  
  284. sub GetTerminalSize {
  285.     my($file) = normalizehandle((@_>1?$_[1]:\*STDOUT));
  286.     my(@results) = ();
  287.     my(@fail);
  288.     
  289.     if(&termsizeoptions() & 1) # VIO
  290.     {
  291.         @results = GetTermSizeVIO($file);
  292.         push(@fail,"VIOGetMode call");
  293.     } elsif(&termsizeoptions() & 2) # GWINSZ
  294.     {
  295.         @results = GetTermSizeGWINSZ($file);
  296.         push(@fail,"TIOCGWINSZ ioctl");
  297.     } elsif(&termsizeoptions() & 4) # GSIZE
  298.     {
  299.         @results = GetTermSizeGSIZE($file);
  300.         push(@fail,"TIOCGSIZE ioctl");
  301.     } elsif(&termsizeoptions() & 8) # WIN32
  302.     {
  303.         @results = GetTermSizeWin32($file);
  304.         push(@fail,"Win32 GetConsoleScreenBufferInfo call");
  305.     } else
  306.     {
  307.         @results = ();
  308.     }
  309.     
  310.     if(@results<4 and $UseEnv) {
  311.         my($C) = defined($ENV{COLUMNS}) ? $ENV{COLUMNS} : 0;
  312.         my($L) = defined($ENV{LINES}) ? $ENV{LINES} : 0;
  313.         if(($C >= 2) and ($L >=2)) {
  314.             @results = ($C+0,$L+0,0,0);
  315.         }
  316.         push(@fail,"COLUMNS and LINES environment variables");
  317.     }
  318.     
  319.     if(@results<4) {
  320.         my($prog) = "resize";
  321.         
  322.         # Workaround for Solaris path sillyness
  323.         if(-f "/usr/openwin/bin/resize") { $prog = "/usr/openwin/bin/resize"}
  324.         
  325.         my($resize) = scalar(`$prog 2>/dev/null`);
  326.         if(defined $resize and ($resize =~ /COLUMNS\s*=\s*(\d+)/ or 
  327.            $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/))  {
  328.             $results[0] = $1;
  329.             if( $resize =~ /LINES\s*=\s*(\d+)/ or
  330.                 $resize =~ /setenv\s+LINES\s+'?(\d+)/) {
  331.                 $results[1] = $1;
  332.                 @results[2,3] = (0,0);
  333.             } else {
  334.                 @results = ();
  335.             }
  336.         } else {
  337.             @results = ();
  338.         }
  339.         push(@fail,"resize program");
  340.     }
  341.     
  342.     if(@results<4) {
  343.         die "Unable to get Terminal Size.".join("", map(" The $_ didn't work.",@fail));
  344.     }
  345.     
  346.     @results;
  347. }
  348.  
  349.  
  350.  
  351. if(&blockoptions() & 1) # Use nodelay
  352. {
  353.     if(&blockoptions() & 2) #poll
  354.     {
  355.         eval <<'DONE';
  356.         sub ReadKey {
  357.           my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  358.                   if (defined $_[0] && $_[0] > 0) {
  359.                     if ($_[0]) {
  360.                       return undef if &pollfile($File,$_[0]) == 0;
  361.                     }
  362.           }
  363.                   if (defined $_[0] && $_[0] < 0) {
  364.                      &setnodelay($File,1);
  365.                   }
  366.                   my ($value) = getc $File;
  367.                   if (defined $_[0] && $_[0] < 0) {
  368.                      &setnodelay($File,0);
  369.                   }
  370.                   $value;
  371.         }
  372.         sub ReadLine {
  373.           my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  374.  
  375.                   if (defined $_[0] && $_[0] > 0) {
  376.                      if ($_[0]) {
  377.                        return undef if &pollfile($File,$_[0]) == 0;
  378.                      }
  379.           }
  380.                   if (defined $_[0] && $_[0] < 0) {
  381.                      &setnodelay($File,1)
  382.                   };
  383.                   my ($value) = scalar(<$File>);
  384.                   if ( defined $_[0] && $_[0]<0 ) {
  385.                     &setnodelay($File,0)
  386.                   };
  387.                   $value;
  388.         }
  389. DONE
  390.     } 
  391.         elsif(&blockoptions() & 4) #select
  392.     {
  393.         eval <<'DONE';
  394.         sub ReadKey {
  395.           my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  396.                   if(defined $_[0] && $_[0]>0) {
  397.                 if($_[0]) {return undef if &selectfile($File,$_[0])==0}
  398.             }
  399.             if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
  400.             my($value) = getc $File;
  401.             if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
  402.             $value;
  403.         }
  404.         sub ReadLine {
  405.           my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  406.             if(defined $_[0] && $_[0]>0) {
  407.                 if($_[0]) {return undef if &selectfile($File,$_[0])==0}
  408.             }
  409.             if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
  410.             my($value)=scalar(<$File>);
  411.             if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
  412.             $value;
  413.         }
  414. DONE
  415.     } else { #nothing
  416.         eval <<'DONE';
  417.         sub ReadKey {
  418.           my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  419.             if(defined $_[0] && $_[0]>0) {
  420.                 # Nothing better seems to exist, so I just use time-of-day
  421.                 # to timeout the read. This isn't very exact, though.
  422.                 $starttime=time;
  423.                 $endtime=$starttime+$_[0];
  424.                 &setnodelay($File,1);
  425.                 my($value)=undef;
  426.                 while(time<$endtime) { # This won't catch wraparound!
  427.                     $value = getc $File;
  428.                     last if defined($value);
  429.                 }
  430.                 &setnodelay($File,0);
  431.                 return $value;
  432.             }
  433.             if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
  434.             my($value) = getc $File;
  435.             if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
  436.             $value;
  437.         }
  438.         sub ReadLine {
  439.           my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  440.             if(defined $_[0] && $_[0]>0) {
  441.                 # Nothing better seems to exist, so I just use time-of-day
  442.                 # to timeout the read. This isn't very exact, though.
  443.                 $starttime=time;
  444.                 $endtime=$starttime+$_[0];
  445.                 &setnodelay($File,1);
  446.                 my($value)=undef;
  447.                 while(time<$endtime) { # This won't catch wraparound!
  448.                     $value = scalar(<$File>);
  449.                     last if defined($value);
  450.                 }
  451.                 &setnodelay($File,0);
  452.                 return $value;
  453.             }
  454.             if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
  455.             my($value)=scalar(<$File>);
  456.             if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
  457.             $value;
  458.         }
  459. DONE
  460.     }
  461. }
  462. elsif(&blockoptions() & 2) # Use poll
  463. {
  464.     eval <<'DONE';
  465.     sub ReadKey {
  466.       my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  467.         if(defined $_[0] && $_[0] != 0) {
  468.                      return undef if &pollfile($File,$_[0]) == 0
  469.                 }
  470.         getc $File;
  471.     }
  472.     sub ReadLine {
  473.       my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  474.         if(defined $_[0] && $_[0]!=0) {
  475.                      return undef if &pollfile($File,$_[0]) == 0;
  476.                 }
  477.         scalar(<$File>);
  478.     }
  479. DONE
  480. }
  481. elsif(&blockoptions() & 4) # Use select
  482. {
  483.     eval <<'DONE';
  484.     sub ReadKey {
  485.       my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  486.         if(defined $_[0] && $_[0] !=0 ) {
  487.                      return undef if &selectfile($File,$_[0])==0
  488.                 }
  489.         getc $File;
  490.     }
  491.     sub ReadLine {
  492.       my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  493.         if(defined $_[0] && $_[0] != 0) {
  494.                      return undef if &selectfile($File,$_[0]) == 0;
  495.                 }
  496.         scalar(<$File>);
  497.     }
  498. DONE
  499. }
  500. elsif(&blockoptions() & 8) # Use Win32
  501. {
  502.     eval <<'DONE';
  503.     sub ReadKey {
  504.       my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  505.         if ($_[0]) {
  506.             Win32PeekChar($File, $_[0]);
  507.         } else {
  508.             getc $File;
  509.         }
  510.         #if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
  511.         #getc $File;
  512.     }
  513.     sub ReadLine {
  514.       my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  515.         #if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
  516.         #scalar(<$File>);
  517.         if($_[0]) 
  518.             {croak("Non-blocking ReadLine is not supported on this architecture")}
  519.         scalar(<$File>);
  520.     }
  521. DONE
  522. }
  523. else
  524. {
  525.     eval <<'DONE';
  526.     sub ReadKey {
  527.       my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  528.         if($_[0]) 
  529.             {croak("Non-blocking ReadKey is not supported on this architecture")}
  530.         getc $File;
  531.     }
  532.     sub ReadLine {
  533.       my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  534.         if($_[0]) 
  535.             {croak("Non-blocking ReadLine is not supported on this architecture")}
  536.         scalar(<$File>);
  537.     }
  538. DONE
  539. }
  540.  
  541. package Term::ReadKey; # return to package ReadKey so AutoSplit is happy
  542. 1;
  543.  
  544. __END__;
  545.