← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:20 2017

Filename/usr/local/lib/perl5/site_perl/mach/5.24/Term/ReadKey.pm
StatementsExecuted 23 statements in 3.07ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11187µs87µsTerm::ReadKey::::bootstrapTerm::ReadKey::bootstrap (xsub)
11144µs52µsTerm::ReadKey::::BEGIN@7Term::ReadKey::BEGIN@7
11132µs54µsTerm::ReadKey::::BEGIN@8Term::ReadKey::BEGIN@8
11130µs244µsTerm::ReadKey::::BEGIN@317Term::ReadKey::BEGIN@317
11126µs182µsTerm::ReadKey::::BEGIN@290Term::ReadKey::BEGIN@290
11126µs117µsTerm::ReadKey::::BEGIN@283Term::ReadKey::BEGIN@283
11124µs42µsTerm::ReadKey::::BEGIN@353Term::ReadKey::BEGIN@353
0000s0sTerm::ReadKey::::GetTerminalSizeTerm::ReadKey::GetTerminalSize
0000s0sTerm::ReadKey::::ReadKeyTerm::ReadKey::ReadKey
0000s0sTerm::ReadKey::::ReadLineTerm::ReadKey::ReadLine
0000s0sTerm::ReadKey::::ReadModeTerm::ReadKey::ReadMode
0000s0sTerm::ReadKey::::carpTerm::ReadKey::carp
0000s0sTerm::ReadKey::::croakTerm::ReadKey::croak
0000s0sTerm::ReadKey::::normalizehandleTerm::ReadKey::normalizehandle
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# -*- buffer-read-only: t -*-
2#
3# This file is auto-generated. ***ANY*** changes here will be lost
4#
5package Term::ReadKey;
6
7263µs260µs
# spent 52µs (44+8) within Term::ReadKey::BEGIN@7 which was called: # once (44µs+8µs) by Mail::SpamAssassin::Util::Progress::BEGIN@52 at line 7
use strict;
# spent 52µs making 1 call to Term::ReadKey::BEGIN@7 # spent 8µs making 1 call to strict::import
82479µs276µs
# spent 54µs (32+22) within Term::ReadKey::BEGIN@8 which was called: # once (32µs+22µs) by Mail::SpamAssassin::Util::Progress::BEGIN@52 at line 8
use warnings;
# spent 54µs making 1 call to Term::ReadKey::BEGIN@8 # spent 22µs making 1 call to warnings::import
9
10=head1 NAME
11
12Term::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
26Term::ReadKey is a compiled perl module dedicated to providing simple
27control over terminal driver modes (cbreak, raw, cooked, etc.,) support for
28non-blocking reads, if the architecture allows, and some generalized handy
29functions for working with terminals. One of the main goals is to have the
30functions as portable as possible, so you can just plug in "use
31Term::ReadKey" on any architecture and have a good likelihood of it working.
32
33Version 2.30.01:
34Added handling of arrows, page up/down, home/end, insert/delete keys
35under Win32. These keys emit xterm-compatible sequences.
36Works with Term::ReadLine::Perl.
37
38=over 4
39
40=item ReadMode MODE [, Filehandle]
41
42Takes an integer argument or a string synonym (case insensitive), which
43can 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
67These functions are automatically applied to the STDIN handle if no
68other handle is supplied. Modes 0 and 5 have some special properties
69worth mentioning: not only will mode 0 restore original settings, but it
70cause the next ReadMode call to save a new set of default settings. Mode
715 is similar to mode 4, except no CR/LF translation is performed, and if
72possible, parity will be disabled (only if not being used by the terminal,
73however. It is no different from mode 4 under Windows.)
74
75If you just need to read a key at a time, then modes 3 or 4 are probably
76sufficient. Mode 4 is a tad more flexible, but needs a bit more work to
77control. If you use ReadMode 3, then you should install a SIGINT or END
78handler to reset the terminal (via ReadMode 0) if the user aborts the
79program via C<^C>. (For any mode, an END handler consisting of "ReadMode 0"
80is actually a good idea.)
81
82If you are executing another program that may be changing the terminal mode,
83you will either want to say
84
85 ReadMode 1; # same as ReadMode 'normal'
86 system('someprogram');
87 ReadMode 1;
88
89which 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
96which records any changes the program may have made, before resetting the
97mode.
98
99=item ReadKey MODE [, Filehandle]
100
101Takes an integer argument, which can currently be one of the following
102values:
103
104 0 Perform a normal read using getc
105 -1 Perform a non-blocked read
106 >0 Perform a timed read
107
108If the filehandle is not supplied, it will default to STDIN. If there is
109nothing waiting in the buffer during a non-blocked read, then undef will be
110returned. In most situations, you will probably want to use C<ReadKey -1>.
111
112I<NOTE> that if the OS does not provide any known mechanism for non-blocking
113reads, then a C<ReadKey -1> can die with a fatal error. This will hopefully
114not be common.
115
116If MODE is greater then zero, then ReadKey will use it as a timeout value in
117seconds (fractional seconds are allowed), and won't return C<undef> until
118that time expires.
119
120I<NOTE>, again, that some OS's may not support this timeout behaviour.
121
122If MODE is less then zero, then this is treated as a timeout
123of zero, and thus will return immediately if no character is waiting. A MODE
124of zero, however, will act like a normal getc.
125
126I<NOTE>, there are currently some limitations with this call under Windows.
127It may be possible that non-blocking reads will fail when reading repeating
128keys from more then one console.
129
130
131=item ReadLine MODE [, Filehandle]
132
133Takes an integer argument, which can currently be one of the following
134values:
135
136 0 Perform a normal read using scalar(<FileHandle>)
137 -1 Perform a non-blocked read
138 >0 Perform a timed read
139
140If there is nothing waiting in the buffer during a non-blocked read, then
141undef will be returned.
142
143I<NOTE>, that if the OS does not provide any known mechanism for
144non-blocking reads, then a C<ReadLine 1> can die with a fatal
145error. This will hopefully not be common.
146
147I<NOTE> that a non-blocking test is only performed for the first character
148in the line, not the entire line. This call will probably B<not> do what
149you assume, especially with C<ReadMode> MODE values higher then 1. For
150example, pressing Space and then Backspace would appear to leave you
151where you started, but any timeouts would now be suspended.
152
153B<This call is currently not available under Windows>.
154
155=item GetTerminalSize [Filehandle]
156
157Returns either an empty array if this operation is unsupported, or a four
158element array containing: the width of the terminal in characters, the
159height of the terminal in character, the width in pixels, and the height in
160pixels. (The pixel size will only be valid in some environments.)
161
162I<NOTE>, under Windows, this function must be called with an B<output>
163filehandle, such as C<STDOUT>, or a handle opened to C<CONOUT$>.
164
165=item SetTerminalSize WIDTH,HEIGHT,XPIX,YPIX [, Filehandle]
166
167Return -1 on failure, 0 otherwise.
168
169I<NOTE> that this terminal size is only for B<informative> value, and
170changing the size via this mechanism will B<not> change the size of
171the screen. For example, XTerm uses a call like this when
172it resizes the screen. If any of the new measurements vary from the old, the
173OS will probably send a SIGWINCH signal to anything reading that tty or pty.
174
175B<This call does not work under Windows>.
176
177=item GetSpeed [, Filehandle]
178
179Returns either an empty array if the operation is unsupported, or a two
180value array containing the terminal in and out speeds, in B<decimal>. E.g,
181an 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
183identical in some OS's.
184
185B<No speeds are reported under Windows>.
186
187=item GetControlChars [, Filehandle]
188
189Returns an array containing key/value pairs suitable for a hash. The pairs
190consist of a key, the name of the control character/signal, and the value
191of that character, as a single character.
192
193B<This call does nothing under Windows>.
194
195Each 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
217Thus, the following will always return the current interrupt character,
218regardless of platform.
219
220 %keys = GetControlChars;
221 $int = $keys{INTERRUPT};
222
223=item SetControlChars [, Filehandle]
224
225Takes an array containing key/value pairs, as a hash will produce. The pairs
226should consist of a key that is the name of a legal control
227character/signal, and the value should be either a single character, or a
228number in the range 0-255. SetControlChars will die with a runtime error if
229an invalid character name is passed or there is an error changing the
230settings. The list of valid names is easily available via
231
232 %cchars = GetControlChars();
233 @cnames = keys %cchars;
234
235B<This call does nothing under Windows>.
236
237=back
238
239=head1 AUTHOR
240
241Kenneth Albanowski <kjahds@kjahds.com>
242
243Currently maintained by Jonathan Stowe <jns@gellyfish.co.uk>
244
245=head1 SUPPORT
246
247The code is maintained at
248
249 https://github.com/jonathanstowe/TermReadKey
250
251Please feel free to fork and suggest patches.
252
253
254=head1 LICENSE
255
256Prior 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
264And was only stated in the README file.
265
266Because I believe the original author's intent was to be more open than the
267other commonly used licenses I would like to leave that in place. However if
268you or your lawyers require something with some more words you can optionally
269choose 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
2832100µs2208µs
# spent 117µs (26+91) within Term::ReadKey::BEGIN@283 which was called: # once (26µs+91µs) by Mail::SpamAssassin::Util::Progress::BEGIN@52 at line 283
use vars qw($VERSION);
# spent 117µs making 1 call to Term::ReadKey::BEGIN@283 # spent 91µs making 1 call to vars::import
284
28512µs$VERSION = '2.37';
286
28719µsrequire Exporter;
28812µsrequire DynaLoader;
289
2902176µs2339µs
# spent 182µs (26+156) within Term::ReadKey::BEGIN@290 which was called: # once (26µs+156µs) by Mail::SpamAssassin::Util::Progress::BEGIN@52 at line 290
use vars qw(@ISA @EXPORT_OK @EXPORT);
# spent 182µs making 1 call to Term::ReadKey::BEGIN@290 # spent 156µs making 1 call to vars::import
291
292118µs@ISA = qw(Exporter DynaLoader);
293
294# Items to export into callers namespace by default
295# (move infrequently used names to @EXPORT_OK below)
296
29714µs@EXPORT = qw(
298 ReadKey
299 ReadMode
300 ReadLine
301 GetTerminalSize
302 SetTerminalSize
303 GetSpeed
304 GetControlChars
305 SetControlChars
306);
307
30812µs@EXPORT_OK = qw();
309
310122µs1656µsbootstrap Term::ReadKey;
# spent 656µs making 1 call to DynaLoader::bootstrap
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
3172496µs2457µs
# spent 244µs (30+214) within Term::ReadKey::BEGIN@317 which was called: # once (30µs+214µs) by Mail::SpamAssassin::Util::Progress::BEGIN@52 at line 317
use vars qw($UseEnv $CurrentMode %modes);
# spent 244µs making 1 call to Term::ReadKey::BEGIN@317 # spent 214µs making 1 call to vars::import
318
31912µs$UseEnv = 1;
320
32112µs$CurrentMode = 0;
322
323120µs%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
334sub croak { require Carp; goto &Carp::croak; }
335sub carp { require Carp; goto &Carp::carp; }
336
337sub ReadMode
338{
339 my $mode = $modes{ lc $_[0] }; # lowercase is canonical
340 my $fh = normalizehandle( ( @_ > 1 ? $_[1] : \*STDIN ) );
341
342 if ( defined($mode) ) { $CurrentMode = $mode }
343 elsif ( $_[0] =~ /^\d/ ) { $CurrentMode = $_[0] }
344 else { croak("Unknown terminal mode `$_[0]'"); }
345
346 SetReadMode($CurrentMode, $fh);
347}
348
349sub normalizehandle
350{
351 my ($file) = @_; # allows fake signature optimization
352
35321.65ms260µs
# spent 42µs (24+18) within Term::ReadKey::BEGIN@353 which was called: # once (24µs+18µs) by Mail::SpamAssassin::Util::Progress::BEGIN@52 at line 353
no strict;
# spent 42µs making 1 call to Term::ReadKey::BEGIN@353 # spent 18µs making 1 call to strict::unimport
354 # print "Handle = $file\n";
355 if ( ref($file) ) { return $file; } # Reference is fine
356
357 # if ($file =~ /^\*/) { return $file; } # Type glob is good
358 if ( ref( \$file ) eq 'GLOB' ) { return $file; } # Glob is good
359
360 # print "Caller = ",(caller(1))[0],"\n";
361 return \*{ ( ( caller(1) )[0] ) . "::$file" };
362}
363
364sub GetTerminalSize
365{
366 my $file = normalizehandle( ( @_ > 0 ? $_[0] : \*STDOUT ) );
367
368 my (@results, @fail);
369
370 if ( &termsizeoptions() & 1 ) # VIO
371 {
372 @results = GetTermSizeVIO($file);
373 push( @fail, "VIOGetMode call" );
374 }
375 elsif ( &termsizeoptions() & 2 ) # GWINSZ
376 {
377 @results = GetTermSizeGWINSZ($file);
378 push( @fail, "TIOCGWINSZ ioctl" );
379 }
380 elsif ( &termsizeoptions() & 4 ) # GSIZE
381 {
382 @results = GetTermSizeGSIZE($file);
383 push( @fail, "TIOCGSIZE ioctl" );
384 }
385 elsif ( &termsizeoptions() & 8 ) # WIN32
386 {
387 @results = GetTermSizeWin32($file);
388 push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
389 }
390 else
391 {
392 @results = ();
393 }
394
395 if ( @results < 4 and $UseEnv )
396 {
397 my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
398 my ($L) = defined( $ENV{LINES} ) ? $ENV{LINES} : 0;
399 if ( ( $C >= 2 ) and ( $L >= 2 ) )
400 {
401 @results = ( $C + 0, $L + 0, 0, 0 );
402 }
403 push( @fail, "COLUMNS and LINES environment variables" );
404 }
405
406 if ( @results < 4 && $^O ne 'MSWin32')
407 {
408 my ($prog) = "resize";
409
410 # Workaround for Solaris path silliness
411 if ( -f "/usr/openwin/bin/resize" ) {
412 $prog = "/usr/openwin/bin/resize";
413 }
414
415 my ($resize) = scalar(`$prog 2>/dev/null`);
416 if (defined $resize
417 and ( $resize =~ /COLUMNS\s*=\s*(\d+)/
418 or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
419 )
420 {
421 $results[0] = $1;
422 if ( $resize =~ /LINES\s*=\s*(\d+)/
423 or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
424 {
425 $results[1] = $1;
426 @results[ 2, 3 ] = ( 0, 0 );
427 }
428 else
429 {
430 @results = ();
431 }
432 }
433 else
434 {
435 @results = ();
436 }
437 push( @fail, "resize program" );
438 }
439
440 if ( @results < 4 && $^O ne 'MSWin32' )
441 {
442 my ($prog) = "stty size";
443
444 my ($stty) = scalar(`$prog 2>/dev/null`);
445 if (defined $stty
446 and ( $stty =~ /(\d+) (\d+)/ )
447 )
448 {
449 $results[0] = $2;
450 $results[1] = $1;
451 @results[ 2, 3 ] = ( 0, 0 );
452 }
453 else
454 {
455 @results = ();
456 }
457 push( @fail, "stty program" );
458 }
459
460 if ( @results != 4 )
461 {
462 carp("Unable to get Terminal Size."
463 . join( "", map( " The $_ didn't work.", @fail ) ));
464 return undef;
465 }
466
467 @results;
468}
469
470# blockoptions:
471#nodelay
472#select
473sub ReadKey {
474 my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
475 if (defined $_[0] && $_[0] > 0) {
476 if ($_[0]) { return undef if &selectfile($File,$_[0]) == 0 }
477 }
478 if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1); }
479 my $value = getc $File;
480 if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0); }
481 $value;
482}
483sub ReadLine {
484 my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
485 if (defined $_[0] && $_[0] > 0) {
486 if ($_[0]) { return undef if &selectfile($File,$_[0]) == 0 }
487 }
488 if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1) };
489 my $value = scalar(<$File>);
490 if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0) };
491 $value;
492}
493129µs1;
494# ex: set ro:
 
# spent 87µs within Term::ReadKey::bootstrap which was called: # once (87µs+0s) by DynaLoader::bootstrap at line 210 of DynaLoader.pm
sub Term::ReadKey::bootstrap; # xsub