Here's how one might achieve the equivalent in perl:

  my @menu = ( "Go left", "Go right" );

  for my $i ( 0 .. $#menu ) { print $i+1, ") $menu[$i]\n"; }

  print "?";
  $_ = <>;
  ($_) = /^(\d+)/; # extract just the digits, if any.
  $_--; # because the menu as displayed in 1-based.

  # now do whatever you want with the number in $_ and
  # the full text of the selected menu item in $menu[$_].
[download]

hth, hand.

I've decided to provide a near-exact reimplementation in Perl. The main differences are that you don't specify the "looping" variable (it uses $_ instead), and the code block comes before the list of choices. This just seems more perlish. One of the fun things about this implementation is that, just like the ksh select statement, it temporarily owns stdin; to exit the loop, you hit ^D (or ^Z on DOS; or as appropriate for your system/terminal).

sub ksh_select(&@) {
  my $cr = shift;
  my $prompt = $ENV{'PS3'} || '#? ';
  local *ARGV;
  local $| = 1;
  local $_;
  while (1) {
    for my $i ( 0 .. $#_ ) {
      print STDOUT $i+1, ") $_[$i]\n";
    }
    print STDOUT $prompt;
    $_ = <>;
    defined $_ or return;
    chomp;
    $cr->( $_ );
  }
}
[download]

A simple example usage:

ksh_select { print "You chose $_\n" } qw( foo bar quux );
[download]

A more realistic example:

# in this example, the user has choices to navigate around some struct
+ure.
my %dispatch = (
  First => \&goto_first,
  Prev => \&goto_prev,
  Next => \&goto_next,
  Last => \&goto_last,
);
my @menu = qw( First Prev Next Last );

ksh_select {
  defined $menu[$_]
    ? $dispatch{$menu[$_]}->()
    : warn "Selection out of range!\n";
} @menu;
[download]

Something like the following might help get you started. Call it with the prompt and list of words. It'll return either undef or the word selected in scalar context. In list context it will also return the reply entered by the user. (To preserve the $REPLY functionality of the ksh builtin.) It preserves my ksh's interpretation of input which allows trailing characters after the number.

sub ksh_like_select {
  my $prompt     = shift;
  my @words      = @_;
  my $retval;
  my $reply;

  do {
    my $i = 1;
    print STDERR $i++, ")\t$_\n" for @words;
    print $prompt;
    $reply = <STDIN>;
  } while ($reply eq '');

  if ($reply =~ /^(\d+)/ and $1 > 0 and $1 <= @words) {
      $retval = $words[$1-1];
  }

  wantarray() ? ($retval,$reply) : $retval;
}
[download]

-sauoq
"My two cents aren't worth a dime.";

#!/usr/bin/ksh

PS3="Enter your choice :"
select menu_list in English francais
do
   case $menu_list in
      English)  print "Thank you";;
      francais) print "Merci";;
      *)        print "???"; break;;
   esac
done
[download]

That is pretty slick. :) Here are some guidelines from the Kornshell '93 manual to go by for anyone wishing to do a little porting:

A select command prints on standard error (file descriptor 2) the set of words, each preceded by a number. If in word  <NULL>. . . is omitted, then the positional parameters starting from 1 are used instead. The PS3 prompt is printed and a line is read from the standard input. If this line consists of the number of one of the listed words, then the value of the variable vname  is set to the word  corresponding to this number. If this line is empty, the selection list is printed again. Otherwise the value of the variable vname  is set to null. The contents of the line read from standard input is saved in the variable REPLY. The list  is executed for each selection until a break  or end-of-file  is encountered. If the REPLY variable is set to null  by the execution of list, then the selection list is printed before displaying the PS3 prompt for the next selection.

UPDATE:
Here is my go at it - pure evil:

no strict;

use constant PS3 => 'Enter your choice :';

my %menu = (
   English => sub { print "Thank you\n" },
   fancais => sub { print "Merci\n" },
   none    => sub { print "???\n"; exit },
);
   
while (1) {
   &select(menu_list => in => qw(English fancais));
   $menu{$menu_list}->();
}


sub select {
   my ($var,$in,@list) = @_;

   unless ($i) {
      printf STDERR "%d) %s\n", ++$i, $_ for @list;
   }

   push @list,undef;
   
   print STDERR PS3;
   chomp($ans = <>);

   unless ($ans) {
      $i = pop @list;
      &select($var,undef,@list);
   }

   $$var = $list[$ans-1] || 'none';
}
[download]

Yes, i am actually doing a Bad Thing and turning off strict. Why? Because i wanted to use menu_list as symbolic var - not really a good thing, but it remains close to the syntax of ksh's select. I opted to use a hash (%menu) instead of a case - much nicer. pushing an undef value onto @list inside select() is a trick to handle the user select anything other than a positive integer. Also, you must prefix the call to select() with an ampersand, else Perl will execute the built-in select. I almost got the REPLY being null behavior to work - see if you can find the bug. ;)

jeffa

#!/usr/bin/perl

#---------------------------------------------------------------------
+-----------
# SELECT.pl
# This code is GPL, but I'd love to see any mods: email join('.','rick
+m@isite','net','au')
#---------------------------------------------------------------------
+-----------

use strict;

#---------------------------------------------------------------------
+-----------
# Example uses
#---------------------------------------------------------------------
+-----------

print "Do you wish to find a mirror site?\n";
Select(
    'Yes'    =>  1,
    'No'    =>  sub{print "OK, exiting now."; exit},
    sub{print "Invalid option, assuming you don't want to continue."; 
+exit}
);

