I know it works in a non-blocking fashion if I call
$char = ReadKey(-1);
However I'll still have to call that like every 0.5 seconds in callbacks of an event-based timer, so it is not exactly real-time. I can improve its responsiveness to 0.2 seconds maybe but here's hoping there is a more perfect solution.
| [reply] [d/l] |
I can improve its responsiveness to 0.2 seconds maybe
There is nothing to stop you calling it every 0.001 seconds if you think the typist is likely to enter something significant within that time. Of course, the problem with this kind of architecture is that you have to do you own line buffering, getline-style editing, history etc.
However, here's a more convenient alternative. It uses a thread to send any input from STDIN to a selectable socket. With the advantages that a) you don't need to set up callbacks or artificial timers; b) all the standard command line handling is available to the user; c) line buffering and re-assembly is taken care of:
#! perl -slw
use strict;
use threads;
use IO::Socket;
use IO::Select;
$|++;
sub selectableSTDIN {
my $true = 1;
my $in = IO::Socket::INET->new(
LocalAddr => '127.0.0.1:65521',
Proto => "udp",
) or die "Failed to bind port 65521";
ioctl( $in, 0x8004667e, \$true ) or die $!;
my $out = IO::Socket::INET->new(
PeerAddr => '127.0.0.1:65521',
Proto => "udp"
) or die "Failed to bind remote port 65521";
async {
$out->send( $_ ) while <STDIN>;
}->detach;
return $in;
}
my $sel = IO::Select->new( selectableSTDIN() );
while( 1 ) {
for my $src ( $sel->can_read( 0.1 ) ) {
print "\n", scalar <$src>;
}
printf '.';
}
__END__
C:\test>selectableSTDIN.pl
...........f.r..e.d..
fred
........b..i....l.l...
bill
..........j..o..h..n...
.
john
.......j.a...c...k...
jack
........Terminating on signal SIGINT(2)
-
-
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
| [reply] [d/l] |
HOLY COW! I'm totally inspired by your "nothing cannot be done in Perl" attitude.
It took me some time to digest that code, and I finally came up with my interpretation of that. I hope this helps many others who are on the same (average) level as me and facing the same problem too!
#!/usr/bin/perl
use strict;
use warnings;
use Carp;
use English '-no_match_vars';
use charnames ':full';
use Readonly;
use Readonly::XS;
use threads;
use IO::Socket;
use version; Readonly::Scalar our $VERSION => qv(0.0_1);
$OUTPUT_AUTOFLUSH = 1;
# IOCTL code to enable or disable non-blocking mode on a socket
Readonly::Scalar my $FIONBIO => 0x80_046_67e;
# Create a UDP server socket as input??? Pick a random port number
my $in_sock = IO::Socket::INET->new(
LocalAddr => 'localhost',
LocalPort => 0,
Proto => 'udp'
) or croak 'Failed to open port';
# Enable the newly created input socket's non-blocking mode
my $true = 1;
( ioctl $in_sock, $FIONBIO, \$true ) or croak $ERRNO;
# Create a UDP client socket as output??? Bind it to the input socket
+created
# earlier
my $out_sock = IO::Socket::INET->new(
PeerAddr => 'localhost',
PeerPort => $in_sock->sockport(),
Proto => 'udp'
) or croak "Failed to bind remote port $in_sock->sockport()";
# Don't really get the mechanics behind these. Just copy and apply for
+ now
threads::async {
while (<>) {
$out_sock->send($_);
}
}
->threads::detach;
# A simple test to prove that it is non-blocking
while (1) {
sleep 1;
print "\N{FULL STOP}";
}
1;
While the script is running, I can even hit Backspace to erase the contents on the screen! | [reply] [d/l] |