comment on

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; 
}
[download]

# 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;
}
[download]

In reply to Another Win32 Tk fileevent work around : using ioctl() properly by bitshiftleft

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Syntactic Confectionery Delight
	PerlMonks