home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 December / PCpro_2006_12.ISO / ossdvd / server / Perl2 / site / lib / Tk / Event / io.pm
Encoding:
Perl POD Document  |  2000-05-01  |  1.9 KB  |  123 lines
  1. package Tk::Event::IO;
  2.  
  3. use vars qw($VERSION @EXPORT_OK);
  4. $VERSION = '3.036'; # $Id: //depot/Tk8/Event/Event/IO.pm#12 $ +24
  5.  
  6. use base qw(Exporter);
  7. use Symbol ();
  8.  
  9. @EXPORT_OK = qw(READABLE WRITABLE);
  10.  
  11. sub PrintArgs
  12. {
  13.  my $func = (caller(1))[3];
  14.  print "$func(",join(',',@_),")\n";
  15. }
  16.  
  17. sub PRINT
  18. {
  19.  my $obj = shift;
  20.  $obj->wait(WRITABLE);
  21.  my $h = $obj->handle;
  22.  return print $h @_;
  23. }
  24.  
  25. sub PRINTF
  26. {
  27.  my $obj = shift;
  28.  $obj->wait(WRITABLE);
  29.  my $h = $obj->handle;
  30.  return printf $h @_;
  31. }
  32.  
  33. sub WRITE
  34. {
  35.  my $obj = $_[0];
  36.  $obj->wait(WRITABLE);
  37.  return syswrite($obj->handle,$_[1],$_[2]);
  38. }
  39.  
  40. my $depth = 0;
  41. sub READLINE
  42. {
  43.  my $obj = shift;
  44.  $obj->wait(READABLE);
  45.  my $h = $obj->handle;
  46.  my $w = <$h>;
  47.  return $w;
  48. }
  49.  
  50. sub READ
  51. {
  52.  my $obj = $_[0];
  53.  $obj->wait(READABLE);
  54.  my $h = $obj->handle;
  55.  return sysread($h,$_[1],$_[2],defined $_[3] ? $_[3] : 0);
  56. }
  57.  
  58. sub GETC
  59. {
  60.  my $obj = $_[0];
  61.  $obj->wait(READABLE);
  62.  my $h = $obj->handle;
  63.  return getc($h);
  64. }
  65.  
  66. sub CLOSE
  67. {
  68.  my $obj = shift;
  69.  $obj->unwatch;
  70.  my $h = $obj->handle;
  71.  return close($h);
  72. }
  73.  
  74. sub EOF
  75. {
  76.  my $obj = shift;
  77.  my $h = $obj->handle;
  78.  return eof($h);
  79. }
  80.  
  81. sub FILENO
  82. {
  83.  my $obj = shift;
  84.  my $h = $obj->handle;
  85.  return fileno($h);
  86. }
  87.  
  88. sub imode
  89. {
  90.  my $mode = shift;
  91.  my $imode = ${{'readable' => READABLE(),
  92.                 'writable' => WRITABLE()}}{$mode};
  93.  croak("Invalid handler type '$mode'") unless (defined $imode);
  94.  return $imode;
  95. }
  96.  
  97. sub fileevent
  98. {
  99.  my ($widget,$file,$mode,$cb) = @_;
  100.  my $imode = imode($mode);
  101.  unless (ref $file)
  102.   {
  103.    no strict 'refs';
  104.    $file = Symbol::qualify($file,(caller)[0]);
  105.    $file = \*{$file};
  106.   }
  107.  my $obj = tied(*$file);
  108.  $obj = tie *$file,'Tk::Event::IO', $file unless $obj && $obj->isa('Tk::Event::IO');
  109.  if (@_ == 3)
  110.   {
  111.    return $obj->handler($imode);
  112.   }
  113.  else
  114.   {
  115.    my $h = $obj->handler($imode,$cb);
  116.    undef $obj;
  117.    untie *$file unless $h;
  118.   }
  119. }
  120.  
  121. 1;
  122. __END__
  123.