File Coverage

blib/arch/Term/ReadKey.pm
Criterion Covered Total %
statement 18 100 18.0
branch 0 66 0.0
condition 0 42 0.0
subroutine 6 13 46.1
pod 4 7 57.1
total 28 228 12.2


line stmt bran cond sub pod time code
1             # -*- buffer-read-only: t -*-
2             #
3             # This file is auto-generated. ***ANY*** changes here will be lost
4             #
5             package Term::ReadKey;
6              
7 2     2   65945 use strict;
  2         12  
  2         57  
8 2     2   10 use warnings;
  2         4  
  2         161  
9              
10             =head1 NAME
11              
12             Term::ReadKey - A perl module for simple terminal control
13              
14             =head1 SYNOPSIS
15              
16             use Term::ReadKey;
17             ReadMode 4; # Turn off controls keys
18             while (not defined ($key = ReadKey(-1))) {
19             # No key yet
20             }
21             print "Get key $key\n";
22             ReadMode 0; # Reset tty mode before exiting
23              
24             =head1 DESCRIPTION
25              
26             Term::ReadKey is a compiled perl module dedicated to providing simple
27             control over terminal driver modes (cbreak, raw, cooked, etc.,) support for
28             non-blocking reads, if the architecture allows, and some generalized handy
29             functions for working with terminals. One of the main goals is to have the
30             functions as portable as possible, so you can just plug in "use
31             Term::ReadKey" on any architecture and have a good likelihood of it working.
32              
33             Version 2.30.01:
34             Added handling of arrows, page up/down, home/end, insert/delete keys
35             under Win32. These keys emit xterm-compatible sequences.
36             Works with Term::ReadLine::Perl.
37              
38             =over 4
39              
40             =item ReadMode MODE [, Filehandle]
41              
42             Takes an integer argument or a string synonym (case insensitive), which
43             can currently be one of the following values:
44              
45             INT SYNONYM DESCRIPTION
46              
47             0 'restore' Restore original settings.
48              
49             1 'normal' Change to what is commonly the default mode,
50             echo on, buffered, signals enabled, Xon/Xoff
51             possibly enabled, and 8-bit mode possibly disabled.
52              
53             2 'noecho' Same as 1, just with echo off. Nice for
54             reading passwords.
55              
56             3 'cbreak' Echo off, unbuffered, signals enabled, Xon/Xoff
57             possibly enabled, and 8-bit mode possibly enabled.
58              
59             4 'raw' Echo off, unbuffered, signals disabled, Xon/Xoff
60             disabled, and 8-bit mode possibly disabled.
61              
62             5 'ultra-raw' Echo off, unbuffered, signals disabled, Xon/Xoff
63             disabled, 8-bit mode enabled if parity permits,
64             and CR to CR/LF translation turned off.
65              
66              
67             These functions are automatically applied to the STDIN handle if no
68             other handle is supplied. Modes 0 and 5 have some special properties
69             worth mentioning: not only will mode 0 restore original settings, but it
70             cause the next ReadMode call to save a new set of default settings. Mode
71             5 is similar to mode 4, except no CR/LF translation is performed, and if
72             possible, parity will be disabled (only if not being used by the terminal,
73             however. It is no different from mode 4 under Windows.)
74              
75             If you just need to read a key at a time, then modes 3 or 4 are probably
76             sufficient. Mode 4 is a tad more flexible, but needs a bit more work to
77             control. If you use ReadMode 3, then you should install a SIGINT or END
78             handler to reset the terminal (via ReadMode 0) if the user aborts the
79             program via C<^C>. (For any mode, an END handler consisting of "ReadMode 0"
80             is actually a good idea.)
81              
82             If you are executing another program that may be changing the terminal mode,
83             you will either want to say
84              
85             ReadMode 1; # same as ReadMode 'normal'
86             system('someprogram');
87             ReadMode 1;
88              
89             which resets the settings after the program has run, or:
90              
91             $somemode=1;
92             ReadMode 0; # same as ReadMode 'restore'
93             system('someprogram');
94             ReadMode 1;
95              
96             which records any changes the program may have made, before resetting the
97             mode.
98              
99             =item ReadKey MODE [, Filehandle]
100              
101             Takes an integer argument, which can currently be one of the following
102             values:
103              
104             0 Perform a normal read using getc
105             -1 Perform a non-blocked read
106             >0 Perform a timed read
107              
108             If the filehandle is not supplied, it will default to STDIN. If there is
109             nothing waiting in the buffer during a non-blocked read, then undef will be
110             returned. In most situations, you will probably want to use C.
111              
112             I that if the OS does not provide any known mechanism for non-blocking
113             reads, then a C can die with a fatal error. This will hopefully
114             not be common.
115              
116             If MODE is greater then zero, then ReadKey will use it as a timeout value in
117             seconds (fractional seconds are allowed), and won't return C until
118             that time expires.
119              
120             I, again, that some OS's may not support this timeout behaviour.
121              
122             If MODE is less then zero, then this is treated as a timeout
123             of zero, and thus will return immediately if no character is waiting. A MODE
124             of zero, however, will act like a normal getc.
125              
126             I, there are currently some limitations with this call under Windows.
127             It may be possible that non-blocking reads will fail when reading repeating
128             keys from more then one console.
129              
130              
131             =item ReadLine MODE [, Filehandle]
132              
133             Takes an integer argument, which can currently be one of the following
134             values:
135              
136             0 Perform a normal read using scalar()
137             -1 Perform a non-blocked read
138             >0 Perform a timed read
139              
140             If there is nothing waiting in the buffer during a non-blocked read, then
141             undef will be returned.
142              
143             I, that if the OS does not provide any known mechanism for
144             non-blocking reads, then a C can die with a fatal
145             error. This will hopefully not be common.
146              
147             I that a non-blocking test is only performed for the first character
148             in the line, not the entire line. This call will probably B do what
149             you assume, especially with C MODE values higher then 1. For
150             example, pressing Space and then Backspace would appear to leave you
151             where you started, but any timeouts would now be suspended.
152              
153             B.
154              
155             =item GetTerminalSize [Filehandle]
156              
157             Returns either an empty array if this operation is unsupported, or a four
158             element array containing: the width of the terminal in characters, the
159             height of the terminal in character, the width in pixels, and the height in
160             pixels. (The pixel size will only be valid in some environments.)
161              
162             I, under Windows, this function must be called with an B
163             filehandle, such as C, or a handle opened to C.
164              
165             =item SetTerminalSize WIDTH,HEIGHT,XPIX,YPIX [, Filehandle]
166              
167             Return -1 on failure, 0 otherwise.
168              
169             I that this terminal size is only for B value, and
170             changing the size via this mechanism will B change the size of
171             the screen. For example, XTerm uses a call like this when
172             it resizes the screen. If any of the new measurements vary from the old, the
173             OS will probably send a SIGWINCH signal to anything reading that tty or pty.
174              
175             B.
176              
177             =item GetSpeed [, Filehandle]
178              
179             Returns either an empty array if the operation is unsupported, or a two
180             value array containing the terminal in and out speeds, in B. E.g,
181             an in speed of 9600 baud and an out speed of 4800 baud would be returned as
182             (9600,4800). Note that currently the in and out speeds will always be
183             identical in some OS's.
184              
185             B.
186              
187             =item GetControlChars [, Filehandle]
188              
189             Returns an array containing key/value pairs suitable for a hash. The pairs
190             consist of a key, the name of the control character/signal, and the value
191             of that character, as a single character.
192              
193             B.
194              
195             Each key will be an entry from the following list:
196              
197             DISCARD
198             DSUSPEND
199             EOF
200             EOL
201             EOL2
202             ERASE
203             ERASEWORD
204             INTERRUPT
205             KILL
206             MIN
207             QUIT
208             QUOTENEXT
209             REPRINT
210             START
211             STATUS
212             STOP
213             SUSPEND
214             SWITCH
215             TIME
216              
217             Thus, the following will always return the current interrupt character,
218             regardless of platform.
219              
220             %keys = GetControlChars;
221             $int = $keys{INTERRUPT};
222              
223             =item SetControlChars [, Filehandle]
224              
225             Takes an array containing key/value pairs, as a hash will produce. The pairs
226             should consist of a key that is the name of a legal control
227             character/signal, and the value should be either a single character, or a
228             number in the range 0-255. SetControlChars will die with a runtime error if
229             an invalid character name is passed or there is an error changing the
230             settings. The list of valid names is easily available via
231              
232             %cchars = GetControlChars();
233             @cnames = keys %cchars;
234              
235             B.
236              
237             =back
238              
239             =head1 AUTHOR
240              
241             Kenneth Albanowski
242              
243             Currently maintained by Jonathan Stowe
244              
245             =head1 SUPPORT
246              
247             The code is maintained at
248              
249             https://github.com/jonathanstowe/TermReadKey
250              
251             Please feel free to fork and suggest patches.
252              
253              
254             =head1 LICENSE
255              
256             Prior to the 2.31 release the license statement was:
257              
258             Copyright (C) 1994-1999 Kenneth Albanowski.
259             2001-2005 Jonathan Stowe and others
260              
261             Unlimited distribution and/or modification is allowed as long as this
262             copyright notice remains intact.
263              
264             And was only stated in the README file.
265              
266             Because I believe the original author's intent was to be more open than the
267             other commonly used licenses I would like to leave that in place. However if
268             you or your lawyers require something with some more words you can optionally
269             choose to license this under the standard Perl license:
270              
271             This module is free software; you can redistribute it and/or modify it
272             under the terms of the Artistic License. For details, see the full
273             text of the license in the file "Artistic" that should have been provided
274             with the version of perl you are using.
275              
276             This program is distributed in the hope that it will be useful, but
277             without any warranty; without even the implied warranty of merchantability
278             or fitness for a particular purpose.
279              
280              
281             =cut
282              
283 2     2   13 use vars qw($VERSION);
  2         3  
  2         147  
