[Chicago-talk] humbling question

[Ted Zlatanov]

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).

Ted

# 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
}
else
{
 # no choice was made
}

sub get_key
{
 require Term::ReadKey;

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

 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";
  $i++;
 }

 print "RETURN: abort\n";

 my $key = uc get_key();

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

 return;
}