ericv wrote:
> ok Bill,
>
> I am talk about the function read_password which is part of the Term module.
> It apparently works in all other platforms ( unix, etc...) but is know not to
> work on Win32 ( and i confirm that!)
>
> I am working on a command line script, and need to input a password from the
> console, and obviously
> i would avoid to show it explicitly.
>
> Any ideas ?
Yes - don't use read_password if it doesn't work. I don't know about
the 'Term' module, but you can use Term::ReadKey module:
use strict;
use warnings;
use Term::ReadKey; END { ReadMode ('restore'); } # just in case
$| = 1; # unbuffer stdout
my $pwd = '';
# echoes * for each char and allows correction
binmode STDIN;
print "Password: ";
ReadMode ('cbreak');
while (defined (my $ch = ReadKey ())) {
last if $ch eq "\x0a" or $ch eq "\x0d";
if ($ch eq "\x08") { # backspace
print "\b \b" if $pwd; # back up 1
chop $pwd;
next;
}
if ($ch eq "\x15") { # ^U
print "\b \b" x length $pwd; # back 1 for each char
$pwd = '';
next;
}
$pwd .= $ch;
print '*';
}
ReadMode ('restore');
print "\n";
print "Password entered was $pwd\n";
# This will also work, but it's not as functional and doesn't echo *'s:
# print "Password: ";
# ReadMode ('noecho');
# my $pwd = ReadLine ();
# chomp $pwd;
# ReadMode ('restore');
__END__
You can also use a less portable Win32 solution (haven't verified lately) :
use strict;
use warnings;
use Win32::Console;
$| = 1; # unbuffer stdout
my $debug = 0;
my $key = '';
my $passwd = '';
my $prompt = "Type password followed by ENTER: ";
my $prompt2 = "try again: ";
my $IN = new Win32::Console (STD_INPUT_HANDLE) or die $!;
print $prompt;
$IN->Flush (); # optionally flush input
while (1) {
my @e = $IN->Input();
print "Event='@e'\n" if $debug;
next if ($e[0] != 1 or $e[1] != 0); # not keybd key up
my $key = chr ($e[5]);
print "key=$key '$e[5]'\n" if $debug;
if ($key =~ /[\r\n]/) { # EOL
if (length $passwd > 0) {
print "\n";
last;
}
} elsif ($e[5] == 8 and ($e[6] == 8 or $e[6] == 0)) { # BS or DEL
$passwd =~ s/^(.*).$/$1/;
print "\b \b";
print "1 passwd=$passwd ", length $passwd, "\n" if $debug;
} elsif ($e[6] == 8 and $e[5] == 21) { # ^U
$passwd = '';
print "2 passwd=$passwd ", length $passwd, "\n" if $debug;
} elsif ($e[6] == 8 and ($e[5] == 4 or $e[5] == 26)) { # ^D or ^Z
last;
} elsif ($e[6] == 0 or $e[6] == 16) { # regular key
next if $e[5] == 0;
$passwd .= $key;
print "3 passwd=$passwd ", length $passwd, " " if $debug;
print "*";
print "\n" if $debug;
} else {
print "? passwd=$passwd ", length $passwd, "\n" if $debug;
print "Illegal key\n";
}
}
print "passwd=$passwd\n" if $debug;
$IN->Flush ();
#$IN->Free (); # don't free or you lose STDOUT
#undef $IN;
__END__
--
,-/- __ _ _ $Bill Luebkert Mailto:[EMAIL PROTECTED]
(_/ / ) // // DBE Collectibles Mailto:[EMAIL PROTECTED]
/ ) /--< o // // Castle of Medieval Myth & Magic http://www.todbe.com/
-/-' /___/_<_</_</_ http://dbecoll.tripod.com/ (My Perl/Lakers stuff)
_______________________________________________
Perl-Win32-Users mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
