This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update to perllocale.pod
[perl5.git] / ext / IO / lib / IO / Select.pm
CommitLineData
8add82fc
PP
1# IO::Select.pm
2
3package IO::Select;
4
5=head1 NAME
6
27d4819a 7IO::Select - OO interface to the select system call
8add82fc 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
27d4819a 34The constructor creates a new object and optionally initialises it with a set
8add82fc
PP
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
27d4819a 121Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
8add82fc
PP
122
123=head1 REVISION
124
27d4819a 125$Revision: 1.9 $
8add82fc
PP
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
27d4819a 139$VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/);
8add82fc
PP
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;
27d4819a 201 my $r = $vec->[VEC_BITS];
8add82fc 202
27d4819a 203 defined($r) && (select($r,undef,undef,$timeout) > 0)
8add82fc
PP
204 ? _handles($vec, $r)
205 : ();
206}
207
208sub can_write
209{
210 my $vec = shift;
211 my $timeout = shift;
27d4819a 212 my $w = $vec->[VEC_BITS];
8add82fc 213
27d4819a 214 defined($w) && (select(undef,$w,undef,$timeout) > 0)
8add82fc
PP
215 ? _handles($vec, $w)
216 : ();
217}
218
219sub has_error
220{
221 my $vec = shift;
222 my $timeout = shift;
27d4819a 223 my $e = $vec->[VEC_BITS];
8add82fc 224
27d4819a 225 defined($e) && (select(undef,undef,$e,$timeout) > 0)
8add82fc
PP
226 ? _handles($vec, $e)
227 : ();
228}
229
760ac839
LW
230sub count
231{
232 my $vec = shift;
233 $vec->[FD_COUNT];
234}
235
8add82fc
PP
236sub _max
237{
238 my($a,$b,$c) = @_;
239 $a > $b
240 ? $a > $c
241 ? $a
242 : $c
243 : $b > $c
244 ? $b
245 : $c;
246}
247
248sub select
249{
250 shift
251 if defined $_[0] && !ref($_[0]);
252
253 my($r,$w,$e,$t) = @_;
254 my @result = ();
255
760ac839
LW
256 my $rb = defined $r ? $r->[VEC_BITS] : undef;
257 my $wb = defined $w ? $e->[VEC_BITS] : undef;
258 my $eb = defined $e ? $w->[VEC_BITS] : undef;
8add82fc
PP
259
260 if(select($rb,$wb,$eb,$t) > 0)
261 {
262 my @r = ();
263 my @w = ();
264 my @e = ();
760ac839
LW
265 my $i = _max(defined $r ? scalar(@$r)-1 : 0,
266 defined $w ? scalar(@$w)-1 : 0,
267 defined $e ? scalar(@$e)-1 : 0);
8add82fc 268
760ac839 269 for( ; $i >= FIRST_FD ; $i--)
8add82fc 270 {
760ac839 271 my $j = $i - FIRST_FD;
8add82fc 272 push(@r, $r->[$i])
760ac839 273 if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
8add82fc 274 push(@w, $w->[$i])
760ac839 275 if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
8add82fc 276 push(@e, $e->[$i])
760ac839 277 if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
8add82fc
PP
278 }
279
280 @result = (\@r, \@w, \@e);
281 }
282 @result;
283}
284
285sub _handles
286{
287 my $vec = shift;
288 my $bits = shift;
289 my @h = ();
290 my $i;
291
760ac839 292 for($i = scalar(@$vec) - 1 ; $i >= FIRST_FD ; $i--)
8add82fc
PP
293 {
294 next unless defined $vec->[$i];
295 push(@h, $vec->[$i])
760ac839 296 if vec($bits,$i - FIRST_FD,1);
8add82fc
PP
297 }
298
299 @h;
300}
301
3021;