Article 10259 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:10259
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.ecn.bgu.edu!psuvax1!uwm.edu!cs.utexas.edu!swrinde!sgiblab!munnari.oz.au!newsroom.utas.edu.au!ml.csiro.au!solaris!jstander
From: jstander@ml.csiro.au (Jeff Stander)
Subject: Re: Interactive scripts (cbreak, flushing STDI
Message-ID: <1994Jan28.060855.5923@ml.csiro.au>
Sender: news@ml.csiro.au
Reply-To: jstander@ml.csiro.au
Organization: CSIRO Marine Laboratories
References: <2hp9q5$t4i@gramps.itd.com>
Date: Fri, 28 Jan 1994 06:08:55 GMT
Lines: 414

In article t4i@gramps.itd.com, jblaine@ma.itd.com (Jeff Blaine) writes:
>The problem:
>------------
>
>I need input from an interactive user.  The user picks a number from
>a menu (1-15) and types it in.  Great.  Except that the terminal
>is doing buffering and it doesn't work properly.
>

Jeff

I have had the same problem and wrote some interactive subs
to handle it.  I'll attach them to this letter.  I don't gurantee
anything here and do not consider myself a Perl "guru".  
Let me know if they are of help and if they work.

Jeff Stander

___________________________________________________________________________

Jeff.Stander@ml.csiro.au        _--_|\        Database Analyst
CSIRO Division Of Fisheries    /      \       Pelagic Fisheries Resources
GPO Box 1538, Hobart           \_.--._/       Tasmania 7001, Australia
Aus Tel: 002-325-332                 v        Intl Tel: +61-02-325-332
Aus Fax: 002-325-000                          Intl Fax: +61-02-325-000
___________________________________________________________________________

#!/bin/sh
# This is a shell archive (produced by shar 3.50)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 01/28/1994 06:05 UTC by tuna@deep
# Source directory /a/aqueous/tuna/jstander/lib/perl
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   6445 -rwxrwxr-x keypress.pl
#   3734 -rwxrwx--x selection.pl
#
# ============= keypress.pl ==============
if test -f 'keypress.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping keypress.pl (File already exists)'
else
echo 'x - extracting keypress.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'keypress.pl' &&
#! /usr/local/bin/perl 
# @(#) keypress : subroutine to read one character from keyboard
# @(#) SunOS deep sun4m (jstander)  
# @(#) loc: /home/tuna/bin
# @(#) $Revision 1.0 $ (jstander 07.12.93): new 
###############################################################################
# Subroutine: 	keypress - perl function to read one charaacter from keyboard
#
# Synopsis 	&keypress([options],["message"])
X
# Description   Read one character from keyboard and return value, optionally 
#		suppressing echo and allow setting of default values
#
# Options
#	noecho		suppress echoing of input character
#       nobell          turn of bell
#       bell            turn on bell
#	fold		if the first argument is "fold" then select
#			characters are all folded to lower case
#			for testing against user entry. I.e. user 
#			entry is case-insensitive.  This is the default.
#	nofold		if the first argument is "nofold" then select
#			characters are NOT folded to lower case.
#			I.e. the user entry is case senstive.
#	"c"		a single character to be taken as default if <CR> is
#			pressed.  Note that this may have to be enclosed in quotes.
#	"[pattern]"	a regular expression character set to match, e.g. "[YNQ]"
#			If a default character was specified, <CR> is implied as
#			a selection character.
#	t=n		Set wait time in seconds before default is taken.
#			If n seconds elapse, the default character is 
#			returned, or if no default, undef is returned.
# Arguments
#	"message"	Message to user printed before 
#
# Returns:		The value of the pressed key.  Note that if fold
#			is enabled (the default) that pressing an upper or
#			lowercase key still returns the matched key, e.g.
#			pressing "y" or "Y" returns a "Y" if the pattern was
#			"[YN]".   Pressing "y" or "Y" if the pattern was
#			"[yn]" returns a "y".  If the pattern was "[yYnN]"
#			then the pressed key is returned.
# Environment
#	KEYPRESS_WAITTIME	sets default waittime 
#	KEYPRESS_NOBELL    	if present, don't ring bell when querying user
#       KEYPRESS_BG             if present, set background mode - don't query user
#                               and take default response.
# Author
#	Jeff.Stander@ml.csiro.au CSIRO Division Of Fisheries, Hobart,
#	Tasmania 7001, Australia
###############################################################################
# Subroutine: 	no/yes - perl functions to read "y" or "n" from keyboard 
#
# Synopsis:	&no([options],["message"])	- default if <CR> is pressed is "n"
#		&yes([options],["message"])	- default if <CR> is pressed is "y"
#
# Description:  Read a "y" or "n" keyboard and return value, optionally 
#		suppressing echo.  Only <CR>, y, Y, n, N are accepted. 
#		and upper case characters are folded to lower
#
# Options:	{options}	same as for &keypress
#
# Arguments:	"message"	Message to user printed before 
#
# Returns:	True if y for &es, n for &no, else false.
#
# Author
#	Jeff.Stander@ml.csiro.au CSIRO Division Of Fisheries, Hobart,
#	Tasmania 7001, Australia
###############################################################################
X
X
$keypress_defined=1;
X
{
X
#local($BSD) = -f '/vmunix';
local($fold)="i";
local($store,$keypress_echo,$keypress_defchar,$keypress_msg,$keypress_pattern,$skip_cleanup);
local($keypress_wait_time,$keypress_nobell);
X
sub keypress_cleanup {
X	undef $keypress_msg;
X	undef $keypress_defchar;
X	$keypress_wait_time = $ENV{'KEYPRESS_WAITTIME'} || 0 ;
X	$keypress_nobell    = $ENV{'KEYPRESS_NOBELL'} || 0 ;
X	$fold="i";
X	$keypress_pattern=".";
X	$keypress_echo=1;;
}
X
sub get_keypress_args {
X	local($arg) = pop(@_);
X
X	if ( defined($arg) ) {
X		if ( $arg eq "bell" ) {
X			$keypress_nobell = 0; 
X		}
X		elsif ( $arg eq "nobell" ) {
X			$keypress_nobell = 1; 
X		}
X		elsif ( $arg eq "fold" ) {
X			$fold = "i"; 
X		}
X		elsif ( $arg eq "nofold" ) {
X			$fold = 0; 
X		}
X		elsif ( $arg eq "noecho" ) {
X			$keypress_echo = 0;
X		}
X		elsif ( length($arg) == 1 ) { 
X			$keypress_defchar = unpack( "a", $arg );
X		}
X		elsif ( $arg =~ /^t=([0-9]+)$/ ) {
X			$keypress_wait_time = $1;
X		}
X		elsif( $arg =~ /^\[/ ) {
X			$keypress_pattern=$arg;
X		}
X		else { 
X			$keypress_msg = $arg;
X		};
X	}
X	@_;
}
X
sub keypress {
X	&keypress_cleanup if !$skip_cleanup;
X	while ( @_ ) { &get_keypress_args(@_); pop(@_); } 
X	if ( $ENV{'KEYPRESS_BG'} ) { return $keypress_defchar; }
X	$store=$|; $|=1;
X
X	$keypress_pattern =~ tr/[A-Z]/[a-z]/ if $fold;
X	$keypress_pattern =~ s#^\[#\[\n# if $keypress_defchar;;
X	$keypress_pattern =~ "[\n]" if !$keypress_pattern;
X	local($key,$ok);
X
X	if ( defined($keypress_msg) ) {
X		print $keypress_msg;
X		print "$keypress_defchar" if $keypress_defchar;
X	}
X	
X	while (!$ok) {
X		undef $key;
X		print "\a" if !$nobell;
X		$key = `keypress -R -t$keypress_wait_time $keypress_defchar`;
X		if ( !$key || $key eq "" ) { last };
X		last if $key =~ /\B/;
X		$key =~ tr/[A-Z]/[a-z]/ if $fold;
X		$ok = $key =~ /$keypress_pattern/;
X	}
X
X	$key=$keypress_defchar if ( $keypress_defchar && ( $key eq "\n" || !$key || $key =~ /\B/ ) );
X
X	print "$key\n" if $keypress_echo; 
X
X	$|=$store; $skip_cleanup=0;
X	$key;
}
X
X
sub yes {
X	&keypress_cleanup;
X	while ( @_ ) { &get_keypress_args(@_); pop(@_); } 
X	$skip_cleanup=1;
X	$keypress_msg = "Proceed? (y/n) n" if !$keypress_msg;
X	local($key) = &keypress("y","[yYnN]");
X	$key =~ /[yY]/;
}
X
X
sub no {
X	&keypress_cleanup;
X	while ( @_ ) { &get_keypress_args(@_); pop(@_); } 
X	$skip_cleanup=1;
X	$keypress_msg = "Proceed? (y/n) n" if !$keypress_msg;
X	local($key) = &keypress("n","[yYnN]");
X	$key =~ /[nN]/;
}
}
1;
X
__END__
print "ECHO  : [" . &keypress("t=2","y","[yYnYabcXYZ]","Enter y or n: ") ."]\n";
$res=&yes("t=1") ; print $res ? "YES" : "NO" , "\n"; 
X
# test program
while ( @_=(&get_keypress_args(@_)) ) {}; 
#print "ECHO  : [" . &keypress ."]\n";
#print "ECHO  : [" . &keypress(Q) ."]\n";
#print "ECHO  : [" . &keypress(x) ."]\n";
#print "NOECHO: [" . &keypress(noecho,x) ."]\n";
#print "NOECHO: [" . &keypress("q",noecho,"[abcq]",nofold) ."]\n";
X
#@_=(xx,yy,zzz);
#while ( @_=(&get_keypress_args(@_)) ) {}; 
X
#print "NO    : [" . &no(noecho,"Read disk?") ."]\n";
#print "NO    : [" . &no(noecho) ."]\n";
#print "NO    : [" . &no(noecho,"") ."]\n";
#print "NO    : [" . &no("") ."]\n";
#print "NO    : [" . &yes("") ."]\n";
print &yes("HELLO? ") ? "YES\n" : "NO\n";
print "NO    : [" . &no(noecho,"Read disk?") ."]\n";
print "NO    : [" . &no(noecho) ."]\n";
print "NO    : [" . &no(noecho,"") ."]\n";
print "NO    : [" . &no("") ."]\n";
print "NO    : [" . &yes("") ."]\n";
SHAR_EOF
chmod 0775 keypress.pl ||
echo 'restore of keypress.pl failed'
Wc_c="`wc -c < 'keypress.pl'`"
test 6445 -eq "$Wc_c" ||
	echo 'keypress.pl: original size 6445, current size' "$Wc_c"
fi
# ============= selection.pl ==============
if test -f 'selection.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping selection.pl (File already exists)'
else
echo 'x - extracting selection.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'selection.pl' &&
#! /usr/local/bin/perl  
###############################################################################
# Subroutine:	selection - sub to select from a list
# Synopsis:	&selection([nofold],$title,$default,@itemlist);
# Description:  Displays an itemized list on /dev/tty and prompts user to
#		enter a choice (read from STDIN).  
#		User's entries are screened for validity.
# Arguments:	title		- scalar containing title to be displayed 
#		default		- scalar which is default selection on <RETURN>
#				  keypress.  If undefined or null, no default
#				  return is allowed.  The default character
#				  should be one of the select-characters.
#		itemlist	- 1) list of select-character/select-item pairs
#						or
#				  2) list of select items.  These will be given
#				     selection numbers automatically, any
#				     single characater list element is assumed
#				     to be a select-characater and the following
#				     element its select-item (see example).
#		fold		- if the first argument is "fold" then select
#				  characters are all folded to lower case
#				  for testing against user entry. I.e. user 
#				  entry is case-insensitive.  This is the default.
#		nofold		- if the first argument is "nofold" then select
#				  characters are NOT folded to lower case.
#				  I.e. the user entry is case senstive.
# Example 1:
#               @items = ("H","HAPPY","S","SAD","B","BORED","Q","QUIT");
#		($result,$answer) = &selection("How are you feeling?","H",@items);
#		exit if $answer =~ /qQ/;
#		print "Oh, so you are feeling $result today\n";
#		
#		would print the following menu for the user..
#			How are you feeling?
#			H.  HAPPY
#			S.  SAD
#			B.  BORED
#			Q.  QUIT
#			Select one: 
#
# Example 2:
#               @items = ("HAPPY","SAD","BORED","Q","QUIT);
#		($result,$answer) = &selection("How are you feeling?","H",@items);
#		exit if $answer =~ /qQ/;
#		print "Oh, so you are feeling $result today\n";
#		
#		would print the following menu for the user..
#			How are you feeling?
#			1.  HAPPY
#			2.  SAD
#			3.  BORED
#			Q.  QUIT
#			Select one: 
#
# Returns: 	2-element list containing the item selected and the 
#		select-character.
# On Error:	Returns undef
# Host:         SunOS deep sun4m
# Author:       Jeff Stander (jstander@ml.csiro.au)
# Revision:     1.0 (jstander 04.01.94): new
# Author: 	Jeff.Stander@ml.csiro.au 
# (c) 1994	CSIRO Div. of Fisheries, Hobart Tasmania, Australia
###############################################################################
X
require "keypress.pl" if !$keypress_defined;
X
sub selection {
X	local($ans,$fmt,$nofold,$key,$item,$list,$cnt,$ndx);
X
X	open(TTY,"> /dev/tty");
X	local($stdin) = select(TTY);
X
X	if ($_[0] eq nofold) { 
X		$nofold = "nofold";
X		shift(@_);
X	}
X	elsif ($_[0] eq fold) { 
X		shift(@_);
X		$nofold = "fold";
X	}
X	else {
X		$nofold = "fold";
X	}
X
X	local($title,$default) = @_;
X	shift @_;
X	shift @_;
X
X	$ndx=0;
X	if ( @_[0] =~ /^.{2,}$/ ) {
X		for $item (@_) {
X			if ( $key ) {
X				$list[$ndx++] = $key;
X				$list[$ndx++] = $item;
X				undef $key;
X				$len    = length($key);
X				$maxlen = $len>$maxlen ? $len : $maxlen;
X				next;
X			}
X			elsif ( $item =~ /^.$/ ) {
X				$key=$item;
X				next;
X			}
X			else {
X				$list[$ndx++] = ++$cnt;
X				$list[$ndx++] = $item;
X				$len    = length($key);
X				$maxlen = $len>$maxlen ? $len : $maxlen;
X			}
X		}
X	}
X	else {
X		@list = @_;
X	}
X	$default=substr($default,0,1);
X	print "$title\n";
X
X	$fmt="\%" . $maxlen . "s.  \%s\n";
X
X	%list = @list;
X	while (($key,$item) = splice(@list,0,2)) {
X		printf ($fmt, $key, $item);
X		$keys .= $key;
X	}
X	local($pat) = "[$keys]";
X
X	print "\n" if $title =~ /\n$/;
X	print "Select one: ";
X	$ans = &keypress($nofold,$default,undef,$pat);
X
X	select($stdin);
X
X	($list{$ans},$ans);
}
1;
SHAR_EOF
chmod 0771 selection.pl ||
echo 'restore of selection.pl failed'
Wc_c="`wc -c < 'selection.pl'`"
test 3734 -eq "$Wc_c" ||
	echo 'selection.pl: original size 3734, current size' "$Wc_c"
fi
exit 0