home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Archived / Updates / Perl / libwww_for_perl_109 / site_perl / LWP / IO.pm < prev    next >
Text File  |  1998-04-17  |  2KB  |  107 lines
  1. package LWP::IO;
  2.  
  3. # $Id: IO.pm,v 1.10 1997/12/02 13:22:52 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. The following functions are available:
  26.  
  27. =over 4
  28.  
  29. =item LWP::IO::read($fd, $data, $size, $offset, $timeout)
  30.  
  31. =item LWP::IO::write($fd, $data, $timeout)
  32.  
  33. =back
  34.  
  35. These routines provide low level I/O with timeout capability for the
  36. LWP library.  These routines will only be installed if they are not
  37. already defined.  This fact can be used by programs that need to
  38. override these functions.  Just provide replacement functions before
  39. you require LWP. See also L<LWP::TkIO>.
  40.  
  41. =cut
  42.  
  43. sub read
  44. {
  45.     my $fd      = shift;
  46.     # data is now $_[0]
  47.     my $size    = $_[1];
  48.     my $offset  = $_[2] || 0;
  49.     my $timeout = $_[3];
  50.  
  51.     my $rin = '';
  52.     vec($rin, fileno($fd), 1) = 1;
  53.     my $err;
  54.     my $nfound = select($rin, undef, $err = $rin, $timeout);
  55.     if ($nfound == 0) {
  56.     die "Timeout";
  57.     } elsif ($nfound < 0) {
  58.     die "Select failed: $!";
  59.     } elsif ($err =~ /[^\0]/) {
  60.     die "Exception while reading on socket handle";
  61.     } else {
  62.     my $n = sysread($fd, $_[0], $size, $offset);
  63.     # Since so much data might pass here we cheat about debugging
  64.     if ($LWP::Debug::current_level{'conns'}) {
  65.         LWP::Debug::debug("Read $n bytes");
  66.         LWP::Debug::conns($_[0]) if $n;
  67.     }
  68.     return $n;
  69.     }
  70. }
  71.  
  72.  
  73. sub write
  74. {
  75.     my $fd = shift;
  76.     my $timeout = $_[1];  # we don't want to copy data in $_[0]
  77.  
  78.     my $len = length $_[0];
  79.     my $offset = 0;
  80.     while ($offset < $len) {
  81.     my $win = '';
  82.     vec($win, fileno($fd), 1) = 1;
  83.     my $err;
  84.     my $nfound = select(undef, $win, $err = $win, $timeout);
  85.     if ($nfound == 0) {
  86.         die "Timeout";
  87.     } elsif ($nfound < 0) {
  88.         die "Select failed: $!";
  89.     } elsif ($err =~ /[^\0]/) {
  90.         die "Exception while writing on socket handle";
  91.     } else {
  92.         my $n = syswrite($fd, $_[0], $len-$offset, $offset);
  93.         return $bytes_written unless defined $n;
  94.  
  95.         if ($LWP::Debug::current_level{'conns'}) {
  96.         LWP::Debug::conns("Write $n bytes: '" .
  97.                   substr($_[0], $offset, $n) .
  98.                   "'");
  99.         }
  100.         $offset += $n;
  101.     }
  102.     }
  103.     $offset;
  104. }
  105.  
  106. 1;
  107.