comment on

Given

Win32::API->Import(
   'mydll',
   'BOOL SomeFunction(
      LPDWORD lpCount
   )',
);
[download]

you'd call the function as follows:

my $nCount = 5;
SomeFunction($nCount);
[download]

Win32::API properly packs nCount into a DWORD and passes a pointer to that packed DWORD to the DLL function.

But what if lpCount can be NULL? Shouldn't be a problem. Scalars already have a mechanism to identify whether they contain a string or not. Just pass undef, right?

SomeFunction(undef);
[download]

Wrong! Win32::API does no defined check. It simply does pack('L', undef) and passes a pointer to that.

That means we need to do our own pointer management. In turn, that means we need to do our own packing and unpacking for pointed data.

use strict;
use warnings;

use Win32::API     qw( );
use Win32API::File qw( GetOsFHandle INVALID_HANDLE_VALUE );
use Time::HiRes    qw( sleep );


use constant ERROR_BROKEN_PIPE => 109;


sub get_pv { unpack 'L!', pack 'P', $_[0] }


BEGIN {
   # BOOL WINAPI PeekNamedPipe(
   #    __in       HANDLE  hNamedPipe,
   #    __out_opt  LPVOID  lpBuffer,
   #    __in       DWORD   nBufferSize,
   #    __out_opt  LPDWORD lpBytesRead,
   #    __out_opt  LPDWORD lpTotalBytesAvail,
   #    __out_opt  LPDWORD lpBytesLeftThisMessage
   # )

   my $f = Win32::API->new('kernel32', 'PeekNamedPipe', 'LLLLLL', 'L')
      or die $^E;

   sub PeekNamedPipe {
      my $nBytesRead;
      my $nTotalBytesAvail;
      my $nBytesLeftThisMessage;

      $nBytesRead            = pack('L!', $_[3]) if defined $_[3];
      $nTotalBytesAvail      = pack('L!', $_[4]) if defined $_[4];
      $nBytesLeftThisMessage = pack('L!', $_[5]) if defined $_[5];

      my $rv = $f->Call(
         $_[0],
         get_pv($_[1]),
         $_[2],
         get_pv($nBytesRead),
         get_pv($nTotalBytesAvail),
         get_pv($nBytesLeftThisMessage),
      );
      
      $_[3] = unpack('L!', $nBytesRead           ) if defined $_[3];
      $_[4] = unpack('L!', $nTotalBytesAvail     ) if defined $_[4];
      $_[5] = unpack('L!', $nBytesLeftThisMessage) if defined $_[5];

      return $rv;      
   }
}


my $cmd = 'perl -le"$|++;print localtime().q[: some text] and sleep 1 
+for 1..10" |';

my $pid = open my $pipe, $cmd
   or die $!;


( my $pHandle = GetOsFHandle( $pipe ) ) != INVALID_HANDLE_VALUE
   or die $^E;

print("Handle: $pHandle\n");


my $buf = '';
for (;;) {
   my $avail = 0;
   if ( !PeekNamedPipe( $pHandle, undef, 0, undef, $avail, undef ) ) {
      last if $^E == ERROR_BROKEN_PIPE;
      die $^E;
   }

   print("Avail: $avail");
   print(" (+" . length($buf) . ")") if length($buf);
   print("\n");

   if ( $avail ) {
      sysread($pipe, $buf, $avail, length($buf) )
         or die $!;

      while ( $buf =~ s/^(.*)\n// ) {
         my $line = $1;
         ## Do stuff with $line
         print( "Got: $line\n" );
      }
   }
   else {
      print( "Zzzz\n" );
      sleep(0.500);
   }
}
[download]

I had to change two things:

I got rid of buffered I/O. <$pipe> and read($pipe, ...) don't mix with select and PeekNamedPipe.
PeekNamedPipe was noticing the EOF condition first, so I moved the loop exit there.

Handle: 1980
Avail: 0
Zzzz
Avail: 37
Got: Tue Sep 30 19:23:32 2008: some text
Avail: 0
Zzzz
Avail: 0
Zzzz
Avail: 37
Got: Tue Sep 30 19:23:33 2008: some text
Avail: 0
Zzzz
Avail: 0
Zzzz
Avail: 37
Got: Tue Sep 30 19:23:34 2008: some text
Avail: 0
Zzzz
Avail: 0
Zzzz
Avail: 37
Got: Tue Sep 30 19:23:35 2008: some text
Avail: 0
Zzzz
Avail: 0
Zzzz
Avail: 37
Got: Tue Sep 30 19:23:36 2008: some text
Avail: 0
Zzzz
Avail: 0
Zzzz
Avail: 37
Got: Tue Sep 30 19:23:37 2008: some text
Avail: 0
Zzzz
Avail: 0
Zzzz
Avail: 37
Got: Tue Sep 30 19:23:38 2008: some text
Avail: 0
Zzzz
Avail: 0
Zzzz
Avail: 37
Got: Tue Sep 30 19:23:39 2008: some text
Avail: 0
Zzzz
Avail: 0
Zzzz
Avail: 37
Got: Tue Sep 30 19:23:40 2008: some text
Avail: 0
Zzzz
Avail: 0
Zzzz
Avail: 37
Got: Tue Sep 30 19:23:41 2008: some text
Avail: 0
Zzzz
Avail: 0
Zzzz
[download]

In reply to Re^2: Non-blocking Reads from Pipe Filehandle by ikegami
in thread Non-blocking Reads from Pipe Filehandle by cbudin

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.