home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / LWP / IO.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  2.1 KB  |  98 lines
  1. package LWP::IO;
  2.  
  3.  
  4. require LWP::Debug;
  5. use AutoLoader ();
  6. *AUTOLOAD = \&AutoLoader::AUTOLOAD;  # import the AUTOLOAD method
  7.  
  8. sub read;
  9. sub write;
  10.  
  11. 1;
  12. __END__
  13.  
  14. =head1 NAME
  15.  
  16. LWP::IO - Low level I/O capability
  17.  
  18. =head1 SYNOPSIS
  19.  
  20.  use LWP::IO ();
  21.  
  22. =head1 DESCRIPTION
  23.  
  24. =head2 LWP::IO::read($fd, $data, $size, $offset, $timeout)
  25.  
  26. =head2 LWP::IO::write($fd, $data, $timeout)
  27.  
  28. These routines provide low level I/O with timeout capability for the
  29. LWP library.  These routines will only be installed if they are not
  30. already defined.  This fact can be used by programs that need to
  31. override these functions.  Just provide replacement functions before
  32. you require LWP. See also L<LWP::TkIO>.
  33.  
  34. =cut
  35.  
  36. sub read
  37. {
  38.     my $fd      = shift;
  39.     my $size    = $_[1];
  40.     my $offset  = $_[2] || 0;
  41.     my $timeout = $_[3];
  42.  
  43.     my $rin = '';
  44.     vec($rin, fileno($fd), 1) = 1;
  45.     my $err;
  46.     my $nfound = select($rin, undef, $err = $rin, $timeout);
  47.     if ($nfound == 0) {
  48.     die "Timeout";
  49.     } elsif ($nfound < 0) {
  50.     die "Select failed: $!";
  51.     } elsif ($err =~ /[^\0]/) {
  52.     die "Exception while reading on socket handle";
  53.     } else {
  54.     my $n = sysread($fd, $_[0], $size, $offset);
  55.     if ($LWP::Debug::current_level{'conns'}) {
  56.         LWP::Debug::debug("Read $n bytes");
  57.         LWP::Debug::conns($_[0]) if $n;
  58.     }
  59.     return $n;
  60.     }
  61. }
  62.  
  63.  
  64. sub write
  65. {
  66.     my $fd = shift;
  67.     my $timeout = $_[1];  # we don't want to copy data in $_[0]
  68.  
  69.     my $len = length $_[0];
  70.     my $offset = 0;
  71.     while ($offset < $len) {
  72.     my $win = '';
  73.     vec($win, fileno($fd), 1) = 1;
  74.     my $err;
  75.     my $nfound = select(undef, $win, $err = $win, $timeout);
  76.     if ($nfound == 0) {
  77.         die "Timeout";
  78.     } elsif ($nfound < 0) {
  79.         die "Select failed: $!";
  80.     } elsif ($err =~ /[^\0]/) {
  81.         die "Exception while writing on socket handle";
  82.     } else {
  83.         my $n = syswrite($fd, $_[0], $len-$offset, $offset);
  84.         return $bytes_written unless defined $n;
  85.  
  86.         if ($LWP::Debug::current_level{'conns'}) {
  87.         LWP::Debug::conns("Write $n bytes: '" .
  88.                   substr($_[0], $offset, $n) .
  89.                   "'");
  90.         }
  91.         $offset += $n;
  92.     }
  93.     }
  94.     $offset;
  95. }
  96.  
  97. 1;
  98.