print "What nationality are you?\n";
print "I will use " . Insist(
    'English'    =>  'mirror.co.uk',
    'French'    =>  'mirror.fr',
    'American'    =>  'mirror.com',
    'None of the above' => sub {print "Enter a custom mirror domain: "
+; return <>},
                            # you should return 0 from your subs if yo
+u want to 
                            # get the name of the option returned, oth
+erwise you'll
                            # get the return value of the sub.
    "You must select a nationality",
) . "\n";

#---------------------------------------------------------------------
+-----------
# The routines
#---------------------------------------------------------------------
+-----------

# Select allows a single opportunity to make a selection from a list
# $result = Select('name0'=>'value', ... , 'namen'=>sub{ ... }, 'Fail 
+message');
# $result = Select('name0'=>'value', ... , 'namen'=>sub{ ... }, sub { 
+... });
# $result = Select('name0'=>'value', ... , 'namen'=>sub{ ... });
# If there's a valid response it returns the 'value' or executes the s
+ub{} 
#    associated with the selected name, otherwise it executes the fail
+ sub{}
#    or prints the 'fail message' and returns a 0
sub Select {
    my $fail = pop if ($#_ % 2 == 0); 
    my @options = @_;
    for (my $i=0; $i<$#options; $i+=2) { 
        print '(' . (int($i/2)+1) . ') ' . $options[$i] . "\n"; # Prin
+t the menu
    }
    my $input = <>;
    $input=~s/[^\d]//g;
    if (($input < 1) || ($input > (int($#options/2)+1))) {
        if ($fail) {
            if (ref($fail) eq 'CODE') { &$fail } else { print $fail."\
+n" }
            return 0;
        } else {
            die("You have not selected a valid option") #Maybe should 
+be a warn or something?
        }
    } elsif (ref($options[(($input*2)-1)]) eq 'CODE') {
        # Execute the code and return the response or the name of the 
+option
        my $value = &{$options[(($input*2)-1)]};
        return $value || $options[($input*2)-2];
    } else {
        # Or just return the value of the option
        return $options[(($input*2)-1)];
    }
}

# Insist requires a valid entry and keeps asking until it gets one.
# $result = Insist('name0'=>'value', ... , 'namen'=>sub{ ... }, 'Fail 
+message');
# $result = Insist('name0'=>'value', ... , 'namen'=>sub{ ... });
# returns the 'value' or executes the sub{} associated with the select
+ed name
sub Insist {
    my $fail = pop if ($#_ % 2 == 0);
    $fail ||= q|You must select a valid option.|;
    my @options = @_;
    my $result;
    die("Insist: Fail message should be a scalar.") if ref($fail);
    until ($result = Select(@options, $fail)) {}
    return $result;
}
[download]

#!/usr/bin/perl
use strict;

my $language = Select('Select your language:', qw(English Francais));

if($language eq 'English') {
  print "Thank you!\n";
}
elsif($language eq 'Francais') {
  print "Merci!\n";
}
else {
  print "Unknown language: $language";
}

sub Select
{
  my($prompt, @choices) = @_;

  while(1) {
    my $i = 0;
    print STDERR $prompt, "\n";
    print STDERR join("\n", map{++$i.") $_"} @choices), "\n";
    my $answer = lc <STDIN>;
    chomp $answer;

    if($answer =~ /^\d+$/) {
      return $choices[$answer-1]
        if defined $choices[$answer-1];
    } else {
      my $out = [grep {lc $_ eq $answer} @choices]->[0];
      return $out if $out;
    }
  }
}
[download]

It supports these obvious invocations:

select (LIST) { block; }

select $var (LIST) { block; }

select my|local|our $var (LIST) { block; }
[download]

LIST2 = select {block;} LIST;
[download]

LIST2 = select /expr/, LIST;
[download]

Tim Maher, "yumpy"

Consultix
tim@teachmeperl.com

I'm currently putting the finishing touches on this module, and working on registering a namespace for it in the CPAN. I expect it will be ready in the near future for downloads. Tim Maher tim@teachmeperl.com

print

My module that implements the select loop of the Korn and Bash shells has been released! It's called Shell::POSIX::Select, and it's available from your friendly neighborhood CPAN mirror now. You can also check out the documentation at my web site. Here's one of the examples shown in the documentation:

use Shell::POSIX::Select ;

# Extract man-page names from TOC portion of output of "perldoc perl"

select $manpage ( sort ( `perldoc perl` =~/^\s+(perl\w+)\s/mg) ) {
      system "perldoc '$manpage'" ;
}

Screen

   1) perl5004delta   2) perl5005delta   3) perl561delta
   4) perl56delta     5) perl570delta    6) perl571delta
        . . .
(This large menu spans multiple screens, but all parts can be 
accessed using your normal terminal scrolling facility.)

   Enter number of choice: 6

        PERL571DELTA(1)       Perl Programmers Reference Guide

        NAME
               perl571delta - what's new for perl v5.7.1

        DESCRIPTION
               This document describes differences between the 5.7.0
               release and the 5.7.1 release.
        . . .
[download]

foreach $varname (@list)
{
  whatever
}
[download]

--
As God is my witness, I thought turkeys could fly.

:)
I think you should lay off the DMT -- Ash/asksh <ask@unixmonks.net>

As a matter of fact, you're only missing one thing -- the whole point! The foreach loop loads each list element into $varname. In contrast, the select loop interactively asks the user which element should be loaded for the next iteration! As you can see, these are totally different in behavior, despite the only visible difference being the change from the keyword foreach to select.

Tim Maher
tim@teachmeperl.com