File Coverage

blib/lib/Term/ReadPassword/Win32.pm
Criterion Covered Total %
statement 7 80 8.7
branch 0 40 0.0
condition 0 22 0.0
subroutine 3 7 42.8
pod 0 5 0.0
total 10 154 6.4


line stmt bran cond sub pod time code
1             package Term::ReadPassword::Win32;
2              
3 1     1   24303 use strict;
  1         2  
  1         54  
4              
5             require Exporter;
6              
7 1         1231 use vars qw(
8             $VERSION @ISA @EXPORT @EXPORT_OK
9             $SUPPRESS_NEWLINE $INPUT_LIMIT
10             $USE_STARS $STAR_STRING $UNSTAR_STRING
11 1     1   6 );
  1         2  
12              
13             @ISA = qw(Exporter);
14             @EXPORT = qw(read_password);
15             @EXPORT_OK = qw(ReadPasswd read_passwd);
16              
17             $VERSION = '0.05';
18              
19             if (IsWin32()) {
20             eval('use Win32');
21             eval('use Win32::Console');
22             eval('use Win32API::File');
23             } else {
24             eval('require Term::ReadPassword');
25             }
26              
27             # The maximum amount of data for the input buffer to hold
28             $INPUT_LIMIT = 1000;
29              
30             sub ReadPasswd {
31 0     0 0 0 read_password(@_);
32             }
33             sub read_passwd {
34 0     0 0 0 read_password(@_);
35             }
36              
37             sub read_password {
38 0     0 0 0 my ($prompt, $idle_limit, $interruptmode) = @_;
39 0 0       0 $prompt = '' unless defined $prompt;
40 0 0       0 $idle_limit = 0 unless defined $idle_limit;
41 0 0       0 $interruptmode = 0 unless defined $interruptmode;
42            
43 0 0       0 if (!IsWin32()) {
44 0 0       0 my $interruptable = ($interruptmode > 0) ? 1 : 0;
45            
46 0         0 $Term::ReadPassword::SUPPRESS_NEWLINE = $SUPPRESS_NEWLINE;
47 0         0 $Term::ReadPassword::INPUT_LIMIT = $INPUT_LIMIT;
48 0         0 $Term::ReadPassword::USE_STARS = $USE_STARS;
49 0         0 $Term::ReadPassword::STAR_STRING = $STAR_STRING;
50 0         0 $Term::ReadPassword::UNSTAR_STRING = $UNSTAR_STRING;
51            
52 0         0 return Term::ReadPassword::read_password($prompt, $idle_limit,
53             $interruptable);
54             }
55            
56 0         0 $idle_limit *= 1000; # sec -> msec
57            
58 0         0 my $CONIN = new Win32::Console(Win32::Console::STD_INPUT_HANDLE());
59 0         0 my $CONOUT = new Win32::Console(Win32::Console::STD_ERROR_HANDLE());
60            
61             # make sure that input and output are not redirected
62 0         0 my $hStdin = $CONIN->{'handle'};
63 0         0 $CONIN->{'handle'} = Win32API::File::createFile('CONIN$', 'rw');
64 0         0 my $hStderr = $CONOUT->{'handle'};
65 0         0 $CONOUT->{'handle'} = Win32API::File::createFile('CONOUT$', 'rw');
66            
67 0         0 $CONOUT->Write($prompt);
68            
69 0         0 $CONIN->Flush();
70            
71 0         0 my $conmode = $CONIN->Mode();
72 0 0       0 if ($interruptmode <= 1) {
73             # disable the system for processing Ctrl+C
74 0         0 $CONIN->Mode($conmode & ~Win32::Console::ENABLE_PROCESSED_INPUT());
75             }
76            
77             # Optionally echo stars in place of password characters.
78 0 0 0     0 my $star_string = $USE_STARS ? ($STAR_STRING || '*') : '';
79 0 0 0     0 my $unstar_string = $USE_STARS ? ($UNSTAR_STRING || "\b \b") : '';
80            
81             # the input buffer
82 0         0 my $input = '';
83            
84 0         0 my $tick = Win32::GetTickCount();
85 0         0 my $tick2 = $tick;
86             keyin:
87 0         0 while (1) {
88 0         0 while ($CONIN->GetEvents() == 0) {
89 0         0 Win32::Sleep(10);
90 0         0 $tick2 = Win32::GetTickCount();
91 0 0 0     0 if ($idle_limit && (DiffTick($tick2, $tick) > $idle_limit)) {
92             # timeout
93 0         0 undef $input;
94 0         0 last keyin;
95             }
96             }
97 0         0 $tick = $tick2;
98            
99             # read console
100 0         0 my ($evtype, $keydown, undef, $keycode, undef, $ch, undef)
101             = $CONIN->Input();
102            
103             # next if not a keydown event
104 0 0 0     0 next if ($evtype != 1 || !$keydown);
105            
106 0 0       0 $ch = 0x7f if ($keycode == 0x2e); # Del
107 0 0       0 next if ($ch == 0x00); # Special Keys
108 0         0 $ch &= 0xff; # for multibyte chars
109            
110 0 0 0     0 if ($ch == 0x0d || $ch == 0x0a) { # Enter
    0 0        
    0 0        
    0 0        
111             # end
112 0         0 last;
113             } elsif ($ch == 0x08 || $ch == 0x7f) { # BS, Del
114 0 0       0 if (length($input) > 0) {
115             # delete the last char
116             #
117             # BUG: If the last char is multibyte character,
118             # this doesn't work well.
119 0         0 chop $input;
120            
121 0         0 $CONOUT->Write($unstar_string);
122             }
123             } elsif ($ch == 0x15) { # Ctrl+U
124 0         0 $CONOUT->Write($unstar_string x length($input));
125 0         0 $input = ''; # clear all
126             } elsif (($interruptmode > 0)
127             && ($ch == 0x1b || $ch == 0x03)) { # Esc, Ctrl+C
128             # cancel
129 0         0 undef $input;
130 0         0 last;
131             } else {
132             # normal chars
133 0         0 $input .= chr($ch);
134 0         0 $CONOUT->Write($star_string);
135             }
136 0 0       0 if (length($input) > $INPUT_LIMIT) {
137 0         0 $input = substr($input, 0, $INPUT_LIMIT);
138             }
139             }
140            
141 0 0       0 $CONOUT->Write("\n") unless $SUPPRESS_NEWLINE;
142            
143             # restore console mode
144 0         0 $CONIN->Mode($conmode);
145            
146             # restore console handles
147 0         0 Win32API::File::CloseHandle($CONIN->{'handle'});
148 0         0 $CONIN->{'handle'} = $hStdin;
149 0         0 Win32API::File::CloseHandle($CONOUT->{'handle'});
150 0         0 $CONOUT->{'handle'} = $hStderr;
151            
152 0         0 $CONIN = undef;
153 0         0 close STDIN;
154 0         0 open STDIN, '+
155 0         0 return $input;
156             }
157              
158             sub DiffTick {
159 0     0 0 0 my ($tick1, $tick2) = @_;
160 0         0 $tick1 &= 0xFFFFFFFF;
161 0         0 $tick2 &= 0xFFFFFFFF;
162            
163 0 0       0 if ($tick1 >= $tick2) {
164 0         0 return $tick1 - $tick2;
165             } else {
166 0         0 return 0xFFFFFFFF + 1 + $tick1 - $tick2;
167             }
168             }
169              
170             sub IsWin32 {
171 1     1 0 5 return ($^O eq 'MSWin32');
172             }
173              
174             1;
175              
176             __END__