|
Packit |
910689 |
#! perl
|
|
Packit |
910689 |
|
|
Packit |
910689 |
package Term::ReadKey;
|
|
Packit |
910689 |
|
|
Packit |
910689 |
# This also needs to be adjusted in the generated code below
|
|
Packit |
910689 |
# and in the Makefile.PL
|
|
Packit |
910689 |
use vars qw($VERSION);
|
|
Packit |
910689 |
|
|
Packit |
910689 |
$VERSION = '2.37';
|
|
Packit |
910689 |
|
|
Packit |
910689 |
use Config;
|
|
Packit |
910689 |
use File::Basename qw(&basename &dirname);
|
|
Packit |
910689 |
use File::Spec;
|
|
Packit |
910689 |
use Cwd;
|
|
Packit |
910689 |
|
|
Packit |
910689 |
# List explicitly here the variables you want Configure to
|
|
Packit |
910689 |
# generate. Metaconfig only looks for shell variables, so you
|
|
Packit |
910689 |
# have to mention them as if they were shell variables, not
|
|
Packit |
910689 |
# %Config entries. Thus you write
|
|
Packit |
910689 |
# $startperl
|
|
Packit |
910689 |
# to ensure Configure will look for $Config{startperl}.
|
|
Packit |
910689 |
# Wanted: $archlibexp
|
|
Packit |
910689 |
|
|
Packit |
910689 |
# This forces PL files to create target in same directory as PL file.
|
|
Packit |
910689 |
# This is so that make depend always knows where to find PL derivatives.
|
|
Packit |
910689 |
my $origdir = cwd;
|
|
Packit |
910689 |
my $dir = dirname($0);
|
|
Packit |
910689 |
chdir $dir;
|
|
Packit |
910689 |
my $file = 'ReadKey.pm';
|
|
Packit |
910689 |
|
|
Packit |
910689 |
open OUT, ">", $file or die "Can't create $file: $!";
|
|
Packit |
910689 |
|
|
Packit |
910689 |
print "Creating $file\n";
|
|
Packit |
910689 |
|
|
Packit |
910689 |
print OUT <<'!FIRSTPART';
|
|
Packit |
910689 |
# -*- buffer-read-only: t -*-
|
|
Packit |
910689 |
#
|
|
Packit |
910689 |
# This file is auto-generated. ***ANY*** changes here will be lost
|
|
Packit |
910689 |
#
|
|
Packit |
910689 |
package Term::ReadKey;
|
|
Packit |
910689 |
|
|
Packit |
910689 |
use strict;
|
|
Packit |
910689 |
use warnings;
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=head1 NAME
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Term::ReadKey - A perl module for simple terminal control
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=head1 SYNOPSIS
|
|
Packit |
910689 |
|
|
Packit |
910689 |
use Term::ReadKey;
|
|
Packit |
910689 |
ReadMode 4; # Turn off controls keys
|
|
Packit |
910689 |
while (not defined ($key = ReadKey(-1))) {
|
|
Packit |
910689 |
# No key yet
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
print "Get key $key\n";
|
|
Packit |
910689 |
ReadMode 0; # Reset tty mode before exiting
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=head1 DESCRIPTION
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Term::ReadKey is a compiled perl module dedicated to providing simple
|
|
Packit |
910689 |
control over terminal driver modes (cbreak, raw, cooked, etc.,) support for
|
|
Packit |
910689 |
non-blocking reads, if the architecture allows, and some generalized handy
|
|
Packit |
910689 |
functions for working with terminals. One of the main goals is to have the
|
|
Packit |
910689 |
functions as portable as possible, so you can just plug in "use
|
|
Packit |
910689 |
Term::ReadKey" on any architecture and have a good likelihood of it working.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Version 2.30.01:
|
|
Packit |
910689 |
Added handling of arrows, page up/down, home/end, insert/delete keys
|
|
Packit |
910689 |
under Win32. These keys emit xterm-compatible sequences.
|
|
Packit |
910689 |
Works with Term::ReadLine::Perl.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=over 4
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=item ReadMode MODE [, Filehandle]
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Takes an integer argument or a string synonym (case insensitive), which
|
|
Packit |
910689 |
can currently be one of the following values:
|
|
Packit |
910689 |
|
|
Packit |
910689 |
INT SYNONYM DESCRIPTION
|
|
Packit |
910689 |
|
|
Packit |
910689 |
0 'restore' Restore original settings.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
1 'normal' Change to what is commonly the default mode,
|
|
Packit |
910689 |
echo on, buffered, signals enabled, Xon/Xoff
|
|
Packit |
910689 |
possibly enabled, and 8-bit mode possibly disabled.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
2 'noecho' Same as 1, just with echo off. Nice for
|
|
Packit |
910689 |
reading passwords.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
3 'cbreak' Echo off, unbuffered, signals enabled, Xon/Xoff
|
|
Packit |
910689 |
possibly enabled, and 8-bit mode possibly enabled.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
4 'raw' Echo off, unbuffered, signals disabled, Xon/Xoff
|
|
Packit |
910689 |
disabled, and 8-bit mode possibly disabled.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
5 'ultra-raw' Echo off, unbuffered, signals disabled, Xon/Xoff
|
|
Packit |
910689 |
disabled, 8-bit mode enabled if parity permits,
|
|
Packit |
910689 |
and CR to CR/LF translation turned off.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
|
|
Packit |
910689 |
These functions are automatically applied to the STDIN handle if no
|
|
Packit |
910689 |
other handle is supplied. Modes 0 and 5 have some special properties
|
|
Packit |
910689 |
worth mentioning: not only will mode 0 restore original settings, but it
|
|
Packit |
910689 |
cause the next ReadMode call to save a new set of default settings. Mode
|
|
Packit |
910689 |
5 is similar to mode 4, except no CR/LF translation is performed, and if
|
|
Packit |
910689 |
possible, parity will be disabled (only if not being used by the terminal,
|
|
Packit |
910689 |
however. It is no different from mode 4 under Windows.)
|
|
Packit |
910689 |
|
|
Packit |
910689 |
If you just need to read a key at a time, then modes 3 or 4 are probably
|
|
Packit |
910689 |
sufficient. Mode 4 is a tad more flexible, but needs a bit more work to
|
|
Packit |
910689 |
control. If you use ReadMode 3, then you should install a SIGINT or END
|
|
Packit |
910689 |
handler to reset the terminal (via ReadMode 0) if the user aborts the
|
|
Packit |
910689 |
program via C<^C>. (For any mode, an END handler consisting of "ReadMode 0"
|
|
Packit |
910689 |
is actually a good idea.)
|
|
Packit |
910689 |
|
|
Packit |
910689 |
If you are executing another program that may be changing the terminal mode,
|
|
Packit |
910689 |
you will either want to say
|
|
Packit |
910689 |
|
|
Packit |
910689 |
ReadMode 1; # same as ReadMode 'normal'
|
|
Packit |
910689 |
system('someprogram');
|
|
Packit |
910689 |
ReadMode 1;
|
|
Packit |
910689 |
|
|
Packit |
910689 |
which resets the settings after the program has run, or:
|
|
Packit |
910689 |
|
|
Packit |
910689 |
$somemode=1;
|
|
Packit |
910689 |
ReadMode 0; # same as ReadMode 'restore'
|
|
Packit |
910689 |
system('someprogram');
|
|
Packit |
910689 |
ReadMode 1;
|
|
Packit |
910689 |
|
|
Packit |
910689 |
which records any changes the program may have made, before resetting the
|
|
Packit |
910689 |
mode.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=item ReadKey MODE [, Filehandle]
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Takes an integer argument, which can currently be one of the following
|
|
Packit |
910689 |
values:
|
|
Packit |
910689 |
|
|
Packit |
910689 |
0 Perform a normal read using getc
|
|
Packit |
910689 |
-1 Perform a non-blocked read
|
|
Packit |
910689 |
>0 Perform a timed read
|
|
Packit |
910689 |
|
|
Packit |
910689 |
If the filehandle is not supplied, it will default to STDIN. If there is
|
|
Packit |
910689 |
nothing waiting in the buffer during a non-blocked read, then undef will be
|
|
Packit |
910689 |
returned. In most situations, you will probably want to use C<ReadKey -1>.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
I<NOTE> that if the OS does not provide any known mechanism for non-blocking
|
|
Packit |
910689 |
reads, then a C<ReadKey -1> can die with a fatal error. This will hopefully
|
|
Packit |
910689 |
not be common.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
If MODE is greater then zero, then ReadKey will use it as a timeout value in
|
|
Packit |
910689 |
seconds (fractional seconds are allowed), and won't return C<undef> until
|
|
Packit |
910689 |
that time expires.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
I<NOTE>, again, that some OS's may not support this timeout behaviour.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
If MODE is less then zero, then this is treated as a timeout
|
|
Packit |
910689 |
of zero, and thus will return immediately if no character is waiting. A MODE
|
|
Packit |
910689 |
of zero, however, will act like a normal getc.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
I<NOTE>, there are currently some limitations with this call under Windows.
|
|
Packit |
910689 |
It may be possible that non-blocking reads will fail when reading repeating
|
|
Packit |
910689 |
keys from more then one console.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=item ReadLine MODE [, Filehandle]
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Takes an integer argument, which can currently be one of the following
|
|
Packit |
910689 |
values:
|
|
Packit |
910689 |
|
|
Packit |
910689 |
0 Perform a normal read using scalar(<FileHandle>)
|
|
Packit |
910689 |
-1 Perform a non-blocked read
|
|
Packit |
910689 |
>0 Perform a timed read
|
|
Packit |
910689 |
|
|
Packit |
910689 |
If there is nothing waiting in the buffer during a non-blocked read, then
|
|
Packit |
910689 |
undef will be returned.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
I<NOTE>, that if the OS does not provide any known mechanism for
|
|
Packit |
910689 |
non-blocking reads, then a C<ReadLine 1> can die with a fatal
|
|
Packit |
910689 |
error. This will hopefully not be common.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
I<NOTE> that a non-blocking test is only performed for the first character
|
|
Packit |
910689 |
in the line, not the entire line. This call will probably B<not> do what
|
|
Packit |
910689 |
you assume, especially with C<ReadMode> MODE values higher then 1. For
|
|
Packit |
910689 |
example, pressing Space and then Backspace would appear to leave you
|
|
Packit |
910689 |
where you started, but any timeouts would now be suspended.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
B<This call is currently not available under Windows>.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=item GetTerminalSize [Filehandle]
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Returns either an empty array if this operation is unsupported, or a four
|
|
Packit |
910689 |
element array containing: the width of the terminal in characters, the
|
|
Packit |
910689 |
height of the terminal in character, the width in pixels, and the height in
|
|
Packit |
910689 |
pixels. (The pixel size will only be valid in some environments.)
|
|
Packit |
910689 |
|
|
Packit |
910689 |
I<NOTE>, under Windows, this function must be called with an B<output>
|
|
Packit |
910689 |
filehandle, such as C<STDOUT>, or a handle opened to C<CONOUT$>.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=item SetTerminalSize WIDTH,HEIGHT,XPIX,YPIX [, Filehandle]
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Return -1 on failure, 0 otherwise.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
I<NOTE> that this terminal size is only for B<informative> value, and
|
|
Packit |
910689 |
changing the size via this mechanism will B<not> change the size of
|
|
Packit |
910689 |
the screen. For example, XTerm uses a call like this when
|
|
Packit |
910689 |
it resizes the screen. If any of the new measurements vary from the old, the
|
|
Packit |
910689 |
OS will probably send a SIGWINCH signal to anything reading that tty or pty.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
B<This call does not work under Windows>.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=item GetSpeed [, Filehandle]
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Returns either an empty array if the operation is unsupported, or a two
|
|
Packit |
910689 |
value array containing the terminal in and out speeds, in B<decimal>. E.g,
|
|
Packit |
910689 |
an in speed of 9600 baud and an out speed of 4800 baud would be returned as
|
|
Packit |
910689 |
(9600,4800). Note that currently the in and out speeds will always be
|
|
Packit |
910689 |
identical in some OS's.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
B<No speeds are reported under Windows>.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=item GetControlChars [, Filehandle]
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Returns an array containing key/value pairs suitable for a hash. The pairs
|
|
Packit |
910689 |
consist of a key, the name of the control character/signal, and the value
|
|
Packit |
910689 |
of that character, as a single character.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
B<This call does nothing under Windows>.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Each key will be an entry from the following list:
|
|
Packit |
910689 |
|
|
Packit |
910689 |
DISCARD
|
|
Packit |
910689 |
DSUSPEND
|
|
Packit |
910689 |
EOF
|
|
Packit |
910689 |
EOL
|
|
Packit |
910689 |
EOL2
|
|
Packit |
910689 |
ERASE
|
|
Packit |
910689 |
ERASEWORD
|
|
Packit |
910689 |
INTERRUPT
|
|
Packit |
910689 |
KILL
|
|
Packit |
910689 |
MIN
|
|
Packit |
910689 |
QUIT
|
|
Packit |
910689 |
QUOTENEXT
|
|
Packit |
910689 |
REPRINT
|
|
Packit |
910689 |
START
|
|
Packit |
910689 |
STATUS
|
|
Packit |
910689 |
STOP
|
|
Packit |
910689 |
SUSPEND
|
|
Packit |
910689 |
SWITCH
|
|
Packit |
910689 |
TIME
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Thus, the following will always return the current interrupt character,
|
|
Packit |
910689 |
regardless of platform.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
%keys = GetControlChars;
|
|
Packit |
910689 |
$int = $keys{INTERRUPT};
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=item SetControlChars [, Filehandle]
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Takes an array containing key/value pairs, as a hash will produce. The pairs
|
|
Packit |
910689 |
should consist of a key that is the name of a legal control
|
|
Packit |
910689 |
character/signal, and the value should be either a single character, or a
|
|
Packit |
910689 |
number in the range 0-255. SetControlChars will die with a runtime error if
|
|
Packit |
910689 |
an invalid character name is passed or there is an error changing the
|
|
Packit |
910689 |
settings. The list of valid names is easily available via
|
|
Packit |
910689 |
|
|
Packit |
910689 |
%cchars = GetControlChars();
|
|
Packit |
910689 |
@cnames = keys %cchars;
|
|
Packit |
910689 |
|
|
Packit |
910689 |
B<This call does nothing under Windows>.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=back
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=head1 AUTHOR
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Kenneth Albanowski <kjahds@kjahds.com>
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Currently maintained by Jonathan Stowe <jns@gellyfish.co.uk>
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=head1 SUPPORT
|
|
Packit |
910689 |
|
|
Packit |
910689 |
The code is maintained at
|
|
Packit |
910689 |
|
|
Packit |
910689 |
https://github.com/jonathanstowe/TermReadKey
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Please feel free to fork and suggest patches.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=head1 LICENSE
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Prior to the 2.31 release the license statement was:
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Copyright (C) 1994-1999 Kenneth Albanowski.
|
|
Packit |
910689 |
2001-2005 Jonathan Stowe and others
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Unlimited distribution and/or modification is allowed as long as this
|
|
Packit |
910689 |
copyright notice remains intact.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
And was only stated in the README file.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
Because I believe the original author's intent was to be more open than the
|
|
Packit |
910689 |
other commonly used licenses I would like to leave that in place. However if
|
|
Packit |
910689 |
you or your lawyers require something with some more words you can optionally
|
|
Packit |
910689 |
choose to license this under the standard Perl license:
|
|
Packit |
910689 |
|
|
Packit |
910689 |
This module is free software; you can redistribute it and/or modify it
|
|
Packit |
910689 |
under the terms of the Artistic License. For details, see the full
|
|
Packit |
910689 |
text of the license in the file "Artistic" that should have been provided
|
|
Packit |
910689 |
with the version of perl you are using.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
This program is distributed in the hope that it will be useful, but
|
|
Packit |
910689 |
without any warranty; without even the implied warranty of merchantability
|
|
Packit |
910689 |
or fitness for a particular purpose.
|
|
Packit |
910689 |
|
|
Packit |
910689 |
|
|
Packit |
910689 |
=cut
|
|
Packit |
910689 |
|
|
Packit |
910689 |
use vars qw($VERSION);
|
|
Packit |
910689 |
|
|
Packit |
910689 |
$VERSION = '2.37';
|
|
Packit |
910689 |
|
|
Packit |
910689 |
require Exporter;
|
|
Packit |
910689 |
require DynaLoader;
|
|
Packit |
910689 |
|
|
Packit |
910689 |
use vars qw(@ISA @EXPORT_OK @EXPORT);
|
|
Packit |
910689 |
|
|
Packit |
910689 |
@ISA = qw(Exporter DynaLoader);
|
|
Packit |
910689 |
|
|
Packit |
910689 |
# Items to export into callers namespace by default
|
|
Packit |
910689 |
# (move infrequently used names to @EXPORT_OK below)
|
|
Packit |
910689 |
|
|
Packit |
910689 |
@EXPORT = qw(
|
|
Packit |
910689 |
ReadKey
|
|
Packit |
910689 |
ReadMode
|
|
Packit |
910689 |
ReadLine
|
|
Packit |
910689 |
GetTerminalSize
|
|
Packit |
910689 |
SetTerminalSize
|
|
Packit |
910689 |
GetSpeed
|
|
Packit |
910689 |
GetControlChars
|
|
Packit |
910689 |
SetControlChars
|
|
Packit |
910689 |
);
|
|
Packit |
910689 |
|
|
Packit |
910689 |
@EXPORT_OK = qw();
|
|
Packit |
910689 |
|
|
Packit |
910689 |
bootstrap Term::ReadKey;
|
|
Packit |
910689 |
|
|
Packit |
910689 |
# Should we use LINES and COLUMNS to try and get the terminal size?
|
|
Packit |
910689 |
# Change this to zero if you have systems where these are commonly
|
|
Packit |
910689 |
# set to erroneous values. (But if either are near zero, they won't be
|
|
Packit |
910689 |
# used anyhow.)
|
|
Packit |
910689 |
|
|
Packit |
910689 |
use vars qw($UseEnv $CurrentMode %modes);
|
|
Packit |
910689 |
|
|
Packit |
910689 |
$UseEnv = 1;
|
|
Packit |
910689 |
|
|
Packit |
910689 |
$CurrentMode = 0;
|
|
Packit |
910689 |
|
|
Packit |
910689 |
%modes = ( # lowercase is canonical
|
|
Packit |
910689 |
original => 0,
|
|
Packit |
910689 |
restore => 0,
|
|
Packit |
910689 |
normal => 1,
|
|
Packit |
910689 |
noecho => 2,
|
|
Packit |
910689 |
cbreak => 3,
|
|
Packit |
910689 |
raw => 4,
|
|
Packit |
910689 |
'ultra-raw' => 5
|
|
Packit |
910689 |
);
|
|
Packit |
910689 |
|
|
Packit |
910689 |
# reduce Carp memory footprint, only load when needed
|
|
Packit |
910689 |
sub croak { require Carp; goto &Carp::croak; }
|
|
Packit |
910689 |
sub carp { require Carp; goto &Carp::carp; }
|
|
Packit |
910689 |
|
|
Packit |
910689 |
sub ReadMode
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
my $mode = $modes{ lc $_[0] }; # lowercase is canonical
|
|
Packit |
910689 |
my $fh = normalizehandle( ( @_ > 1 ? $_[1] : \*STDIN ) );
|
|
Packit |
910689 |
|
|
Packit |
910689 |
if ( defined($mode) ) { $CurrentMode = $mode }
|
|
Packit |
910689 |
elsif ( $_[0] =~ /^\d/ ) { $CurrentMode = $_[0] }
|
|
Packit |
910689 |
else { croak("Unknown terminal mode `$_[0]'"); }
|
|
Packit |
910689 |
|
|
Packit |
910689 |
SetReadMode($CurrentMode, $fh);
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
|
|
Packit |
910689 |
sub normalizehandle
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
my ($file) = @_; # allows fake signature optimization
|
|
Packit |
910689 |
|
|
Packit |
910689 |
no strict;
|
|
Packit |
910689 |
# print "Handle = $file\n";
|
|
Packit |
910689 |
if ( ref($file) ) { return $file; } # Reference is fine
|
|
Packit |
910689 |
|
|
Packit |
910689 |
# if ($file =~ /^\*/) { return $file; } # Type glob is good
|
|
Packit |
910689 |
if ( ref( \$file ) eq 'GLOB' ) { return $file; } # Glob is good
|
|
Packit |
910689 |
|
|
Packit |
910689 |
# print "Caller = ",(caller(1))[0],"\n";
|
|
Packit |
910689 |
return \*{ ( ( caller(1) )[0] ) . "::$file" };
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
|
|
Packit |
910689 |
sub GetTerminalSize
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
my $file = normalizehandle( ( @_ > 0 ? $_[0] : \*STDOUT ) );
|
|
Packit |
910689 |
|
|
Packit |
910689 |
my (@results, @fail);
|
|
Packit |
910689 |
|
|
Packit |
910689 |
if ( &termsizeoptions() & 1 ) # VIO
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
@results = GetTermSizeVIO($file);
|
|
Packit |
910689 |
push( @fail, "VIOGetMode call" );
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
elsif ( &termsizeoptions() & 2 ) # GWINSZ
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
@results = GetTermSizeGWINSZ($file);
|
|
Packit |
910689 |
push( @fail, "TIOCGWINSZ ioctl" );
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
elsif ( &termsizeoptions() & 4 ) # GSIZE
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
@results = GetTermSizeGSIZE($file);
|
|
Packit |
910689 |
push( @fail, "TIOCGSIZE ioctl" );
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
elsif ( &termsizeoptions() & 8 ) # WIN32
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
@results = GetTermSizeWin32($file);
|
|
Packit |
910689 |
push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
else
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
@results = ();
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
|
|
Packit |
910689 |
if ( @results < 4 and $UseEnv )
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
|
|
Packit |
910689 |
my ($L) = defined( $ENV{LINES} ) ? $ENV{LINES} : 0;
|
|
Packit |
910689 |
if ( ( $C >= 2 ) and ( $L >= 2 ) )
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
@results = ( $C + 0, $L + 0, 0, 0 );
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
push( @fail, "COLUMNS and LINES environment variables" );
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
|
|
Packit |
910689 |
if ( @results < 4 && $^O ne 'MSWin32')
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
my ($prog) = "resize";
|
|
Packit |
910689 |
|
|
Packit |
910689 |
# Workaround for Solaris path silliness
|
|
Packit |
910689 |
if ( -f "/usr/openwin/bin/resize" ) {
|
|
Packit |
910689 |
$prog = "/usr/openwin/bin/resize";
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
|
|
Packit |
910689 |
my ($resize) = scalar(`$prog 2>/dev/null`);
|
|
Packit |
910689 |
if (defined $resize
|
|
Packit |
910689 |
and ( $resize =~ /COLUMNS\s*=\s*(\d+)/
|
|
Packit |
910689 |
or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
|
|
Packit |
910689 |
)
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
$results[0] = $1;
|
|
Packit |
910689 |
if ( $resize =~ /LINES\s*=\s*(\d+)/
|
|
Packit |
910689 |
or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
$results[1] = $1;
|
|
Packit |
910689 |
@results[ 2, 3 ] = ( 0, 0 );
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
else
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
@results = ();
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
else
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
@results = ();
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
push( @fail, "resize program" );
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
|
|
Packit |
910689 |
if ( @results < 4 && $^O ne 'MSWin32' )
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
my ($prog) = "stty size";
|
|
Packit |
910689 |
|
|
Packit |
910689 |
my ($stty) = scalar(`$prog 2>/dev/null`);
|
|
Packit |
910689 |
if (defined $stty
|
|
Packit |
910689 |
and ( $stty =~ /(\d+) (\d+)/ )
|
|
Packit |
910689 |
)
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
$results[0] = $2;
|
|
Packit |
910689 |
$results[1] = $1;
|
|
Packit |
910689 |
@results[ 2, 3 ] = ( 0, 0 );
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
else
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
@results = ();
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
push( @fail, "stty program" );
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
|
|
Packit |
910689 |
if ( @results != 4 )
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
carp("Unable to get Terminal Size."
|
|
Packit |
910689 |
. join( "", map( " The $_ didn't work.", @fail ) ));
|
|
Packit |
910689 |
return undef;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
|
|
Packit |
910689 |
@results;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
|
|
Packit |
910689 |
!FIRSTPART
|
|
Packit |
910689 |
|
|
Packit |
910689 |
close OUT;
|
|
Packit |
910689 |
# preload the XS module needed for the blockoptions() expansions below
|
|
Packit |
910689 |
# does not work with miniperl
|
|
Packit |
910689 |
package Term::ReadKey;
|
|
Packit |
910689 |
require DynaLoader;
|
|
Packit |
910689 |
our @ISA = qw(DynaLoader);
|
|
Packit |
910689 |
|
|
Packit |
910689 |
print "Bootstrapping the XS for blockoptions: ";
|
|
Packit |
910689 |
bootstrap Term::ReadKey or die;
|
|
Packit |
910689 |
print blockoptions()."\n";
|
|
Packit |
910689 |
|
|
Packit |
910689 |
open OUT, ">>", $file or die "Can't append to $file: $!";
|
|
Packit |
910689 |
print OUT "# blockoptions: \n";
|
|
Packit |
910689 |
if ( &blockoptions() & 1 ) # Use nodelay
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
print OUT "#nodelay\n";
|
|
Packit |
910689 |
if ( &blockoptions() & 2 ) #poll
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
print OUT <<'!NO!SUBS!';
|
|
Packit |
910689 |
# poll
|
|
Packit |
910689 |
sub ReadKey {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] > 0) {
|
|
Packit |
910689 |
if ($_[0]) {
|
|
Packit |
910689 |
return undef if &pollfile($File,$_[0]) == 0;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1); }
|
|
Packit |
910689 |
my $value = getc $File;
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0); }
|
|
Packit |
910689 |
$value;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
sub ReadLine {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] > 0) {
|
|
Packit |
910689 |
if ($_[0]) {
|
|
Packit |
910689 |
return undef if &pollfile($File,$_[0]) == 0;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1) };
|
|
Packit |
910689 |
my $value = scalar(<$File>);
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0) };
|
|
Packit |
910689 |
$value;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
!NO!SUBS!
|
|
Packit |
910689 |
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
elsif ( &blockoptions() & 4 ) #select
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
print OUT <<'!NO!SUBS!';
|
|
Packit |
910689 |
#select
|
|
Packit |
910689 |
sub ReadKey {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] > 0) {
|
|
Packit |
910689 |
if ($_[0]) { return undef if &selectfile($File,$_[0]) == 0 }
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1); }
|
|
Packit |
910689 |
my $value = getc $File;
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0); }
|
|
Packit |
910689 |
$value;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
sub ReadLine {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] > 0) {
|
|
Packit |
910689 |
if ($_[0]) { return undef if &selectfile($File,$_[0]) == 0 }
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1) };
|
|
Packit |
910689 |
my $value = scalar(<$File>);
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0) };
|
|
Packit |
910689 |
$value;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
!NO!SUBS!
|
|
Packit |
910689 |
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
else
|
|
Packit |
910689 |
{ #nothing
|
|
Packit |
910689 |
print OUT <<'!NO!SUBS!';
|
|
Packit |
910689 |
sub ReadKey {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] > 0) {
|
|
Packit |
910689 |
# Nothing better seems to exist, so I just use time-of-day
|
|
Packit |
910689 |
# to timeout the read. This isn't very exact, though.
|
|
Packit |
910689 |
$starttime = time;
|
|
Packit |
910689 |
$endtime = $starttime + $_[0];
|
|
Packit |
910689 |
&setnodelay($File,1);
|
|
Packit |
910689 |
my $value;
|
|
Packit |
910689 |
while (time < $endtime) { # This won't catch wraparound!
|
|
Packit |
910689 |
$value = getc $File;
|
|
Packit |
910689 |
last if defined($value);
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
&setnodelay($File,0);
|
|
Packit |
910689 |
return $value;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1); }
|
|
Packit |
910689 |
my $value = getc $File;
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0); }
|
|
Packit |
910689 |
$value;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
sub ReadLine {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] > 0) {
|
|
Packit |
910689 |
# Nothing better seems to exist, so I just use time-of-day
|
|
Packit |
910689 |
# to timeout the read. This isn't very exact, though.
|
|
Packit |
910689 |
$starttime = time;
|
|
Packit |
910689 |
$endtime = $starttime + $_[0];
|
|
Packit |
910689 |
&setnodelay($File,1);
|
|
Packit |
910689 |
my $value;
|
|
Packit |
910689 |
while (time < $endtime) { # This won't catch wraparound!
|
|
Packit |
910689 |
$value = scalar(<$File>);
|
|
Packit |
910689 |
last if defined($value);
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
&setnodelay($File,0);
|
|
Packit |
910689 |
return $value;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1) };
|
|
Packit |
910689 |
my $value = scalar(<$File>);
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0) };
|
|
Packit |
910689 |
$value;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
!NO!SUBS!
|
|
Packit |
910689 |
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
else {
|
|
Packit |
910689 |
print OUT "#no nodelay\n";
|
|
Packit |
910689 |
|
|
Packit |
910689 |
if ( &blockoptions() & 2 ) # Use poll
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
print OUT <<'!NO!SUBS!';
|
|
Packit |
910689 |
#poll
|
|
Packit |
910689 |
sub ReadKey {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] != 0) {
|
|
Packit |
910689 |
return undef if &pollfile($File,$_[0]) == 0
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
getc $File;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
sub ReadLine {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] != 0 ) {
|
|
Packit |
910689 |
return undef if &pollfile($File,$_[0]) == 0;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
scalar(<$File>);
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
!NO!SUBS!
|
|
Packit |
910689 |
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
elsif ( &blockoptions() & 4 ) # Use select
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
print OUT <<'!NO!SUBS!';
|
|
Packit |
910689 |
#select
|
|
Packit |
910689 |
sub ReadKey {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] != 0) {
|
|
Packit |
910689 |
return undef if &selectfile($File,$_[0]) == 0
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
getc $File;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
sub ReadLine {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if (defined $_[0] && $_[0] != 0) {
|
|
Packit |
910689 |
return undef if &selectfile($File,$_[0]) == 0;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
scalar(<$File>);
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
!NO!SUBS!
|
|
Packit |
910689 |
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
elsif ( &blockoptions() & 8 ) # Use Win32
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
print OUT <<'!NO!SUBS!';
|
|
Packit |
910689 |
#Win32
|
|
Packit |
910689 |
sub ReadKey {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if ($_[0] || $CurrentMode >= 3) {
|
|
Packit |
910689 |
Win32PeekChar($File, $_[0]);
|
|
Packit |
910689 |
} else {
|
|
Packit |
910689 |
getc $File;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
#if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
|
|
Packit |
910689 |
#getc $File;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
sub ReadLine {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
#if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
|
|
Packit |
910689 |
#scalar(<$File>);
|
|
Packit |
910689 |
if ($_[0]) {
|
|
Packit |
910689 |
croak("Non-blocking ReadLine is not supported on this architecture")
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
scalar(<$File>);
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
!NO!SUBS!
|
|
Packit |
910689 |
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
else
|
|
Packit |
910689 |
{
|
|
Packit |
910689 |
print OUT <<'!NO!SUBS!';
|
|
Packit |
910689 |
sub ReadKey {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if ($_[0]) {
|
|
Packit |
910689 |
croak("Non-blocking ReadKey is not supported on this architecture")
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
getc $File;
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
sub ReadLine {
|
|
Packit |
910689 |
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
|
|
Packit |
910689 |
if ($_[0]) {
|
|
Packit |
910689 |
croak("Non-blocking ReadLine is not supported on this architecture")
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
scalar(<$File>);
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
!NO!SUBS!
|
|
Packit |
910689 |
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
}
|
|
Packit |
910689 |
|
|
Packit |
910689 |
print OUT <<'EOF';
|
|
Packit |
910689 |
1;
|
|
Packit |
910689 |
# ex: set ro:
|
|
Packit |
910689 |
EOF
|
|
Packit |
910689 |
|
|
Packit |
910689 |
close OUT;
|
|
Packit |
910689 |
if (-s $file < 1000) {
|
|
Packit |
910689 |
warn "WARNING: $file probably too small";
|
|
Packit |
910689 |
} else {
|
|
Packit |
910689 |
print "Done\n";
|
|
Packit |
910689 |
}
|