[poe-commits] poe/t/10_units/04_drivers 01_sysrw.t,1.2,1.3
Brought to you by:
rcaputo
From: <rc...@us...> - 2004-11-22 00:09:35
|
Update of /cvsroot/poe/poe/t/10_units/04_drivers In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16225/t/10_units/04_drivers Modified Files: 01_sysrw.t Log Message: In these enlightened times of ActivePerl 5.8.4, $handle->blocking() seems not to do anything useful. This commit undoes the blocking() calls that were introduced when ActivePerl 5.8.0 broke the original ioctl() calls and actually seemed to honor blocking(). ActivePerl, she is such a fickle mistress. Index: 01_sysrw.t =================================================================== RCS file: /cvsroot/poe/poe/t/10_units/04_drivers/01_sysrw.t,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** 01_sysrw.t 12 Oct 2004 05:18:51 -0000 1.2 --- 01_sysrw.t 22 Nov 2004 00:08:07 -0000 1.3 *************** *** 98,103 **** die "can't open a pipe: $!" unless $r; ! $w->blocking(0); ! $r->blocking(0); # Number of flushed octets == number of read octets. --- 98,103 ---- die "can't open a pipe: $!" unless $r; ! nonblocking($w); ! nonblocking($r); # Number of flushed octets == number of read octets. *************** *** 222,223 **** --- 222,273 ---- return $read; } + + # Portable nonblocking sub. blocking(0) doesn't do it all the time, + # everywhere, and it sucks. + # + # This sub sucks, too. The code is lifted almost verbatim from + # POE::Resource::FileHandles. That code should probably be made a + # library function, but where should it go? + + sub nonblocking { + my $handle = shift; + + # For DOSISH systems like OS/2. Wrapped in eval{} in case it's a + # tied handle that doesn't support binmode. + eval { binmode *$handle }; + + # Turn off blocking unless it's tied or a plain file. + unless (tied *$handle or -f $handle) { + use POSIX; + use Fcntl; + + unless ($^O eq "MSWin32") { + if ($] >= 5.008) { + $handle->blocking(0); + } + else { + # Long, drawn out, POSIX way. + my $flags = fcntl($handle, F_GETFL, 0) + or die "fcntl($handle, F_GETFL, etc.) fails: $!\n"; + until (fcntl($handle, F_SETFL, $flags | O_NONBLOCK)) { + die "fcntl($handle, FSETFL, etc) fails: $!" + unless $! == EAGAIN or $! == EWOULDBLOCK; + } + } + } + else { + # Do it the Win32 way. + my $set_it = "1"; + + # 126 is FIONBIO (some docs say 0x7F << 16) + ioctl( $handle, + 0x80000000 | (4 << 16) | (ord('f') << 8) | 126, + $set_it + ) + or die "ioctl($handle, FIONBIO, $set_it) fails: $!\n"; + } + } + + # Turn off buffering. + CORE::select((CORE::select($handle), $| = 1)[0]); + } |