This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Updated to IO-1.12.
[perl5.git] / ext / IO / lib / IO / Select.pm
CommitLineData
8add82fc
PP
1# IO::Select.pm
2
3package IO::Select;
4
5=head1 NAME
6
7IO::Select - OO interface to the system select call
8
84dc3c4d 9=head1 SYNOPSIS
8add82fc
PP
10
11 use IO::Select;
12
13 $s = IO::Select->new();
14
15 $s->add(\*STDIN);
16 $s->add($some_handle);
17
18 @ready = $s->can_read($timeout);
19
20 @ready = IO::Select->new(@handles)->read(0);
21
22=head1 DESCRIPTION
23
24The C<IO::Select> package implements an object approach to the system C<select>
25function call. It allows the user to see what IO handles, see L<IO::Handle>,
26are ready for reading, writing or have an error condition pending.
27
28=head1 CONSTRUCTOR
29
30=over 4
31
32=item new ( [ HANDLES ] )
33
34The constructor create a new object and optionally initialises it with a set
35of handles.
36
37=back
38
39=head1 METHODS
40
41=over 4
42
43=item add ( HANDLES )
44
45Add the list of handles to the C<IO::Select> object. It is these values that
46will be returned when an event occurs. C<IO::Select> keeps these values in a
47cache which is indexed by the C<fileno> of the handle, so if more than one
48handle with the same C<fileno> is specified then only the last one is cached.
49
50=item remove ( HANDLES )
51
760ac839
LW
52Remove all the given handles from the object. This method also works
53by the C<fileno> of the handles. So the exact handles that were added
54need not be passed, just handles that have an equivalent C<fileno>
8add82fc
PP
55
56=item can_read ( [ TIMEOUT ] )
57
58Return an array of handles that are ready for reading. C<TIMEOUT> is the maximum
59amount of time to wait before returning an empty list. If C<TIMEOUT> is
60not given then the call will block.
61
62=item can_write ( [ TIMEOUT ] )
63
64Same as C<can_read> except check for handles that can be written to.
65
66=item has_error ( [ TIMEOUT ] )
67
68Same as C<can_read> except check for handles that have an error condition, for
69example EOF.
70
760ac839
LW
71=item count ()
72
73Returns the number of handles that the object will check for when
74one of the C<can_> methods is called or the object is passed to
75the C<select> static method.
76
8add82fc
PP
77=item select ( READ, WRITE, ERROR [, TIMEOUT ] )
78
79C<select> is a static method, that is you call it with the package name
80like C<new>. C<READ>, C<WRITE> and C<ERROR> are either C<undef> or
81C<IO::Select> objects. C<TIMEOUT> is optional and has the same effect as
82before.
83
84The result will be an array of 3 elements, each a reference to an array
85which will hold the handles that are ready for reading, writing and have
86error conditions respectively. Upon error an empty array is returned.
87
88=back
89
90=head1 EXAMPLE
91
92Here is a short example which shows how C<IO::Select> could be used
93to write a server which communicates with several sockets while also
94listening for more connections on a listen socket
95
96 use IO::Select;
97 use IO::Socket;
98
99 $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
100 $sel = new IO::Select( $lsn );
101
102 while(@ready = $sel->can_read) {
103 foreach $fh (@ready) {
104 if($fh == $lsn) {
105 # Create a new socket
106 $new = $lsn->accept;
107 $sel->add($new);
108 }
109 else {
110 # Process socket
111
112 # Maybe we have finished with the socket
113 $sel->remove($fh);
114 $fh->close;
115 }
116 }
117 }
118
119=head1 AUTHOR
120
121Graham Barr <Graham.Barr@tiuk.ti.com>
122
123=head1 REVISION
124
125$Revision: 1.2 $
126
127=head1 COPYRIGHT
128
129Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
130software; you can redistribute it and/or modify it under the same terms
131as Perl itself.
132
133=cut
134
135use strict;
136use vars qw($VERSION @ISA);
137require Exporter;
138
139$VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
140
141@ISA = qw(Exporter); # This is only so we can do version checking
142
760ac839
LW
143sub VEC_BITS {0}
144sub FD_COUNT {1}
145sub FIRST_FD {2}
146
8add82fc
PP
147sub new
148{
149 my $self = shift;
150 my $type = ref($self) || $self;
151
760ac839 152 my $vec = bless [undef,0], $type;
8add82fc
PP
153
154 $vec->add(@_)
155 if @_;
156
157 $vec;
158}
159
160sub add
161{
162 my $vec = shift;
163 my $f;
164
760ac839
LW
165 $vec->[VEC_BITS] = '' unless defined $vec->[VEC_BITS];
166
8add82fc
PP
167 foreach $f (@_)
168 {
169 my $fn = $f =~ /^\d+$/ ? $f : fileno($f);
170 next
171 unless defined $fn;
760ac839
LW
172 vec($vec->[VEC_BITS],$fn,1) = 1;
173 $vec->[FD_COUNT] += 1
174 unless defined $vec->[$fn+FIRST_FD];
175 $vec->[$fn+FIRST_FD] = $f;
8add82fc 176 }
760ac839 177 $vec->[VEC_BITS] = undef unless $vec->count;
8add82fc
PP
178}
179
180sub remove
181{
182 my $vec = shift;
183 my $f;
184
185 foreach $f (@_)
186 {
187 my $fn = $f =~ /^\d+$/ ? $f : fileno($f);
188 next
189 unless defined $fn;
760ac839
LW
190 vec($vec->[VEC_BITS],$fn,1) = 0;
191 $vec->[$fn+FIRST_FD] = undef;
192 $vec->[FD_COUNT] -= 1;
8add82fc 193 }
760ac839 194 $vec->[VEC_BITS] = undef unless $vec->count;
8add82fc
PP
195}
196
197sub can_read
198{
199 my $vec = shift;
200 my $timeout = shift;
201
760ac839 202 my $r = $vec->[VEC_BITS] or return ();
8add82fc
PP
203
204 select($r,undef,undef,$timeout) > 0
205 ? _handles($vec, $r)
206 : ();
207}
208
209sub can_write
210{
211 my $vec = shift;
212 my $timeout = shift;
213
760ac839 214 my $w = $vec->[VEC_BITS] or return ();
8add82fc
PP
215
216 select(undef,$w,undef,$timeout) > 0
217 ? _handles($vec, $w)
218 : ();
219}
220
221sub has_error
222{
223 my $vec = shift;
224 my $timeout = shift;
225
760ac839 226 my $e = $vec->[VEC_BITS] or return ();
8add82fc
PP
227
228 select(undef,undef,$e,$timeout) > 0
229 ? _handles($vec, $e)
230 : ();
231}
232
760ac839
LW
233sub count
234{
235 my $vec = shift;
236 $vec->[FD_COUNT];
237}
238
8add82fc
PP
239sub _max
240{
241 my($a,$b,$c) = @_;
242 $a > $b
243 ? $a > $c
244 ? $a
245 : $c
246 : $b > $c
247 ? $b
248 : $c;
249}
250
251sub select
252{
253 shift
254 if defined $_[0] && !ref($_[0]);
255
256 my($r,$w,$e,$t) = @_;
257 my @result = ();
258
760ac839
LW
259 my $rb = defined $r ? $r->[VEC_BITS] : undef;
260 my $wb = defined $w ? $e->[VEC_BITS] : undef;
261 my $eb = defined $e ? $w->[VEC_BITS] : undef;
8add82fc
PP
262
263 if(select($rb,$wb,$eb,$t) > 0)
264 {
265 my @r = ();
266 my @w = ();
267 my @e = ();
760ac839
LW
268 my $i = _max(defined $r ? scalar(@$r)-1 : 0,
269 defined $w ? scalar(@$w)-1 : 0,
270 defined $e ? scalar(@$e)-1 : 0);
8add82fc 271
760ac839 272 for( ; $i >= FIRST_FD ; $i--)
8add82fc 273 {
760ac839 274 my $j = $i - FIRST_FD;
8add82fc 275 push(@r, $r->[$i])
760ac839 276 if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
8add82fc 277 push(@w, $w->[$i])
760ac839 278 if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
8add82fc 279 push(@e, $e->[$i])
760ac839 280 if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
8add82fc
PP
281 }
282
283 @result = (\@r, \@w, \@e);
284 }
285 @result;
286}
287
288sub _handles
289{
290 my $vec = shift;
291 my $bits = shift;
292 my @h = ();
293 my $i;
294
760ac839 295 for($i = scalar(@$vec) - 1 ; $i >= FIRST_FD ; $i--)
8add82fc
PP
296 {
297 next unless defined $vec->[$i];
298 push(@h, $vec->[$i])
760ac839 299 if vec($bits,$i - FIRST_FD,1);
8add82fc
PP
300 }
301
302 @h;
303}
304
3051;
760ac839 306