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