284              
285             $VERSION = '2.38';
286              
287             require Exporter;
288             require DynaLoader;
289              
290 2     2   11 use vars qw(@ISA @EXPORT_OK @EXPORT);
  2         5  
  2         198  
291              
292             @ISA = qw(Exporter DynaLoader);
293              
294             # Items to export into callers namespace by default
295             # (move infrequently used names to @EXPORT_OK below)
296              
297             @EXPORT = qw(
298             ReadKey
299             ReadMode
300             ReadLine
301             GetTerminalSize
302             SetTerminalSize
303             GetSpeed
304             GetControlChars
305             SetControlChars
306             );
307              
308             @EXPORT_OK = qw();
309              
310             bootstrap Term::ReadKey;
311              
312             # Should we use LINES and COLUMNS to try and get the terminal size?
313             # Change this to zero if you have systems where these are commonly
314             # set to erroneous values. (But if either are near zero, they won't be
315             # used anyhow.)
316              
317 2     2   15 use vars qw($UseEnv $CurrentMode %modes);
  2         9  
  2         556  
318              
319             $UseEnv = 1;
320              
321             $CurrentMode = 0;
322              
323             %modes = ( # lowercase is canonical
324             original => 0,
325             restore => 0,
326             normal => 1,
327             noecho => 2,
328             cbreak => 3,
329             raw => 4,
330             'ultra-raw' => 5
331             );
332              
333             # reduce Carp memory footprint, only load when needed
334 0     0 0   sub croak { require Carp; goto &Carp::croak; }
  0            
