1#!/usr/bin/perl -w 2 3#use strict vars; 4 5#use Term::ReadKey qw( ReadMode ReadKey ); 6#my $x; 7#ReadMode 3; 8#print "Read 1\n"; 9#$x = ReadKey(0); 10#print "X=$x\n"; 11#print "Read 2\n"; 12#$x = ReadKey(0); 13#print "X=$x\n"; 14#ReadMode 0; 15#__END__; 16 17my $interactive = ( @ARGV && $ARGV[0] =~ /interactive/ ); 18 19BEGIN { print "1 .. 8\n"; } 20END { print "not ok 1\n" unless $loaded } 21use Term::ReadKey; 22 23$loaded = 1; 24print "ok 1\n"; 25 26use Fcntl; 27 28if ( not exists $ENV{COLUMNS} ) 29{ 30 $ENV{COLUMNS} = 80; 31 $ENV{LINES} = 24; 32} 33 34if ( $^O =~ /Win32/i ) 35{ 36 sysopen( IN, 'CONIN$', O_RDWR ) or die "Unable to open console input:$!"; 37 sysopen( OUT, 'CONOUT$', O_RDWR ) or die "Unable to open console output:$!"; 38} 39else 40{ 41 42 if ( open( IN, "</dev/tty" ) ) 43 { 44 *OUT = *IN; 45 die "Foo" unless -t OUT; 46 } 47 else 48 { 49 50 # Okay we are going to cheat a skip 51 foreach my $skip ( 2 .. 8 ) 52 { 53 print "ok $skip # skip /dev/tty is absent\n"; 54 } 55 exit; 56 } 57} 58 59*IN = *IN; # Make single-use warning go away 60$| = 1; 61 62my $size1 = join( ",", GetTerminalSize( \IN ) ); 63my $size2 = join( ",", GetTerminalSize("IN") ); 64my $size3 = join( ",", GetTerminalSize(*IN) ); 65my $size4 = join( ",", GetTerminalSize( \*IN ) ); 66 67if ( ( $size1 eq $size2 ) && ( $size2 eq $size3 ) && ( $size3 eq $size4 ) ) 68{ 69 print "ok 2\n"; 70} 71else 72{ 73 print "not ok 2\n"; 74} 75 76sub makenicelist 77{ 78 my (@list) = @_; 79 my ( $i, $result ); 80 $result = ""; 81 for ( $i = 0 ; $i < @list ; $i++ ) 82 { 83 $result .= ", " if $i > 0; 84 $result .= "and " if $i == @list - 1 and @list > 1; 85 $result .= $list[$i]; 86 } 87 $result; 88} 89 90sub makenice 91{ 92 my ($char) = $_[0]; 93 if ( ord($char) < 32 ) { $char = "^" . pack( "c", ord($char) + 64 ) } 94 elsif ( ord($char) > 126 ) { $char = ord($char) } 95 $char; 96} 97 98sub makeunnice 99{ 100 my ($char) = $_[0]; 101 $char =~ s/^\^(.)$/pack("c",ord($1)-64)/eg; 102 $char =~ s/(\d{1,3})/pack("c",$1+0)/eg; 103 $char; 104} 105 106my $response; 107 108eval { 109 110 if ( &Term::ReadKey::termoptions() == 1 ) 111 { 112 $response = 113 "Term::ReadKey is using TERMIOS, as opposed to TERMIO or SGTTY.\n"; 114 } 115 elsif ( &Term::ReadKey::termoptions() == 2 ) 116 { 117 $response = 118 "Term::ReadKey is using TERMIO, as opposed to TERMIOS or SGTTY.\n"; 119 } 120 elsif ( &Term::ReadKey::termoptions() == 3 ) 121 { 122 $response = 123 "Term::ReadKey is using SGTTY, as opposed to TERMIOS or TERMIO.\n"; 124 } 125 elsif ( &Term::ReadKey::termoptions() == 4 ) 126 { 127 $response = 128"Term::ReadKey is trying to make do with stty; facilites may be limited.\n"; 129 } 130 elsif ( &Term::ReadKey::termoptions() == 5 ) 131 { 132 $response = "Term::ReadKey is using Win32 functions.\n"; 133 } 134 else 135 { 136 $response = 137 "Term::ReadKey could not find any way to manipulate the terminal.\n"; 138 } 139 140 print "ok 3\n"; 141}; 142 143print "not ok 3\n" if $@; 144 145print $response if $interactive; 146 147eval { 148 push( @modes, "O_NODELAY" ) if &Term::ReadKey::blockoptions() & 1; 149 push( @modes, "poll()" ) if &Term::ReadKey::blockoptions() & 2; 150 push( @modes, "select()" ) if &Term::ReadKey::blockoptions() & 4; 151 push( @modes, "Win32" ) if &Term::ReadKey::blockoptions() & 8; 152 153 print "ok 4\n"; 154}; 155 156print "not ok 4\n" if $@; 157 158if ($interactive) 159{ 160 if ( &Term::ReadKey::blockoptions() == 0 ) 161 { 162 print "No methods found to implement non-blocking reads.\n"; 163 print 164" (If your computer supports poll(), you might like to read through ReadKey.xs)\n"; 165 } 166 else 167 { 168 print "Non-blocking reads possible via ", makenicelist(@modes), ".\n"; 169 print $modes[0] . " will be used. " if @modes > 0; 170 print $modes[1] . " will be used for timed reads." 171 if @modes > 1 172 and $modes[0] eq "O_NODELAY"; 173 print "\n"; 174 } 175} 176 177eval { 178 @size = GetTerminalSize(OUT); 179 print "ok 5\n"; 180}; 181 182print "not ok 5\n" if $@; 183 184if ($interactive) 185{ 186 if ( !@size ) 187 { 188 print 189 "GetTerminalSize was incapable of finding the size of your terminal."; 190 } 191 else 192 { 193 print "Using GetTerminalSize, it appears that your terminal is\n"; 194 print "$size[0] characters wide by $size[1] high.\n\n"; 195 } 196 197} 198 199eval { 200 @speeds = GetSpeed(); 201 print "ok 6\n"; 202}; 203 204print "not ok 6\n" if $@; 205 206if ($interactive) 207{ 208 if (@speeds) 209 { 210 print "Apparently, you are connected at ", join( "/", @speeds ), 211 " baud.\n"; 212 } 213 else 214 { 215 print "GetSpeed couldn't tell your connection baud rate.\n\n"; 216 } 217 print "\n"; 218} 219 220eval { 221 %chars = GetControlChars(IN); 222 print "ok 7\n"; 223}; 224 225print "not ok 7\n" if $@; 226 227%origchars = %chars; 228 229if ($interactive) 230{ 231 for $c ( keys %chars ) { $chars{$c} = makenice( $chars{$c} ) } 232 233 print "Control chars = (", 234 join( ', ', map( "$_ => $chars{$_}", keys %chars ) ), ")\n"; 235} 236 237eval { 238 SetControlChars( %origchars, IN ); 239 print "ok 8\n"; 240}; 241 242print "not ok 8\n" if $@; 243 244#SetControlChars("FOOFOO"=>"Q"); 245#SetControlChars("INTERRUPT"=>"\x5"); 246 247END { ReadMode 0, IN; } # Just if something goes weird 248 249exit(0) unless $interactive; 250 251print "\nAnd now for the interactive tests.\n"; 252 253print 254 "\nThis is ReadMode 1. It's guarranteed to give you cooked input. All the\n"; 255print "signals and editing characters may be used as usual.\n"; 256 257ReadMode 1, IN; 258 259print "\nYou may enter some text here: "; 260 261$t = ReadLine 0, IN; 262 263chop $t; 264 265print "\nYou entered `$t'.\n"; 266 267ReadMode 2, IN; 268 269print 270 "\nThis is ReadMode 2. It's just like #1, but echo is turned off. Great\n"; 271print "for passwords.\n"; 272 273print "\nYou may enter some invisible text here: "; 274 275$t = ReadLine 0, IN; 276 277chop $t; 278 279print "\nYou entered `$t'.\n"; 280 281ReadMode 3, IN; 282 283print 284 "\nI won't demonstrate ReadMode 3 here. It's your standard cbreak mode,\n"; 285print 286 "with editing characters disabled, single character at a time input, but\n"; 287print "with the control characters still enabled.\n"; 288 289print "\n"; 290 291print 292"I'm now putting the terminal into ReadMode 4 and using non-blocking reads.\n"; 293print 294 "All signals should be disabled, including xon-xoff. You should only be\n"; 295print "able to exit this loop via 'q'.\n"; 296 297ReadMode 4, IN; 298$k = ""; 299 300#$in = *STDIN; 301$in = \*IN; # or *IN or "IN" 302while ( $k ne "q" ) 303{ 304 print "Press a key, or \"q\" to stop: "; 305 $count = 0; 306 307 #print "IN = $in\n"; 308 $count++ while !defined( $k = ReadKey( -1, $in ) ); 309 310 #print "IN2 = $in\n"; 311 print "\nYou pressed `", makenice($k), 312 "' after the loop rolled over $count times\n"; 313} 314ReadMode 0, IN; 315 316print "\nHere is a similar loop which times out after two seconds:\n"; 317 318ReadMode 4, IN; 319$k = ""; 320 321#$in = *STDIN; 322$in = \*IN; # or *IN or "IN" 323while ( $k ne "q" ) 324{ 325 print "Press a key, or \"q\" to stop: "; 326 $count = 0; 327 328 #print "IN = $in\n"; 329 print "Timeout! " while !defined( $k = ReadKey( 2, $in ) ); 330 331 #print "IN2 = $in\n"; 332 print "\nYou pressed `", makenice($k), "'\n"; 333} 334 335print 336 "\nLastly, ReadMode 5, which also affects output (except under Win32).\n\n"; 337 338ReadMode 5, IN; 339 340print 341"This should be a diagonal line (except under Win32): *\n*\n*\n\*\n*\n*\r\n\r\n"; 342print "And this should be a moving spot:\r\n\r\n"; 343 344$width = ( GetTerminalSize(OUT) )[0]; 345$width /= 2; 346$width--; 347if ( $width < 10 ) { $width = 10; } 348 349for ( $i = 0 ; $i < 20 ; $i += .15 ) 350{ 351 print "\r"; 352 print( " " x ( ( cos($i) + 1 ) * $width ) ); 353 print "*"; 354 select( undef, undef, undef, 0.01 ); 355 print "\r"; 356 print( " " x ( ( cos($i) + 1 ) * $width ) ); 357 print " "; 358} 359print "\r "; 360 361print "\n\r\n"; 362 363ReadMode 0, IN; 364 365print "That's all, folks!\n"; 366 367