Do you need to do these things asynchronously, or do you have a main loop somewhere dispatching things ?
Time::HiRes provides a higher resolution time() and sleep(). I also discovered that Time::HiRes::alarm() doesn't work, but Time::HiRes::ualarm() does -- at least on by Linux machine. Neither alarm nor ualarm work on Winders :-(
I would be nervous about doing a lot of work in a signal handler -- the documentation does not inspire confidence. However, the code below appears to work. I've included a mechanism for temporarily disabling the signal handler, which can be wrapped round any code found to be critical.
If your program can be converted into a select loop, then something like:
while (1) {
my $timeout = 5 ;
while (@events) {
$timeout = $events[-1]->[0] - Time::HiRes::time() ;
last if ($timeout > 0.001) ;
my ($time, $rsub, @args) = @{pop @events} ;
$rsub->(@args) ;
$timeout = 5 ;
} ;
# use IO::Select recommended, but this is just for illustration...
select(my $rout = $rin, my $wout = $win, my $eout = $ein, $timeout
+) ;
# .....
} ;
# add_event($delay, $rsub, @args)
#
# schedule call of $rsub->(@args) in $delay (float) seconds in the
+ future
sub add_event {
my ($delay, $rsub, @args) = @_ ;
my $when = $delay + Time::HiRes::time() ;
push @events, [$when, $rsub, @args] ;
if ((@events > 1) && ($events[-2]->[0] < $when)) {
@events = sort { $b->[0] <=> $a->[0] } @events ;
} ;
} ;
will do the trick... but you're into non-blocking I/O bigtime here.
Alternatively, you could poll an event loop on a regular basis. So scattering calls to something like: sub events {
while (@events) {
my $timeout = $events[-1]->[0] - Time::HiRes::time() ;
return $timeout if ($timeout > 0.001) ;
my ($time, $rsub, @args) = @{pop @events} ;
$rsub->(@args) ;
} ;
return 5 ;
} ;
far and wide... This is straightforward, and finesses a lot of worries about access to shared variables. But you have to be careful to ensure that the events() subroutine is called "often enough" given the required timing accuracy.
|