Commit | Line | Data |
---|---|---|
86530b38 AT |
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__; |