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