The Win32 version to the unix ioctl() is DeviceIoControl.
To communicate with device drivers you can use the standard module:
use Win32API::File qw( :ALL );
... the rest of your perl code ...
$result = DeviceIoControl( $handle,....)
which gives you far more capabilities if your Administrator.
The ioctl() under Win32 actually maps to ioctlsocket() by the ActiveState docs.
Many earlier postings used:
$nonblocking = 1;
ioctl($socket,0x8004667e,\$nonblocking);
This will unblock the socket , but for the wrong reason .
\$nonblocking returns an address to a small memory structure that perl maintains
the variable with. That address is readable and will never have the value of zero.
As a result you get a nonblocking socket.
You will NOT get a BLOCKING socket if you use:
$nonblocking = 0; # remains non blocking !!!!
The third argument in ioctl() expects a pointer to a long.
Apparently, this is not the case for perls under UNIX, - I haven't tried that.
The correct way to use ioctl() is:
$nonblocking = "\x00\x00\x00\x01"; # pack("L",1) works too
use constant FIONBIO => 0x8004667e;
$PtrToLong = unpack("I",pack('P',$nonblocking)); # get address to the variable contents, not it's reference structure
ioctl($socket, FIONBIO,$PtrToLong );
Now that you are the wiser , you breath easy and say "GREAT" I don't have to fix any code.
Ignorance is not always bliss.
Consider what more you can do with this.
I took Steve Lidie's
Mastering Perl/Tk fileevent sockets work around for Win32.
I removed the very important polling line: my(@ready) = $sel->can_read(0);
and used:
use constant FIONREAD => 0x4004667f;
our $numbytes = "\x00" x 4; # pack('L',0) works too
ioctl($socket, FIONREAD, unpack('I',pack('P',$numbytes)));
$nbytes = unpack('I',$numbytes);
return if $nbytes == 0;
This returns how many bytes on the socket to be read, blocking or not !!!!.
If its zero bytes the Tk repeat event continues as before.
I left out the UNIX part of this code during changing it ,
but I will leave it for you to put it in(easy).
Here is a small CONSOLE Capture Tk application.
Execute as:
c:\> perl.exe TkClient.pl 2>&1 | perl.exe IO_server.pl
# TkClient.pl
# A modification of the fileevent work around on Win32, from the book
+: "Mastering Perl/Tk",
# by Steve Lidie and Nancy Walsh pp 492-493
# USAGE: open a DOS32 CONSOLE (Yes!!! CMD.EXE is 32 bit, COMMAND.COM 1
+6 bit) and type:
# c:\> perl.exe TkClient.pl 2>&1 | perl.exe IO_server.pl
# Don't forget to leave in "perl.exe" for this to work properly
use Tk ;
use Tk ':variables';
use Tk::Event;
use POSIX ":sys_wait_h";
use strict;
our $mw = MainWindow->new( -title => "Tk client");
$mw->geometry('325x250');
our $programs = $mw->Button(-text => 'EXEC CODE ', -width => 35, -acti
+vebackground => 'steelblue', -command => \&myprograms)
->place(-anchor => 'nw', -relx => 0.10, -rely => 0.60, -relwidth =
+> .28);
our $quitbttn = $mw->Button(-text => 'QUIT ', -width => 35, -activebac
+kground => 'steelblue', -command => \&exit)
->place(-anchor => 'nw', -relx => 0.10, -rely => 0.80, -relwidth =
+> .28);
################# output text box toplevel ###########
our $polling;
our $sock;
our $sel;
our $numbytes = "\x00" x 4; # pack('L' works too
my $dbgout = $mw->Toplevel;
$dbgout->title('CAPTURED FILTERED OUTPUT');
my $textdbg = $dbgout->Scrolled('Text', -scrollbars => 'osoe')->pa
+ck;
$textdbg->Subwidget("text")->configure(-width => 80, -height => 25
+ ,-wrap => 'none');
if ($^O eq 'MSWin32') {
use IO::Socket;
use constant FIONBIO => 0x8004667e; # winsock2.h macro
use constant FIONREAD => 0x4004667f; # winsock2.h macro
my $nonblocking = "\x00\x00\x00\x01"; # long nonblocking != 0;
$sock = IO::Socket::INET->new(
PeerAddr => 'localhost',
PeerPort => '10254',
Proto => 'tcp',
) or die "IO::Socket::INET: $!";
ioctl($sock, FIONBIO, unpack("I",pack('P',$nonblocking))) == 0 or
+die "ioctlsocket(\$sock, FIONBIO,...):$!" ;
$polling = $mw->repeat(50 => \&read_sock);
}
#################### EVENTLOOP ###############################
MainLoop;
exit;
#################### SUBROUTINES #############################
sub read_sock {
my $hand = $sock;
my ($stat,$buf,$content,$line,$nbytes);
if ($^O eq 'MSWin32') {
ioctl($hand, FIONREAD, unpack('I',pack('P',$numbytes))) == 0 o
+r die "ioctlsocket(\$hand, FIONREAD,...):$!" ;
$nbytes = unpack('I',$numbytes);
$nbytes == 0 ? return : $polling->cancel; # not re-entrant
}
$stat = sysread $hand, $buf, $nbytes;
$line .= $buf if $stat > 0;
$line = "sysread error: $!\n" unless defined $stat;
# filter the text using regular expressions here, then:
$textdbg->insert('end',"$line");
$textdbg->yviewMoveto(1.0);
$polling = $mw->repeat(50 => \&read_sock) if ($^O eq 'MSWin32'); #
+ restart repeat
}
sub myprograms{
# put your external calls here
# system(1, ...) returns immediately - great with Tk event loop
my $cpid;
$cpid = system(1,"echo --- Start of test ---");
TkUpdates();
$cpid = system(1,"ipconfig");
TkUpdates();
$cpid = system(1,"ping -n 3 localhost");
TkUpdates();
$cpid = system(1,"dir");
TkUpdates();
$cpid = system(1,"echo --- End of test ---");
TkUpdates();
}
sub TkUpdates{
my ($kid,$status);
do {
$kid = waitpid(-1,&WNOHANG); # wait for all child processes to f
+inish
$status = $?;
$mw->update; # LET Tk DO UPDATES
} until $kid == -1;
}
# IO_server.pl
# see also:
# http://aspn.activestate.com/ASPN/Mail/Message/perl-tk/1857686
use IO::Socket;
use File::Basename;
use strict;
our $data;
my $socket = IO::Socket::INET-> new(
Listen => 5,
Reuse => 1,
LocalPort => 10254,
Proto => 'tcp',
) or die "Couldn't open socket: $!";
print basename($0)," started\n";
my $new_sock = $socket->accept();
while ($data = <STDIN>) {
print $data; # tee
syswrite $new_sock, $data;
}