335 0     0 0   sub carp { require Carp; goto &Carp::carp; }
  0            
336              
337             sub ReadMode
338             {
339 0     0 1   my $mode = $modes{ lc $_[0] }; # lowercase is canonical
340 0 0         my $fh = normalizehandle( ( @_ > 1 ? $_[1] : \*STDIN ) );
341              
342 0 0         if ( defined($mode) ) { $CurrentMode = $mode }
  0 0          
343 0           elsif ( $_[0] =~ /^\d/ ) { $CurrentMode = $_[0] }
344 0           else { croak("Unknown terminal mode `$_[0]'"); }
345              
346 0           SetReadMode($CurrentMode, $fh);
347             }
348              
349             sub normalizehandle
350             {
351 0     0 0   my ($file) = @_; # allows fake signature optimization
352              
353 2     2   15 no strict;
  2         4  
  2         1923  
354             # print "Handle = $file\n";
355 0 0         if ( ref($file) ) { return $file; } # Reference is fine
  0            
356              
357             # if ($file =~ /^\*/) { return $file; } # Type glob is good
358 0 0         if ( ref( \$file ) eq 'GLOB' ) { return $file; } # Glob is good
  0            
359              
360             # print "Caller = ",(caller(1))[0],"\n";
361 0           return \*{ ( ( caller(1) )[0] ) . "::$file" };
  0            
362             }
363              
364             sub GetTerminalSize
365             {
366 0 0   0 1   my $file = normalizehandle( ( @_ > 0 ? $_[0] : \*STDOUT ) );
367              
368 0           my (@results, @fail);
369              
370 0 0         if ( &termsizeoptions() & 1 ) # VIO
    0          
    0          
    0          
371             {
372 0           @results = GetTermSizeVIO($file);
373 0           push( @fail, "VIOGetMode call" );
374             }
375             elsif ( &termsizeoptions() & 2 ) # GWINSZ
376             {
377 0           @results = GetTermSizeGWINSZ($file);
378 0           push( @fail, "TIOCGWINSZ ioctl" );
379             }
380             elsif ( &termsizeoptions() & 4 ) # GSIZE
381             {
382 0           @results = GetTermSizeGSIZE($file);
383 0           push( @fail, "TIOCGSIZE ioctl" );
384             }
385             elsif ( &termsizeoptions() & 8 ) # WIN32
386             {
387 0           @results = GetTermSizeWin32($file);
388 0           push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
389             }
390             else
391             {
392 0           @results = ();
393             }
394              
395 0 0 0       if ( @results < 4 and $UseEnv )
396             {
397 0 0         my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
398 0 0         my ($L) = defined( $ENV{LINES} ) ? $ENV{LINES} : 0;
399 0 0 0       if ( ( $C >= 2 ) and ( $L >= 2 ) )
400             {
401 0           @results = ( $C + 0, $L + 0, 0, 0 );
402             }
403 0           push( @fail, "COLUMNS and LINES environment variables" );
404             }
405              
406 0 0 0       if ( @results < 4 && $^O ne 'MSWin32')
407             {
408 0           my ($prog) = "resize";
409              
410             # Workaround for Solaris path silliness
411 0 0         if ( -f "/usr/openwin/bin/resize" ) {
412 0           $prog = "/usr/openwin/bin/resize";
413             }
414              
415 0           my ($resize) = scalar(`$prog 2>/dev/null`);
416 0 0 0       if (defined $resize
      0        
417             and ( $resize =~ /COLUMNS\s*=\s*(\d+)/
418             or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
419             )
420             {
421 0           $results[0] = $1;
422 0 0 0       if ( $resize =~ /LINES\s*=\s*(\d+)/
423             or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
424             {
425 0           $results[1] = $1;
426 0           @results[ 2, 3 ] = ( 0, 0 );
427             }
428             else
429             {
430 0           @results = ();
431             }
432             }
433             else
434             {
435 0           @results = ();
436             }
437 0           push( @fail, "resize program" );
438             }
439              
440 0 0 0       if ( @results < 4 && $^O ne 'MSWin32' )
441             {
442 0           my ($prog) = "stty size";
443              
444 0           my ($stty) = scalar(`$prog 2>/dev/null`);
445 0 0 0       if (defined $stty
446             and ( $stty =~ /(\d+) (\d+)/ )
447             )
448             {
449 0           $results[0] = $2;
450 0           $results[1] = $1;
451 0           @results[ 2, 3 ] = ( 0, 0 );
452             }
453             else
454             {
455 0           @results = ();
456             }
457 0           push( @fail, "stty program" );
458             }
459              
460 0 0         if ( @results != 4 )
461             {
462 0           carp("Unable to get Terminal Size."
463             . join( "", map( " The $_ didn't work.", @fail ) ));
464 0           return undef;
465             }
466              
467 0           @results;
468             }
469              
470             # blockoptions:
471             #nodelay
472             #select
473             sub ReadKey {
474 0 0   0 1   my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
475 0 0 0       if (defined $_[0] && $_[0] > 0) {
476 0 0         if ($_[0]) { return undef if &selectfile($File,$_[0]) == 0 }
  0 0          
477             }
478 0 0 0       if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1); }
  0            
479 0           my $value = getc $File;
480 0 0 0       if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0); }
  0            
481 0           $value;
482             }
483             sub ReadLine {
484 0 0   0 1   my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
485 0 0 0       if (defined $_[0] && $_[0] > 0) {
486 0 0         if ($_[0]) { return undef if &selectfile($File,$_[0]) == 0 }
  0 0          
487             }
488 0 0 0       if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1) };
  0            
489 0           my $value = scalar(<$File>);
490 0 0 0       if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0) };
  0            
491 0           $value;
492             }
493             1;
494             # ex: set ro: