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: [email protected] (Jeff Stander)
Subject: Re: Interactive scripts (cbreak, flushing STDI
Message-ID: <[email protected]>
Sender: [email protected]
Reply-To: [email protected]
Organization: CSIRO Marine Laboratories
References: <[email protected]>
Date: Fri, 28 Jan 1994 06:08:55 GMT
Lines: 414

In article [email protected], [email protected] (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

___________________________________________________________________________

[email protected]        _--_|\        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
#       [email protected] 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
#       [email protected] 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 ([email protected])
# Revision:     1.0 (jstander 04.01.94): new
# Author:       [email protected]
# (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

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.