1N/A
1N/A# IO::Poll.pm
1N/A#
1N/A# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
1N/A# This program is free software; you can redistribute it and/or
1N/A# modify it under the same terms as Perl itself.
1N/A
1N/Apackage IO::Poll;
1N/A
1N/Ause strict;
1N/Ause IO::Handle;
1N/Ause Exporter ();
1N/Aour(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
1N/A
1N/A@ISA = qw(Exporter);
1N/A$VERSION = "0.06";
1N/A
1N/A@EXPORT = qw( POLLIN
1N/A POLLOUT
1N/A POLLERR
1N/A POLLHUP
1N/A POLLNVAL
1N/A );
1N/A
1N/A@EXPORT_OK = qw(
1N/A POLLPRI
1N/A POLLRDNORM
1N/A POLLWRNORM
1N/A POLLRDBAND
1N/A POLLWRBAND
1N/A POLLNORM
1N/A );
1N/A
1N/A# [0] maps fd's to requested masks
1N/A# [1] maps fd's to returned masks
1N/A# [2] maps fd's to handles
1N/Asub new {
1N/A my $class = shift;
1N/A
1N/A my $self = bless [{},{},{}], $class;
1N/A
1N/A $self;
1N/A}
1N/A
1N/Asub mask {
1N/A my $self = shift;
1N/A my $io = shift;
1N/A my $fd = fileno($io);
1N/A if (@_) {
1N/A my $mask = shift;
1N/A if($mask) {
1N/A $self->[0]{$fd}{$io} = $mask; # the error events are always returned
1N/A $self->[1]{$fd} = 0; # output mask
1N/A $self->[2]{$io} = $io; # remember handle
1N/A } else {
1N/A delete $self->[0]{$fd}{$io};
1N/A unless(%{$self->[0]{$fd}}) {
1N/A # We no longer have any handles for this FD
1N/A delete $self->[1]{$fd};
1N/A delete $self->[0]{$fd};
1N/A }
1N/A delete $self->[2]{$io};
1N/A }
1N/A }
1N/A
1N/A return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io};
1N/A return $self->[0]{$fd}{$io};
1N/A}
1N/A
1N/A
1N/Asub poll {
1N/A my($self,$timeout) = @_;
1N/A
1N/A $self->[1] = {};
1N/A
1N/A my($fd,$mask,$iom);
1N/A my @poll = ();
1N/A
1N/A while(($fd,$iom) = each %{$self->[0]}) {
1N/A $mask = 0;
1N/A $mask |= $_ for values(%$iom);
1N/A push(@poll,$fd => $mask);
1N/A }
1N/A
1N/A my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0;
1N/A
1N/A return $ret
1N/A unless $ret > 0;
1N/A
1N/A while(@poll) {
1N/A my($fd,$got) = splice(@poll,0,2);
1N/A $self->[1]{$fd} = $got if $got;
1N/A }
1N/A
1N/A return $ret;
1N/A}
1N/A
1N/Asub events {
1N/A my $self = shift;
1N/A my $io = shift;
1N/A my $fd = fileno($io);
1N/A exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io}
1N/A ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL)
1N/A : 0;
1N/A}
1N/A
1N/Asub remove {
1N/A my $self = shift;
1N/A my $io = shift;
1N/A $self->mask($io,0);
1N/A}
1N/A
1N/Asub handles {
1N/A my $self = shift;
1N/A return values %{$self->[2]} unless @_;
1N/A
1N/A my $events = shift || 0;
1N/A my($fd,$ev,$io,$mask);
1N/A my @handles = ();
1N/A
1N/A while(($fd,$ev) = each %{$self->[1]}) {
1N/A while (($io,$mask) = each %{$self->[0]{$fd}}) {
1N/A $mask |= POLLHUP|POLLERR|POLLNVAL; # must allow these
1N/A push @handles,$self->[2]{$io} if ($ev & $mask) & $events;
1N/A }
1N/A }
1N/A return @handles;
1N/A}
1N/A
1N/A1;
1N/A
1N/A__END__
1N/A
1N/A=head1 NAME
1N/A
1N/AIO::Poll - Object interface to system poll call
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A use IO::Poll qw(POLLRDNORM POLLWRNORM POLLIN POLLHUP);
1N/A
1N/A $poll = new IO::Poll;
1N/A
1N/A $poll->mask($input_handle => POLLIN);
1N/A $poll->mask($output_handle => POLLOUT);
1N/A
1N/A $poll->poll($timeout);
1N/A
1N/A $ev = $poll->events($input);
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AC<IO::Poll> is a simple interface to the system level poll routine.
1N/A
1N/A=head1 METHODS
1N/A
1N/A=over 4
1N/A
1N/A=item mask ( IO [, EVENT_MASK ] )
1N/A
1N/AIf EVENT_MASK is given, then, if EVENT_MASK is non-zero, IO is added to the
1N/Alist of file descriptors and the next call to poll will check for
1N/Aany event specified in EVENT_MASK. If EVENT_MASK is zero then IO will be
1N/Aremoved from the list of file descriptors.
1N/A
1N/AIf EVENT_MASK is not given then the return value will be the current
1N/Aevent mask value for IO.
1N/A
1N/A=item poll ( [ TIMEOUT ] )
1N/A
1N/ACall the system level poll routine. If TIMEOUT is not specified then the
1N/Acall will block. Returns the number of handles which had events
1N/Ahappen, or -1 on error.
1N/A
1N/A=item events ( IO )
1N/A
1N/AReturns the event mask which represents the events that happend on IO
1N/Aduring the last call to C<poll>.
1N/A
1N/A=item remove ( IO )
1N/A
1N/ARemove IO from the list of file descriptors for the next poll.
1N/A
1N/A=item handles( [ EVENT_MASK ] )
1N/A
1N/AReturns a list of handles. If EVENT_MASK is not given then a list of all
1N/Ahandles known will be returned. If EVENT_MASK is given then a list
1N/Aof handles will be returned which had one of the events specified by
1N/AEVENT_MASK happen during the last call ti C<poll>
1N/A
1N/A=back
1N/A
1N/A=head1 SEE ALSO
1N/A
1N/AL<poll(2)>, L<IO::Handle>, L<IO::Select>
1N/A
1N/A=head1 AUTHOR
1N/A
1N/AGraham Barr. Currently maintained by the Perl Porters. Please report all
1N/Abugs to <perl5-porters@perl.org>.
1N/A
1N/A=head1 COPYRIGHT
1N/A
1N/ACopyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
1N/AThis program is free software; you can redistribute it and/or
1N/Amodify it under the same terms as Perl itself.
1N/A
1N/A=cut