home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _b443f1a0263577dca49f9b4e2fd0721d < prev    next >
Text File  |  2000-03-15  |  4KB  |  206 lines
  1. # IO::Poll.pm
  2. #
  3. # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
  4. # This program is free software; you can redistribute it and/or
  5. # modify it under the same terms as Perl itself.
  6.  
  7. package IO::Poll;
  8.  
  9. use strict;
  10. use IO::Handle;
  11. use Exporter ();
  12. our(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
  13.  
  14. @ISA = qw(Exporter);
  15. $VERSION = "0.01";
  16.  
  17. @EXPORT = qw(poll);
  18.  
  19. @EXPORT_OK = qw(
  20.  POLLIN    
  21.  POLLPRI   
  22.  POLLOUT   
  23.  POLLRDNORM
  24.  POLLWRNORM
  25.  POLLRDBAND
  26.  POLLWRBAND
  27.  POLLNORM  
  28.  POLLERR   
  29.  POLLHUP   
  30.  POLLNVAL  
  31. );
  32.  
  33. sub new {
  34.     my $class = shift;
  35.  
  36.     my $self = bless [{},{}], $class;
  37.  
  38.     $self;
  39. }
  40.  
  41. sub mask {
  42.     my $self = shift;
  43.     my $io = shift;
  44.     my $fd = fileno($io);
  45.     if(@_) {
  46.     my $mask = shift;
  47.     $self->[0]{$fd} ||= {};
  48.     if($mask) {
  49.         $self->[0]{$fd}{$io} = $mask;
  50.     }
  51.     else {
  52.         delete $self->[0]{$fd}{$io};
  53.     }
  54.     }
  55.     elsif(exists $self->[0]{$fd}{$io}) {
  56.     return $self->[0]{$fd}{$io};
  57.     }
  58.     return;
  59. }
  60.  
  61.  
  62. sub poll {
  63.     my($self,$timeout) = @_;
  64.  
  65.     $self->[1] = {};
  66.  
  67.     my($fd,$ref);
  68.     my @poll = ();
  69.  
  70.     while(($fd,$ref) = each %{$self->[0]}) {
  71.     my $events = 0;
  72.     map { $events |= $_ } values %{$ref};
  73.     push(@poll,$fd, $events);
  74.     }
  75.  
  76.     my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0;
  77.  
  78.     return $ret
  79.     unless $ret > 0;
  80.  
  81.     while(@poll) {
  82.     my($fd,$got) = splice(@poll,0,2);
  83.     $self->[1]{$fd} = $got
  84.         if $got;
  85.     }
  86.  
  87.     return $ret;  
  88. }
  89.  
  90. sub events {
  91.     my $self = shift;
  92.     my $io = shift;
  93.     my $fd = fileno($io);
  94.  
  95.     exists $self->[1]{$fd} && exists $self->[0]{$fd}{$io}
  96.     ? $self->[1]{$fd} & $self->[0]{$fd}{$io}
  97.     : 0;
  98. }
  99.  
  100. sub remove {
  101.     my $self = shift;
  102.     my $io = shift;
  103.     $self->mask($io,0);
  104. }
  105.  
  106. sub handles {
  107.     my $self = shift;
  108.  
  109.     return map { keys %$_ } values %{$self->[0]}
  110.     unless(@_);
  111.  
  112.     my $events = shift || 0;
  113.     my($fd,$ev,$io,$mask);
  114.     my @handles = ();
  115.  
  116.     while(($fd,$ev) = each %{$self->[1]}) {
  117.     if($ev & $events) {
  118.         while(($io,$mask) = each %{$self->[0][$fd]}) {
  119.         push(@handles, $io)
  120.             if $events & $mask;
  121.         }
  122.     }
  123.     }
  124.     return @handles;
  125. }
  126.  
  127. 1;
  128.  
  129. __END__
  130.  
  131. =head1 NAME
  132.  
  133. IO::Poll - Object interface to system poll call
  134.  
  135. =head1 SYNOPSIS
  136.  
  137.     use IO::Poll qw(POLLRDNORM POLLWRNORM POLLIN POLLHUP);
  138.  
  139.     $poll = new IO::Poll;
  140.  
  141.     $poll->mask($input_handle => POLLRDNORM | POLLIN | POLLHUP);
  142.     $poll->mask($output_handle => POLLWRNORM);
  143.  
  144.     $poll->poll($timeout);
  145.  
  146.     $ev = $poll->events($input);
  147.  
  148. =head1 DESCRIPTION
  149.  
  150. C<IO::Poll> is a simple interface to the system level poll routine.
  151.  
  152. =head1 METHODS
  153.  
  154. =over 4
  155.  
  156. =item mask ( IO [, EVENT_MASK ] )
  157.  
  158. If EVENT_MASK is given, then, if EVENT_MASK is non-zero, IO is added to the
  159. list of file descriptors and the next call to poll will check for
  160. any event specified in EVENT_MASK. If EVENT_MASK is zero then IO will be
  161. removed from the list of file descriptors.
  162.  
  163. If EVENT_MASK is not given then the return value will be the current
  164. event mask value for IO.
  165.  
  166. =item poll ( [ TIMEOUT ] )
  167.  
  168. Call the system level poll routine. If TIMEOUT is not specified then the
  169. call will block. Returns the number of handles which had events
  170. happen, or -1 on error.
  171.  
  172. =item events ( IO )
  173.  
  174. Returns the event mask which represents the events that happend on IO
  175. during the last call to C<poll>.
  176.  
  177. =item remove ( IO )
  178.  
  179. Remove IO from the list of file descriptors for the next poll.
  180.  
  181. =item handles( [ EVENT_MASK ] )
  182.  
  183. Returns a list of handles. If EVENT_MASK is not given then a list of all
  184. handles known will be returned. If EVENT_MASK is given then a list
  185. of handles will be returned which had one of the events specified by
  186. EVENT_MASK happen during the last call ti C<poll>
  187.  
  188. =back
  189.  
  190. =head1 SEE ALSO
  191.  
  192. L<poll(2)>, L<IO::Handle>, L<IO::Select>
  193.  
  194. =head1 AUTHOR
  195.  
  196. Graham Barr. Currently maintained by the Perl Porters.  Please report all
  197. bugs to <perl5-porters@perl.org>.
  198.  
  199. =head1 COPYRIGHT
  200.  
  201. Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
  202. This program is free software; you can redistribute it and/or
  203. modify it under the same terms as Perl itself.
  204.  
  205. =cut
  206.