Re^2: Non-blocking Reads from Pipe Filehandle

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]

Comment on Re^2: Non-blocking Reads from Pipe Filehandle Select or Download Code

Replies are listed 'Best First'.
Re^3: Non-blocking Reads from Pipe Filehandle by BrowserUk (Patriarch) on Oct 01, 2008 at 01:04 UTC
Wrong! Win32::API does no defined check. Hm, Maybe you're right, but it doesn't seem to be necessary. With your insight about buffering & EOF and a little wrapping, this seems to work quite nicely: #! perl -slw use strict; use Win32API::File qw[ GetOsFHandle ]; use Win32::API::Prototype; ApiLink( 'Kernel32', q[ BOOL PeekNamedPipe( HANDLE hNamedPipe, LPVOID lpBuffer, DWORD nBufferSize, LPDWORD lpBytesRead, DWORD *lpTotalBytesAvail, LPDWORD lpBytesLeftThisMessage ) ] ) or die $^E; sub readlineMaybe { my $fh = shift; my $osfh = GetOsFHandle( $fh ) or die $^E; my( $bufsize, $buffer, $cAvail, $read ) = ( 1024, chr(0)x1024, 0, +0 ); PeekNamedPipe( $osfh, $buffer, $bufsize, $read, $cAvail, 0 ) or $^E == 109 or die $^E; return if $^E == 109; my $eolPos = 1+index $buffer, $/; return '' unless $eolPos; sysread( $fh, $buffer, $eolPos ) or die $!; return $buffer; } my $cmd = 'perl -le"$\|++;print localtime().q[: some text] and sleep 1 for 1..1 +0" \|'; my $pid = open my $pipe, $cmd or die $!; while( defined( my $line = readlineMaybe( $pipe ) ) ) { Win32::Sleep( 100 ) and next unless $line; chomp $line; chop $line; ## Annoying! print "Got: '$line'"; } __END__ c:\test>buk-pipe.pl Got: 'Wed Oct 1 02:01:21 2008: some text' Got: 'Wed Oct 1 02:01:22 2008: some text' Got: 'Wed Oct 1 02:01:23 2008: some text' Got: 'Wed Oct 1 02:01:24 2008: some text' Got: 'Wed Oct 1 02:01:25 2008: some text' Got: 'Wed Oct 1 02:01:26 2008: some text' Got: 'Wed Oct 1 02:01:27 2008: some text' Got: 'Wed Oct 1 02:01:28 2008: some text' Got: 'Wed Oct 1 02:01:29 2008: some text' Got: 'Wed Oct 1 02:01:30 2008: some text' [download] The only annoying thing is the need for that chop in addition to chomp. 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. "Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."	[reply] [d/l]
Re^4: Non-blocking Reads from Pipe Filehandle by ikegami (Patriarch) on Oct 01, 2008 at 02:07 UTC
Hm, Maybe you're right, but it doesn't seem to be necessary It stopped your program from working for over a year. It's forcing you to have to OS do unnecessary and possible unwanted work. It's definitely a necessity even though though it could be fudged this time.	[reply]
Re^5: ... (Proof!) by BrowserUk (Patriarch) on Oct 01, 2008 at 03:40 UTC
It's definitely a necessity even though though it could be fudged this time. For the record. This is from API.XS: `case T_POINTER: ## If pointer params[i].t = T_POINTER; origST[i] = ST(i+1); if(has_proto) { pointerCallPack(ST(i+1), i, intypes); params[i].p = (char ) SvPV_nolen(ST(i+1)); } else { ## and no proto if(SvIOK(ST(i+1)) && SvIV(ST(i+1)) == 0) { ## and IV is OK +and zero params[i].p = NULL; ## use NULL } else { params[i].p = (char ) SvPV_nolen(ST(i+1)); ## else use th +e address of the PV } }` [download] So, if you work with the module instead of fighting it, and use 0 (zero) instead of undef to indicate that you want this pointer parameter set to null, that's what it does! Ie. it's not a "fudge", but how the author designed it! 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. "Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."	[reply] [d/l]
Re^6: ... (Proof!) by ikegami (Patriarch) on Oct 01, 2008 at 04:00 UTC
Re^7: ... (Proof!) by BrowserUk (Patriarch) on Oct 01, 2008 at 04:59 UTC
Some notes below your chosen depth have not been shown here
Re^6: ... (Proof!) by ikegami (Patriarch) on Oct 01, 2008 at 06:25 UTC
Re^7: ... (Proof!) by BrowserUk (Patriarch) on Oct 01, 2008 at 07:34 UTC
Re^5:Non-blocking Reads from Pipe Filehandle by BrowserUk (Patriarch) on Oct 01, 2008 at 02:31 UTC
It stopped your program from working for over a year. It's forcing you to have to OS do unnecessary and possible unwanted work. It's definitely a necessity even though though it could be fudged this time. Oh dear. You really do talk bollocks sometimes! My "program" was a throw away attempt at something to which I already had (and posted) a simpler, better alternative. What stopped that throw-away from working, for the whole 10 minutes I spent on it, had absolutely nothing to do with all your ballshit above about "having to manage your own buffers". As I demonstrated, that is all completely unnecessary. You (and your mentor) just like doing things the hard way for some reason. 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. "Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."	[reply]