Хороша фигня и полезна.

..
Данный скрипт отлично работает в Nix, в windows при использованиия cygwin.

При использовании Activeperl работать не будет, ето связано с неблокирующими сокетами, почитать можно здесь тыц

sub transfer {
my ($rfh, $wfh) = @_;
my $total = 0;
my $bytes;

while ($bytes = sysread $rfh, my $data, $bufsize) {
$total += $bytes;

while ($bytes > 0) {
my $written = syswrite $wfh, $data, $bytes, length($data) - $bytes;
die "write error: $!" if !defined $written && !$!{EAGAIN};
$bytes -= $written if defined $written;
}
}

verbose(1, sprintf 'xfer %d %d %d', fileno $rfh, fileno $wfh, $total);

return defined $bytes?0:1;

}

sub nonblock {

my $fh = shift;

if ($^O eq 'MSWin32') {

my $nonblocking = pack("L",1);

ioctl($fh, 0x8004667e, unpack("I",pack('P',$nonblocking))) == 0 or die "ioctlsocket(\$sock, FIONBIO,...):$!" ;

}

else{

my $flags = fcntl $fh, F_GETFL, 0 or

die "fcntl error: $!";

fcntl $fh, F_SETFL, $flags | O_NONBLOCK or

die "fcntl error: $!";

}

return $fh;

}