PromptUtil.pm (Chapters 8 and 9) The PromptUtil.pm module provides basic functionality for prompting the user for passwords and commands. A more sophisticated package of prompt utilities is the Term ::Prompt module, found on CPAN. This module exports two functions. The get_passwd() function prompts for a password, turning off echo so that the user's response is not visible. If a username and host is provided, the prompt includes this information (used when logging into a particular account on a remote host). The prompt() function takes the text of a prompt and a default to return if the user enters no value. The user is prompted with the given prompt, and the function returns his response. As a special case, the function checks for a response of " q ", indicating that the user wants to quit immediately. The echo() function uses one of two methods to disable echo. If the Term::ReadKey module is installed, then it uses the imported ReadMode() function. Otherwise , it calls the UNIX command-line stty program to fetch the current terminal settings, and calls stty again to disable echo. Later, when echo() is asked to reactivate terminal echo, it restores the terminal settings. 0 package PromptUtil; 1 # file PromptUtil.pm 2 use strict; 3 require Exporter; 4 eval "use Term::ReadKey"; 5 use vars '@EXPORT','@ISA'; 6 @EXPORT = qw(get_passwd prompt); 7 @ISA = 'Exporter'; 8 my $stty_settings; # save old TTY settings 9 sub get_passwd { 10 my ($user,$host) = @_; 11 print STDERR "$user\@$host " 12 if $user && $host; 13 print STDERR "password: "; 14 echo ('off'); 15 chomp(my $pass = <>); 16 echo ('on'); 17 print STDERR "\n"; 18 $pass; 19 } 20 # print a prompt 21 sub prompt { 22 local($) = 1; 23 my $prompt = shift; 24 my $default = shift; 25 print "$prompt ('q' to quit) [$default]: "; 26 chomp(my $response = <>); 27 exit 0 if $response eq 'q'; 28 return $response $default; 29 } 30 sub echo { 31 my $mode = shift; 32 if (defined &ReadMode) { 33 ReadMode( $mode eq 'off' ? 'noecho' : 'restore' ); 34 } else { 35 if ($mode eq 'off') { 36 chomp($stty_settings = `/usr/bin/stty -g`); 37 system "/usr/bin/stty -echo </dev/tty"; 38 } else { 39 $stty_settings =~ /^([:\da-fA-F]+)$/; 40 system "/usr/bin/stty </dev/tty"; 41 } 42 } 43 } 44 1; 45 =head1 NAME 46 PromptUtil - Prompt utilities 47 =head1 SYNOPSIS 48 use PromptUtil; 49 my $response = prompt('<n>ext, <p>revious, or <e>dit','n'); 50 my $pass = get_passwd(); 51 =head1 DESCRIPTION 52 This package exports two utilities that are handy for prompting for 53 user input. 54 =head1 EXPORTED FUNCTIONS 55 =over 4 56 =item $result = prompt($prompt,$default) 57 Prints the indicated C<$prompt> to and requests a line of input. If 58 the user types "q" or "quit", it returns false. Otherwise, it returns 59 the input line (minus the newline). If the user hits return without 60 typing anything, it returns the default specified by C<$default>. 61 =item $password = get_passwd([$user,$host]) 62 Turns off terminal echo and prompts the user to enter password. 63 If C<$user> and C<$host> are provided, the prompt is in the format 64 jdoe@host.domain password: 65 otherwise the prompt is simply 66 password: 67 The function returns the password, or undef it the user typed return 68 without entering a password. 69 =back 70 If get_passwd() detects that the Term::ReadKey module is available, it 71 attempts to use that. Otherwise, it calls the UNIX stty 72 program, which is not available on non-UNIX systems. 73 =head1 SEE ALSO 74 L<Term::ReadKey>, L<perl> 75 =head1 AUTHOR 76 Lincoln Stein <lstein@cshl.org> 77 =head1 COPYRIGHT 78 Copyright (c) 2000 Lincoln Stein. All rights reserved. This program is 79 free software; you can redistribute it and/or modify it under the same 80 terms as Perl itself. 81 =cut |