My solutions could easily be packaged, but I imagine there's something already around that does this...
#!/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;
}