home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / HTML / IO.pm < prev   
Encoding:
Perl POD Document  |  1997-08-10  |  2.4 KB  |  114 lines
  1. package LWP::IO;
  2.  
  3. # $Id: TkIO.pm,v 1.3 1995/12/29 15:12:04 aas Exp $
  4.  
  5. require Tk;
  6. require LWP::Debug;
  7.  
  8. use MIME::QuotedPrint qw(encode_qp);
  9.  
  10. =head1 NAME
  11.  
  12. LWP::TkIO - Tk I/O routines for the LWP library
  13.  
  14. =head1 SYNOPSIS
  15.  
  16.  use Tk;
  17.  require LWP::TkIO;
  18.  require LWP::UserAgent;
  19.  
  20. =head1 DESCRIPTION
  21.  
  22. This module provide replacement functions for the LWP::IO
  23. functions. Require this module if you use Tk and want non exclusive IO
  24. behaviour from LWP.
  25.  
  26. See also L<LWP::IO>.
  27.  
  28. =cut
  29.  
  30.  
  31. sub read
  32. {
  33.     my $fd = shift;
  34.     my $dataRef = \$_[0];
  35.     my $size    =  $_[1];
  36.     my $offset  =  $_[2] || 0;
  37.     my $timeout =  $_[3];
  38.  
  39.     my $doneFlag = 0;
  40.     my $n;
  41.  
  42.     my $timer;
  43.     my $timeoutSub = sub { undef $timer };
  44.  
  45.     Tk->fileevent($fd, 'readable',
  46.           sub {
  47.                $n = sysread($fd, $$dataRef, 1, $offset);
  48.                   #     print STDERR fileno($fd)," sz=$size off=$offset n=$n:$!\n";
  49.                        if (defined $n)
  50.                         {
  51.                 #LWP::Debug::conns("Read $n bytes: '" .
  52.             #        encode_qp(substr($$dataRef, $offset, $n)) .
  53.             #        "'");
  54.                          $offset += $n;
  55.                         }
  56.                 $doneFlag = 1;
  57.               }
  58.          );
  59.     $timer = Tk->after($timeout*1000, $timeoutSub );
  60.  
  61.     Tk::DoOneEvent(0) until ($doneFlag || !defined($timer));
  62.  
  63.     Tk->fileevent($fd, 'readable', ''); # no more callbacks
  64.     die "Timeout" unless (defined $timer);
  65.     Tk->after(cancel => $timer);
  66.     return $n;
  67. }
  68.  
  69.  
  70. sub write
  71. {
  72.     my $fd = shift;
  73.     my $dataRef = \$_[0];
  74.     my $timeout =  $_[1];
  75.  
  76.     my $len = length $$dataRef;
  77.  
  78.     return 0 unless $len;
  79.  
  80.     my $offset = 0;
  81.     my $timeoutFlag = 0;
  82.     my $doneFlag = 0;
  83.  
  84.     my $timeoutSub = sub { $timeoutFlag = 1; };
  85.     my $timer;
  86.     $timer = Tk->after($timeout*1000, $timeoutSub ) if $timeout;
  87.  
  88.     Tk->fileevent($fd, 'writable',
  89.           sub {
  90.               my $n = syswrite($fd, $$dataRef, $len-$offset, $offset);
  91.               if (!defined $n) {
  92.               $done = 1;
  93.               } else {
  94.               LWP::Debug::conns("Write $n bytes: '" .
  95.                         substr($$dataRef, $offset, $n) .
  96.                         "'");
  97.               $offset += $n;
  98.               $timer = Tk->after($timeout*1000, $timeoutSub )
  99.                 if $timeout;
  100.               }
  101.           }
  102.          );
  103.  
  104.     Tk::DoOneEvent(0) until ($timeoutFlag || $doneFlag || $offset >= $len);
  105.  
  106.     Tk->fileevent($fd, 'writable', ''); # no more callbacks
  107.     Tk->after(cancel => $timer) if $timeout;
  108.  
  109.     die "Timeout" if $timeoutFlag;
  110.     $offset;
  111. }
  112.  
  113. 1;
  114.