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.
use Time::HiRes qw(time ualarm) ;
use constant MS => 1_000_000 ;
# Event Handling
#
# When $in_event == 0, we may set the alarm.
# When $in_event == 0, $in_event_min == 0.
#
# So $in_event != 0 implies that the alarm is not running, and pre
+vents
# add_event() from setting the alarm.
#
# When the signal handler is entered $in_event == $in_event_min ==
+ 0 (for
# only under these circumstances will the alarm be set. Before ca
+lling an
# event subroutine, $in_event = $in_event_min = 1 -- this prevents
+ two
# things:
#
# (a) add_event() will not set the alarm -- which avoids the
# possibility of recursing through the event handler;
#
# (b) ei_events() will not reduce $in_event below 1, and hence w
+ill not
# set the alarm.
#
# To disable events, if $in_event == 0 we clear the alarm, then $i
+n_event is
# incremented. (So can nest disables.)
#
# To re-enable events, $in_event is decremented (unless it is alre
+ady equal
# to $in_event_min). If it is decremented to zero and there is at
+ least one
# event in the queue, then the alarm is set. Note that:
#
# (a) if $in_event == $in_event_min == 0, it is a mistake to cal
+l
# ei_events(), but if there is an event outstanding the alar
+m will
# already be set, and we can simply do nothing.
#
# (b) if $in_event == $in_event_min == 1, it is also a mistake t
+o call
# ei_events(), and we are inside the event handler, so we ne
+ither want
# to reduce $in_event nor do we want to set the alarm.
#
# On exit from the signal handler we set $in_event = $in_event_min
+ = 0. So,
# any unbalanced di_events in an event subroutine are discarded.
my @events = () ; # Event queue
my $in_event = 0 ; # non-zero => events disabled
my $in_event_min = 0 ; # minimum allowed $in_event
# event_signal: Alarm Signal handler
local $SIG{ALRM} = \&event_signal ;
sub event_signal {
while (@events) {
my $timeout = $events[-1]->[0] - time() ;
if ($timeout > 0.001) {
ualarm($timeout * MS) ; # Restart the clock...
last ; # ... and we're done.
} ;
$in_event = $in_event_min = 1 ;
my ($time, $rsub, @args) = @{pop @events} ;
$rsub->(@args) ;
$in_event = $in_event_min = 0 ;
} ;
} ;
# add_event($delay, $rsub, @args)
#
# schedule call of $rsub->(@args) in $delay (float) seconds in the
+ future
#
# can add events during event handling.
sub add_event {
my ($delay, $rsub, @args) = @_ ;
my $time = time() ;
my $when = $delay + $time ;
ualarm(0) unless $in_event ; # Stop the clock while we f
+iddle
# unless already stopped
push @events, [$when, $rsub, @args] ;
if ((@events > 1) && ($events[-2]->[0] < $when)) {
@events = sort { $b->[0] <=> $a->[0] } @events ;
$delay = $events[-1]->[0] - $time ;
} ;
$delay = 0.0001 if $delay < 0.0001 ;
ualarm($delay * MS) unless $in_event ; # Start the clock again
# unless disabled (or in ev
+ent)
} ;
# di_events: disable event handling for the time being
#
# Note that can disable event handling 'n' times, and must enable
+events
# again 'n' times before events actually start again.
#
# It is only necessary to ualarm(0) if $in_event != 0. However, i
+t is
# essential to do the ualarm(0) before incrementing $in_event, bec
+ause if
# the alarm were to go off the signal handler will set $in_event t
+o zero !
sub di_events {
ualarm(0) unless $in_event ;
$in_event++ ;
} ;
# ei_events: enable event handling again (reduce disable count)
#
# Note that $in_event_min is set to 1 while in the signal handler,
+ and 0
# at other times. We use this to prevent excess calls to ei_event
+s() from
# enabling events during event handling and from pushing the $in_e
+vent
# negative.
sub ei_events {
return if ($in_event == $in_event_min) || --$in_event || (@events
+== 0) ;
my $delay = $events[-1]->[0] - time() ;
$delay = 0.0001 if $delay < 0.0001 ;
ualarm($delay * MS) ;
} ;
