in reply to Re^6: ... (Proof!)
in thread Non-blocking Reads from Pipe Filehandle

I used 0. Didn't work.

Probably because your protoype is wrong.

This: my $f = Win32::API->new('kernel32', 'PeekNamedPipe', 'LLLLLL', 'L')

Should be this: my $f = Win32::API->new('kernel32', 'PeekNamedPipe', 'LPLPPP', 'L')

Fix that, and your 'fix' above is unnecessary.

Just another hack at a module that worked fine for the most part before people start trying 'fix it' without enough knowledge to do so.

I wouldn't call it excitement. More depression when I see people proffering this kind unnecessary complexity: 

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

BEGIN {
   # BOOL PeekNamedPipe(
   #    HANDLE  hNamedPipe,
   #    LPVOID  lpBuffer,
   #    DWORD   nBufferSize,
   #    LPDWORD lpBytesRead,
   #    LPDWORD lpTotalBytesAvail,
   #    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;
   }
}

[download]

for the sake of a little reading, and a couple of zeros. The icing on the cake is when they try to claim the technical high ground as justifiction for 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."

Replies are listed 'Best First'.
Re^8: ... (Proof!)
by ikegami (Patriarch) on Oct 01, 2008 at 05:31 UTC

    My original code, the one with the problem, was 

    Win32::API->Import(
   'kernel32',
   'BOOL PeekNamedPipe(
      HANDLE  hNamedPipe,
      LPVOID  lpBuffer,
      DWORD   nBufferSize,
      LPDWORD lpBytesRead,
      LPDWORD lpTotalBytesAvail,
      LPDWORD lpBytesLeftThisMessage
   )',
);

    [download]

    There's no way to pass NULL when using that syntax. Using that syntax is what sets has_proto. I may not have found the optimal *workaround*, but that doesn't mean the bug isn't there. I didn't use LPLPPP because I assumed it was buggy too.

    More depression when I see people proffering this kind unnecessary complexity:

    If you think LPLPPP is shorter... 

    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', 'LPLPPP', 'L')
      or die $^E;

   sub PeekNamedPipe {
      my $vBuffer           = defined($_[1]) ? $vBuffer          : 0;
      my $nBytesRead        = defined($_[3]) ? pack('L!', $_[3]) : 0;
      my $nTotalBytesAvail  = defined($_[4]) ? pack('L!', $_[4]) : 0;
      my $nBytesLeftThisMsg = defined($_[5]) ? pack('L!', $_[5]) : 0;

      my $rv = $f->Call(
         $_[0],
         $vBuffer,
         $_[2],
         $nBytesRead,
         $nTotalBytesAvail,
         $nBytesLeftThisMsg,
      );

      $_[1] = $vBuffer                         if defined $_[1];
      $_[3] = unpack('L!', $nBytesRead       ) if defined $_[3];
      $_[4] = unpack('L!', $nTotalBytesAvail ) if defined $_[4];
      $_[5] = unpack('L!', $nBytesLeftThisMsg) if defined $_[5];

      return $rv;      
   }
}

    [download]

    That's why I prefer to use the prototype approach. It's much simpler. It handles packing pointers. It just doesn't handle NULL.

    I agree with you. Avoiding this complexity would be much better, but a bug is preventing me.

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom