VMS config tweak (from Craig A. Berry <craig.berry@metamorgs.com>)
[p5sagit/p5-mst-13.2.git] / ext / IO / lib / IO / Poll.pm
CommitLineData
cf7fe8a2 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
7package IO::Poll;
8
9use strict;
10use IO::Handle;
11use Exporter ();
17f410f9 12our(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
cf7fe8a2 13
14@ISA = qw(Exporter);
334f17bd 15$VERSION = "0.01";
cf7fe8a2 16
334f17bd 17@EXPORT = qw(poll);
cf7fe8a2 18
19@EXPORT_OK = qw(
334f17bd 20 POLLIN
cf7fe8a2 21 POLLPRI
334f17bd 22 POLLOUT
cf7fe8a2 23 POLLRDNORM
24 POLLWRNORM
25 POLLRDBAND
26 POLLWRBAND
27 POLLNORM
334f17bd 28 POLLERR
29 POLLHUP
30 POLLNVAL
cf7fe8a2 31);
32
33sub new {
34 my $class = shift;
35
334f17bd 36 my $self = bless [{},{}], $class;
cf7fe8a2 37
38 $self;
39}
40
41sub mask {
42 my $self = shift;
43 my $io = shift;
44 my $fd = fileno($io);
45 if(@_) {
46 my $mask = shift;
334f17bd 47 $self->[0]{$fd} ||= {};
cf7fe8a2 48 if($mask) {
334f17bd 49 $self->[0]{$fd}{$io} = $mask;
50 }
51 else {
52 delete $self->[0]{$fd}{$io};
cf7fe8a2 53 }
54 }
334f17bd 55 elsif(exists $self->[0]{$fd}{$io}) {
56 return $self->[0]{$fd}{$io};
57 }
58 return;
cf7fe8a2 59}
60
61
62sub poll {
63 my($self,$timeout) = @_;
64
65 $self->[1] = {};
66
334f17bd 67 my($fd,$ref);
cf7fe8a2 68 my @poll = ();
69
334f17bd 70 while(($fd,$ref) = each %{$self->[0]}) {
71 my $events = 0;
72 map { $events |= $_ } values %{$ref};
73 push(@poll,$fd, $events);
cf7fe8a2 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);
334f17bd 83 $self->[1]{$fd} = $got
84 if $got;
cf7fe8a2 85 }
86
87 return $ret;
88}
89
90sub events {
91 my $self = shift;
92 my $io = shift;
93 my $fd = fileno($io);
334f17bd 94
95 exists $self->[1]{$fd} && exists $self->[0]{$fd}{$io}
96 ? $self->[1]{$fd} & $self->[0]{$fd}{$io}
97 : 0;
cf7fe8a2 98}
99
100sub remove {
101 my $self = shift;
102 my $io = shift;
103 $self->mask($io,0);
104}
105
106sub handles {
107 my $self = shift;
334f17bd 108
109 return map { keys %$_ } values %{$self->[0]}
110 unless(@_);
cf7fe8a2 111
112 my $events = shift || 0;
113 my($fd,$ev,$io,$mask);
114 my @handles = ();
115
116 while(($fd,$ev) = each %{$self->[1]}) {
334f17bd 117 if($ev & $events) {
118 while(($io,$mask) = each %{$self->[0][$fd]}) {
119 push(@handles, $io)
120 if $events & $mask;
121 }
122 }
cf7fe8a2 123 }
124 return @handles;
125}
126
1271;
128
129__END__
130
131=head1 NAME
132
133IO::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
334f17bd 141 $poll->mask($input_handle => POLLRDNORM | POLLIN | POLLHUP);
142 $poll->mask($output_handle => POLLWRNORM);
cf7fe8a2 143
144 $poll->poll($timeout);
145
146 $ev = $poll->events($input);
147
148=head1 DESCRIPTION
149
150C<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
158If EVENT_MASK is given, then, if EVENT_MASK is non-zero, IO is added to the
159list of file descriptors and the next call to poll will check for
160any event specified in EVENT_MASK. If EVENT_MASK is zero then IO will be
161removed from the list of file descriptors.
162
163If EVENT_MASK is not given then the return value will be the current
164event mask value for IO.
165
166=item poll ( [ TIMEOUT ] )
167
168Call the system level poll routine. If TIMEOUT is not specified then the
169call will block. Returns the number of handles which had events
170happen, or -1 on error.
171
172=item events ( IO )
173
174Returns the event mask which represents the events that happend on IO
175during the last call to C<poll>.
176
177=item remove ( IO )
178
179Remove IO from the list of file descriptors for the next poll.
180
181=item handles( [ EVENT_MASK ] )
182
183Returns a list of handles. If EVENT_MASK is not given then a list of all
184handles known will be returned. If EVENT_MASK is given then a list
185of handles will be returned which had one of the events specified by
186EVENT_MASK happen during the last call ti C<poll>
187
188=back
189
190=head1 SEE ALSO
191
192L<poll(2)>, L<IO::Handle>, L<IO::Select>
193
194=head1 AUTHOR
195
854822f1 196Graham Barr. Currently maintained by the Perl Porters. Please report all
197bugs to <perl5-porters@perl.org>.
cf7fe8a2 198
199=head1 COPYRIGHT
200
201Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
202This program is free software; you can redistribute it and/or
203modify it under the same terms as Perl itself.
204
205=cut