# # Simple multiplexing package # # by Andrew Hunter. All rights given away. # package Multiplex; use strict; # De-rigeur use Carp; # Nicer error reporting use Time::HiRes qw/time/; # High precision time # These structures contain the file objects and timers that we are currently # interested in: my @files = (); my @timers = (); # Function to add a file object to the list to listen to # A file object should be a blessed reference, providing the functions # receive(), called when data becomes available, and file(), which should # return a reference to a filehandle. sub listen ($) { my ($file) = @_; croak "File object must provide receive and file methods" if (!defined($file->can('receive')) || !defined($file->can('file'))); push @files, $file; } # Function to add a timer object to the list to wait for # A timer object should be a blessed reference, providing the function timeout, # which is called when it expires. # # This function takes two arguments - the timer object and the length of # time to wait until timing out. sub timeout ($$) { my ($timer, $howlong) = @_; croak "Timer object must provide timeout method" if (!defined($timer->can("timeout"))); push @timers, { what => $timer, when => time()+$howlong }; @timers = sort { $a->{when} <=> $b->{when} } @timers; # Yeah, the sort is probably inefficient with large numbers of timers } # This removes a timeout from the list. This takes a reference to a blessed # timer object. It should be the same as the reference passed to timeout. sub removetimout ($) { my ($timer) = @_; @timers = grep { $_->{what} ne "$timer" } @timers; } # Actually do the select business itself! # This should be repeatedly called to create a feeling of interactivity sub despatchevents () { my $now = time(); # Send out any timeouts that have expired while ($#timers >= 0 and $timers[0]->{when} < $now) { $timers[0]->{what}->timeout(); shift @timers; $now = time(); } # Set up the file handles to wait for my $rin = ''; vec($rin, fileno($_->file()), 1) = 1 foreach (@files); # Actually do the select my $rout; select($rout=$rin, undef, undef, $#timers>=0?$timers[0]->{when} - $now:undef); # Notify any files that have data waiting foreach (@files) { $_->receive() if (vec($rout, fileno($_->file()), 1)); } } # == return 1;