home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / auto / LWP / IO / write.al < prev   
Text File  |  1997-11-28  |  909b  |  39 lines
  1. # NOTE: Derived from ./blib/lib/LWP/IO.pm.  Changes made here will be lost.
  2. package LWP::IO;
  3.  
  4. sub write
  5. {
  6.     my $fd = shift;
  7.     my $timeout = $_[1];  # we don't want to copy data in $_[0]
  8.  
  9.     my $len = length $_[0];
  10.     my $offset = 0;
  11.     while ($offset < $len) {
  12.     my $win = '';
  13.     vec($win, fileno($fd), 1) = 1;
  14.     my $err;
  15.     my $nfound = select(undef, $win, $err = $win, $timeout);
  16.     if ($nfound == 0) {
  17.         die "Timeout";
  18.     } elsif ($nfound < 0) {
  19.         die "Select failed: $!";
  20.     } elsif ($err =~ /[^\0]/) {
  21.         die "Exception while writing on socket handle";
  22.     } else {
  23.         my $n = syswrite($fd, $_[0], $len-$offset, $offset);
  24.         return $bytes_written unless defined $n;
  25.  
  26.         if ($LWP::Debug::current_level{'conns'}) {
  27.         LWP::Debug::conns("Write $n bytes: '" .
  28.                   substr($_[0], $offset, $n) .
  29.                   "'");
  30.         }
  31.         $offset += $n;
  32.     }
  33.     }
  34.     $offset;
  35. }
  36.  
  37. 1;
  38. 1;
  39.