Just a wrapper to ask users questions.
I got tired of writing the sametheing over and over.
So a quicky snippet called my name.
use Term::ReadKey;

sub Request($;$$)
{
    chomp(my $talk = shift || return -1);
       #required arg, the question!
    chomp(my $letters = shift || "Ny");
       #letters to display
    chomp(my $return = shift || 1);
       #do you need a line break after the anwser is given
    my $answer;
    {
        $answer = undef; #set to null
        print "$talk? [$letters] "; #note a '?' is given
        ReadMode('cbreak'); 
           #ReadKey is here 'cause I just like to use it.
        $answer = ReadKey(0);#quick!
        ReadMode('normal');
        chomp $answer;
           #I always chomp my vars. Even if Gram gave them to me.
        if(!(grep /$answer/i, $letters)) #not a real choice
         { print "\nplease answer [$letters]\n"; redo }
    }
    if($return){print "\n"}#the newline bump
    return $answer;

#I tend to use it like this
#if((Request("Setup metacheck.sh in crontab", "Ny")) =~/Y/i){yak;yak;y
+ak;}
}

[download]

Replies are listed 'Best First'.
Re: questions, questions
by Aristotle (Chancellor) on Sep 19, 2002 at 19:32 UTC
    Your use of grep was wrong. It's for testing lists - you just wanted a single match there. The redo isn't wrong, but can catch someone off guard. Overall the thing looks much like C. More idiomatically, it looks like this: 
    use Term::ReadKey;

sub Request {
  my ($prompt, $letters, $linefeed) = @_;

  return unless $prompt;
  $letters ||= "Ny";
  $linefeed ||= 1;

  my ($answer, $is_correct);
  do {
      print "$prompt? [$letters] ";

      ReadMode 'cbreak';
      $answer = uc ReadKey 0;
      ReadMode 'normal';

      $is_correct = (index uc $letters, $answer >= 0);
      print "\nplease answer [$letters]\n" unless $is_correct;
  } until $is_correct;

  print "\n" if $linefeed;

  return $answer;
}

    [download]

    Note the use of uc to force things to uppercase so we needn't juggle with case-insensitivity in comparisons. You can then use it as in if(Request(...) eq 'Y') { ... }.

    Update: Oops. Now complies with strict.

    Makeshifts last the longest.

[reply]
[d/l]
      Thanks! Good points all round. As to style, guess I'm a grunt.
      Only thing is "uc". It limits the avalible args
[reply]

        It does, but if you wanted case sensitive behaviour, the /$answer/i in your original code was wrong. In any case, just drop the ucs if that's what you need. One could also make that an option..

        Don't worry about style, it's just a matter of experience. :-) Being a Pascalite, my first Perl scripts looked rather.. odd.

        Makeshifts last the longest.

[reply]

Back to Cool Uses for Perl