# Turn on strictures and warnings. Get the module to sort
# out ambiguous answers.
#
use strict;
use warnings;

use Disambiguate;

# Initialise a list of choices, declare a scalar that will
# receive the disambiguated and completed choice.
#
my @choices = qw(
   alias
   allow
   appear
   apply
   begin
   clean
   clear
   clone
   close
   compare);
my $youChose;

# Call disambiguate() which is exported by Disambiguate.pm to
# generate a compiled regular expression to validate choices.
# Print it out just to see what is generated.
#
my $rxDisambiguate = disambiguate(\$youChose, @choices);
print "\nCompiled regular expression is\n\n$rxDisambiguate\n";

# Test choices in an infinite loop, Ctrl-D to exit. Use Ctrl-Z
# on Windows?
#
while(1)
{
    # Prompt user, drop out of loop if Ctrl-D entered. Chomp
    # answer given.
    #
    print
       "\nChoose from following, partial unambiguous entry OK\n",
       "   @choices\n",
       "Please choose (or Ctrl-D to exit) ? ";
    last if eof STDIN;
    chomp(my $ans = <STDIN>);

    # Does answer match regular expression returned by disambiguate()
    # above. If it does, completed choice was placed in $youChose by
    # the regular expression.
    #
    if($ans =~ $rxDisambiguate)
    {
        print "You chose: $youChose\n";
    }

    # It didn't match. Grep from @choices those that start with $ans.
    # If more than one grep'ed then $ans is ambiguous; if none then
    # $ans was not recognised. If only one was grep'ed then something
    # has gone badly wrong as the match above should have succeeded.
    #
    else
    {
        my @couldBe = grep {m/^$ans/} @choices;
        if(scalar @couldBe > 1)
        {
            print "\"$ans\" is ambiguous, ",
	       "could be any one of - @couldBe\a\n";
        }
        elsif(scalar @couldBe == 0)
        {
            print "\"$ans\" not recognised\a\n";
        }
        else
        {
            die "It should not be possible to get here\n";
        }
    }
}
print "     \n";