##################################################################### # # Compat::Term::ReadKey # ###################################################################### # # This file is part of GNU EPrints 2. # # Copyright (c) 2000-2004 University of Southampton, UK. SO17 1BJ. # # EPrints 2 is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # EPrints 2 is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with EPrints 2; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # ###################################################################### =pod =head1 NAME B<Compat::Term::ReadKey> - Compatibility module for Term::ReadKey. =head1 DESCRIPTION This module provides a compatibility module for L<Term::ReadKey>, in case the user can't install it. It will only change the terminal mode on a linux-compiled Perl. For full documentation of what these methods are supposed to do see L<Term::ReadKey>. =head1 SYNOPSIS require Compat::Term::ReadKey; print Term::ReadKey::GetTerminalSize( \*STDIN ), "\n"; =over 4 =cut package Term::ReadKey; use vars qw( @ISA @EXPORT ); use Exporter; @ISA = qw( Exporter ); @EXPORT = qw( ReadMode ReadKey ReadLine GetTerminalSize ); use vars qw( $STTY_NORMAL $STTY_RESTORE ); # Fetch the tty settings sub _fetch_tty { my $c = `stty -g`; chomp($c); return $c; } =item ReadMode MODE [, Filehandle] Change the reading mode on the console (support for linux/stty only!). =cut sub ReadMode { my( $mode, $fh ) = @_; $fh ||= \*STDIN; return unless $^O eq 'linux'; if( !defined $STTY_NORMAL ) { $STTY_NORMAL = $STTY_RESTORE = &_fetch_tty; } if( $mode eq 'restore' or $mode eq '0' ) { system "stty", $STTY_RESTORE; } if( $mode eq 'normal' or $mode eq '1' ) { system "stty", $STTY_NORMAL; } if( $mode eq 'noecho' or $mode eq '2' ) { $STTY_RESTORE = &_fetch_tty; system "stty", "-echo"; } if( $mode eq 'raw' or $mode eq '4' ) { $STTY_RESTORE = &_fetch_tty; system "stty", "-icanon", "eol", "\001"; } if( $mode eq 'ultra-raw' or $mode eq '5' ) { $STTY_RESTORE = &_fetch_tty; system "stty", "-icanon", "eol", "\001"; } } # Read from console sub _read { my( $mode, $fh, $f ) = @_; $fh ||= \*STDIN; if( $mode == -1 ) { ReadMode( 'raw' ); my $r = &$f( $fh ); ReadMode( 'restore' ); return $r; } elsif( $mode > 0 ) { my $r; eval { local $SIG{ALRM} = sub { die "alarm\n" }; alarm $mode; $r = &$f($fh); alarm 0; }; if( $@ ) { die unless $@ eq "alarm\n"; } return $r; } return &$f($fh); } =item ReadKey MODE [, Filehandle] Read a single character from the console. =cut sub ReadKey { my( $mode, $fh ) = @_; return _read( $mode, $fh, sub { getc(shift) }); } =item ReadLine MODE [, Filehandle] Read and return a line of input from the console. =cut sub ReadLine { my( $mode, $fh ) = @_; return _read( $mode, $fh, sub { my $fh = shift; return <$fh> }); } =item GetTerminalSize [Filehandle] Hard-coded as 80. =cut sub GetTerminalSize { 80 } 1; __END__ =back