This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deprecate != Depreciate.
[perl5.git] / ext / IO / lib / IO / Select.pm
CommitLineData
8add82fc 1# IO::Select.pm
7a4c00b4 2#
cf7fe8a2
GS
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.
8add82fc
PP
6
7package IO::Select;
8
8add82fc 9use strict;
d3a7d8c7 10use warnings::register;
8add82fc
PP
11use vars qw($VERSION @ISA);
12require Exporter;
13
d6a466d7 14$VERSION = "1.15";
8add82fc
PP
15
16@ISA = qw(Exporter); # This is only so we can do version checking
17
7a4c00b4
PP
18sub VEC_BITS () {0}
19sub FD_COUNT () {1}
20sub FIRST_FD () {2}
760ac839 21
8add82fc
PP
22sub new
23{
24 my $self = shift;
25 my $type = ref($self) || $self;
26
760ac839 27 my $vec = bless [undef,0], $type;
8add82fc
PP
28
29 $vec->add(@_)
30 if @_;
31
32 $vec;
33}
34
35sub add
36{
7a4c00b4
PP
37 shift->_update('add', @_);
38}
39
40
41sub remove
42{
43 shift->_update('remove', @_);
44}
45
46
47sub exists
48{
8add82fc 49 my $vec = shift;
4fdd9276
GS
50 my $fno = $vec->_fileno(shift);
51 return undef unless defined $fno;
52 $vec->[$fno + FIRST_FD];
7a4c00b4 53}
8add82fc 54
760ac839 55
7a4c00b4
PP
56sub _fileno
57{
58 my($self, $f) = @_;
da7f16d7 59 return unless defined $f;
7a4c00b4
PP
60 $f = $f->[0] if ref($f) eq 'ARRAY';
61 ($f =~ /^\d+$/) ? $f : fileno($f);
8add82fc
PP
62}
63
7a4c00b4 64sub _update
8add82fc
PP
65{
66 my $vec = shift;
7a4c00b4 67 my $add = shift eq 'add';
8add82fc 68
7a4c00b4
PP
69 my $bits = $vec->[VEC_BITS];
70 $bits = '' unless defined $bits;
71
72 my $count = 0;
73 my $f;
8add82fc
PP
74 foreach $f (@_)
75 {
7a4c00b4
PP
76 my $fn = $vec->_fileno($f);
77 next unless defined $fn;
78 my $i = $fn + FIRST_FD;
79 if ($add) {
80 if (defined $vec->[$i]) {
81 $vec->[$i] = $f; # if array rest might be different, so we update
82 next;
83 }
84 $vec->[FD_COUNT]++;
85 vec($bits, $fn, 1) = 1;
86 $vec->[$i] = $f;
87 } else { # remove
88 next unless defined $vec->[$i];
89 $vec->[FD_COUNT]--;
90 vec($bits, $fn, 1) = 0;
91 $vec->[$i] = undef;
92 }
93 $count++;
8add82fc 94 }
7a4c00b4
PP
95 $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
96 $count;
8add82fc
PP
97}
98
99sub can_read
100{
101 my $vec = shift;
102 my $timeout = shift;
27d4819a 103 my $r = $vec->[VEC_BITS];
8add82fc 104
27d4819a 105 defined($r) && (select($r,undef,undef,$timeout) > 0)
7a4c00b4 106 ? handles($vec, $r)
8add82fc
PP
107 : ();
108}
109
110sub can_write
111{
112 my $vec = shift;
113 my $timeout = shift;
27d4819a 114 my $w = $vec->[VEC_BITS];
8add82fc 115
27d4819a 116 defined($w) && (select(undef,$w,undef,$timeout) > 0)
7a4c00b4 117 ? handles($vec, $w)
8add82fc
PP
118 : ();
119}
120
cf7fe8a2 121sub has_exception
8add82fc
PP
122{
123 my $vec = shift;
124 my $timeout = shift;
27d4819a 125 my $e = $vec->[VEC_BITS];
8add82fc 126
27d4819a 127 defined($e) && (select(undef,undef,$e,$timeout) > 0)
7a4c00b4 128 ? handles($vec, $e)
8add82fc
PP
129 : ();
130}
131
cf7fe8a2
GS
132sub has_error
133{
6facdfff 134 warnings::warn("Call to deprecated method 'has_error', use 'has_exception'")
d3a7d8c7 135 if warnings::enabled();
cf7fe8a2
GS
136 goto &has_exception;
137}
138
760ac839
LW
139sub count
140{
141 my $vec = shift;
142 $vec->[FD_COUNT];
143}
144
7a4c00b4
PP
145sub bits
146{
147 my $vec = shift;
148 $vec->[VEC_BITS];
149}
150
151sub as_string # for debugging
152{
153 my $vec = shift;
154 my $str = ref($vec) . ": ";
155 my $bits = $vec->bits;
156 my $count = $vec->count;
157 $str .= defined($bits) ? unpack("b*", $bits) : "undef";
158 $str .= " $count";
159 my @handles = @$vec;
160 splice(@handles, 0, FIRST_FD);
161 for (@handles) {
162 $str .= " " . (defined($_) ? "$_" : "-");
163 }
164 $str;
165}
166
8add82fc
PP
167sub _max
168{
169 my($a,$b,$c) = @_;
170 $a > $b
171 ? $a > $c
172 ? $a
173 : $c
174 : $b > $c
175 ? $b
176 : $c;
177}
178
179sub select
180{
181 shift
182 if defined $_[0] && !ref($_[0]);
183
184 my($r,$w,$e,$t) = @_;
185 my @result = ();
186
760ac839 187 my $rb = defined $r ? $r->[VEC_BITS] : undef;
7a4c00b4
PP
188 my $wb = defined $w ? $w->[VEC_BITS] : undef;
189 my $eb = defined $e ? $e->[VEC_BITS] : undef;
8add82fc
PP
190
191 if(select($rb,$wb,$eb,$t) > 0)
192 {
193 my @r = ();
194 my @w = ();
195 my @e = ();
760ac839
LW
196 my $i = _max(defined $r ? scalar(@$r)-1 : 0,
197 defined $w ? scalar(@$w)-1 : 0,
198 defined $e ? scalar(@$e)-1 : 0);
8add82fc 199
760ac839 200 for( ; $i >= FIRST_FD ; $i--)
8add82fc 201 {
760ac839 202 my $j = $i - FIRST_FD;
8add82fc 203 push(@r, $r->[$i])
760ac839 204 if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
8add82fc 205 push(@w, $w->[$i])
760ac839 206 if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
8add82fc 207 push(@e, $e->[$i])
760ac839 208 if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
8add82fc
PP
209 }
210
211 @result = (\@r, \@w, \@e);
212 }
213 @result;
214}
215
7a4c00b4
PP
216
217sub handles
8add82fc
PP
218{
219 my $vec = shift;
220 my $bits = shift;
221 my @h = ();
222 my $i;
7a4c00b4 223 my $max = scalar(@$vec) - 1;
8add82fc 224
7a4c00b4 225 for ($i = FIRST_FD; $i <= $max; $i++)
8add82fc
PP
226 {
227 next unless defined $vec->[$i];
228 push(@h, $vec->[$i])
7a4c00b4 229 if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
8add82fc
PP
230 }
231
232 @h;
233}
234
2351;
cf7fe8a2
GS
236__END__
237
238=head1 NAME
239
240IO::Select - OO interface to the select system call
241
242=head1 SYNOPSIS
243
244 use IO::Select;
245
246 $s = IO::Select->new();
247
248 $s->add(\*STDIN);
249 $s->add($some_handle);
250
251 @ready = $s->can_read($timeout);
252
253 @ready = IO::Select->new(@handles)->read(0);
254
255=head1 DESCRIPTION
256
257The C<IO::Select> package implements an object approach to the system C<select>
258function call. It allows the user to see what IO handles, see L<IO::Handle>,
259are ready for reading, writing or have an error condition pending.
260
261=head1 CONSTRUCTOR
262
263=over 4
264
265=item new ( [ HANDLES ] )
266
267The constructor creates a new object and optionally initialises it with a set
268of handles.
269
270=back
271
272=head1 METHODS
273
274=over 4
275
276=item add ( HANDLES )
277
278Add the list of handles to the C<IO::Select> object. It is these values that
279will be returned when an event occurs. C<IO::Select> keeps these values in a
280cache which is indexed by the C<fileno> of the handle, so if more than one
281handle with the same C<fileno> is specified then only the last one is cached.
282
283Each handle can be an C<IO::Handle> object, an integer or an array
284reference where the first element is a C<IO::Handle> or an integer.
285
286=item remove ( HANDLES )
287
288Remove all the given handles from the object. This method also works
289by the C<fileno> of the handles. So the exact handles that were added
290need not be passed, just handles that have an equivalent C<fileno>
291
292=item exists ( HANDLE )
293
294Returns a true value (actually the handle itself) if it is present.
295Returns undef otherwise.
296
297=item handles
298
299Return an array of all registered handles.
300
301=item can_read ( [ TIMEOUT ] )
302
303Return an array of handles that are ready for reading. C<TIMEOUT> is
8971464f
JH
304the maximum amount of time to wait before returning an empty list, in
305seconds, possibly fractional. If C<TIMEOUT> is not given and any
306handles are registered then the call will block.
cf7fe8a2
GS
307
308=item can_write ( [ TIMEOUT ] )
309
310Same as C<can_read> except check for handles that can be written to.
311
312=item has_exception ( [ TIMEOUT ] )
313
314Same as C<can_read> except check for handles that have an exception
315condition, for example pending out-of-band data.
316
317=item count ()
318
319Returns the number of handles that the object will check for when
320one of the C<can_> methods is called or the object is passed to
321the C<select> static method.
322
323=item bits()
324
325Return the bit string suitable as argument to the core select() call.
326
327=item select ( READ, WRITE, ERROR [, TIMEOUT ] )
328
329C<select> is a static method, that is you call it with the package
330name like C<new>. C<READ>, C<WRITE> and C<ERROR> are either C<undef>
331or C<IO::Select> objects. C<TIMEOUT> is optional and has the same
332effect as for the core select call.
333
334The result will be an array of 3 elements, each a reference to an array
335which will hold the handles that are ready for reading, writing and have
336error conditions respectively. Upon error an empty array is returned.
337
338=back
339
340=head1 EXAMPLE
341
342Here is a short example which shows how C<IO::Select> could be used
343to write a server which communicates with several sockets while also
344listening for more connections on a listen socket
345
346 use IO::Select;
347 use IO::Socket;
348
349 $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
350 $sel = new IO::Select( $lsn );
3cb6de81 351
cf7fe8a2
GS
352 while(@ready = $sel->can_read) {
353 foreach $fh (@ready) {
354 if($fh == $lsn) {
355 # Create a new socket
356 $new = $lsn->accept;
357 $sel->add($new);
358 }
359 else {
360 # Process socket
361
362 # Maybe we have finished with the socket
363 $sel->remove($fh);
364 $fh->close;
365 }
366 }
367 }
368
369=head1 AUTHOR
370
854822f1
GS
371Graham Barr. Currently maintained by the Perl Porters. Please report all
372bugs to <perl5-porters@perl.org>.
cf7fe8a2
GS
373
374=head1 COPYRIGHT
375
376Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
377This program is free software; you can redistribute it and/or
378modify it under the same terms as Perl itself.
379
380=cut
381