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