[Chicago-talk] humbling question

Ted Zlatanov tzz at lifelogs.com
Wed Sep 19 07:04:53 PDT 2007

On Wed, 19 Sep 2007 06:18:03 -0700 (PDT) Richard Reina <richard at rushlogistics.com> wrote: 

RR> I am trying to write a simple program like the one below that lets
RR> users at a console select an active employee.  However, because they
RR> are not supposed to see the employee's employee number I can't
RR> figure out a way to let them make the selection.  I thought I could
RR> do it with a counter ($i) but don't know of a way to associate the
RR> date with the count.  Any ideas would be greatfully appreciated.

If you can get your choices into an array, the pick_one function below
will let your users pick with A through Z.  Larger lists won't work
(it's easy to add a "...more" choice activated by SPACE, for instance).
Any key that's not a valid choice exits the menu.  I wrote this for
myself, so let me know if it's useful to you.

The nice thing about it is that you can pass any list of values, as long
as you define a suitable formatting function ($info_sub).


# info_sub can be undefined, in which case each choice will be printed
# as itself; otherwise it is a subroutine that will be passed each
# choice and needs to print it as desired by you

my $choice = pick_one("Menu header", \@list_of_choices, $info_sub);

if (defined $choice)
 my $position = $choice->[0]; # the position in the list
 my $item = $choice->[1];     # the item that was picked
 # no choice was made

sub get_key
 require Term::ReadKey;

 my $key = Term::ReadKey::ReadKey(0);
 chomp $key;

 undef $key if $key eq '';

 if (defined $key)
  print "[$key]";

 print "\n";

 return $key;

sub pick_one
 my $header   = shift @_;
 my $list     = shift @_;
 my $info_sub = shift @_;

 $info_sub = sub { "@_" }
  unless defined $info_sub;

 my %keys;
 my $i = 'A';
 my $pos = 0;
 return unless scalar @$list;

 print "$header\n";

 foreach my $entry (@$list)
  $keys{$i} = [$pos, $entry];
  print "($i) ", $info_sub->($entry), "\n";

 print "RETURN: abort\n";

 my $key = uc get_key();

 if (defined $key && exists $keys{$key})
  return $keys{$key};


More information about the Chicago-talk mailing list