eval 'exec perl -x $0 ${1+"$@"}' # -*-perl-*-
  if 0;
#!perl -w
#
# ======================================================================
# This file is Copyright 1998,1999 by the Purdue Research Foundation and
# may only be used under license.  For terms of the license, see the
# file named COPYRIGHT included with this software release.
# AAFID is a trademark of the Purdue Research Foundation.
# All rights reserved.
# ======================================================================
#
# Comm::Timer package - Implements a queue for timed events.
#
# AAFID project, COAST Laboratory, CERIAS, 1998-1999.
#
# Frederic Dumont, 1998-1999
# Diego Zamboni, 1999.
#
# $Id: Timer.pm,v 1.3 1999/09/03 16:50:58 zamboni Exp $
#
# NOTE: This file is in Perl's POD format. For more information, see the 
#       manual page for perlpod(1).
#

=head1 NAME

Comm::Timer - Timed event queue

=head1 SYNOPSIS

    use Comm::Timer;

    $timer=new Timer;

    $timer->add_event(time()+5,\&some_func);
    $next_events=$time->get_next();
    $next_time=shift @$next_events;
    if ($next_time-time()<=0) {
        foreach (@$next_events) {
	    &$_();
	}
    }

=head1 CONSTRUCTOR

=over 4

=item new

The constructor return a timer object.

=back

=head1 METHODS

=over 4

=item add_event ( TIME, FUNC )

Add the function FUNC with the time TIME (given in seconds since 1/1/1970).

=item add_repeating_event ( INTERVAL, FUNC )

Add the function FUNC to be called every INTERVAL seconds, starting at
the moment the function is called.

=item remove_event ( TIME, FUNC )

Remove this function that was scheduled at time TIME. Both arguments must
match those given to the add_event method.

=item remove_repeating_event ( INTERVAL, FUNC )

Remove the repeating function that was scheduled with interval INTERVAL.
Both arguments must match those given to the add_repeating_event method.

=item get_when

Return the time for the next events

=item get_next

Return a list whose first element is the time of the events (that is,
functions) given as the other elements of the list.

=back

=head1 BUGS

I hope not.

=head1 AUTHOR

Frederic Dumont <fdm@cs.purdue.edu>

=cut

package Comm::Timer;

use strict;

# Usage:
#    my $timer = new Timer;
sub new {
    my ($pkg)=shift;
    my ($self)={};
    # Queue contains the queue itself.
    $self->{Queue}=[];
    # Repeating contains information about the repeating events. It
    # is indexed by "$func.$interval" and each element contains a 
    # reference to a list that contains the next scheduled time and
    # a pointer to the function. The function has to be stored to be
    # able to remove the repeating events.
    $self->{Repeating}={};
    return bless $self, $pkg;
}

# Usage:
#    $timer->add_event(time()+$timeout, \&func);
# Rem:
#    use closure if you want to pass arguments to the function
sub add_event {
    my ($self, $timeout, $func) = @_;
    my ($entry)=[$timeout, $func];
    my $selfq=$self->{Queue};
    push @$selfq, $entry;
    @$selfq = sort { return $$a[0] <=> $$b[0] or $$a[1] <=> $$b[1]; }  @$selfq;
}

# Usage:
#    $timer->remove_event($time, \&func);
# both $time and \&func must match the arguments given at add_event
sub remove_event {
    my ($self, $timeout, $func) = @_;
    my $selfq=$self->{Queue};
    @$selfq=grep { $$_[0] != $timeout or $$_[1] != $func } @$selfq;
}

# Usage:
#    $timer->add_repeating_event($interval, \&func);
sub add_repeating_event {
  my ($self, $interval, $func)=@_;
  # Schedule the first occurrence to be in $interval seconds. Create
  # an anonymous wrapper function.
  my $nexttime=time()+$interval;
  my $nextsub=sub {
                $self->_do_repeating_event($interval, $func);
	      };
  $self->add_event($nexttime, $nextsub);
  # Add to the table.
  $self->{Repeating}->{"$func.$interval"}=[$nexttime, $nextsub];
}

# Usage:
#    $timer->remove_repeating_event($interval, \&func)
# Removes all future occurrences of the event.
# Both $interval and \&func have to be exactly the same of those given
# to add_repeating_event.
sub remove_repeating_event {
  my ($self, $interval, $func)=@_;
  # Get the next time at which the event will occur.
  my $key="$func.$interval";
  if (defined($self->{Repeating}->{$key})) {
    my ($nexttime,$nextsub)=@{$self->{Repeating}->{$key}};
    # Remove the next occurrence.
    $self->remove_event($nexttime, $nextsub);
    # Remove from the table of repeating events.
    delete $self->{Repeating}->{$key};
  }
}

# Usage:
#    $next_events=$timer->get_next();
# $next is a reference to a list : ($time, \&func1, \&func2, ...)
# with $time the lowest time entry in the timer, and the corresponding
# function references
sub get_next {
    my ($self) = @_;
    my ($timeout, @entries);
    my $selfq=$self->{Queue};
    return [] unless @$selfq;
    $timeout=$$selfq[0][0];
    while ($$selfq[0][0]==$timeout) {
	  my $entry = shift @$selfq;
	  push @entries, $$entry[1]; 
	  last unless @$selfq;
    }
    return [$timeout, @entries];
}

# Usage:
#    $time = $timer->get_when();
# if $time == undef, it means there's no more scheduled events.
# $time is a absolute time that can be compared to time().
sub get_when {
    my ($self) = @_;
    my $selfq=$self->{Queue};
    return undef unless @$selfq;
    return $$selfq[0][0];
}

# Private methods

# _do_repeating_event: Executes the function corresponding to a
# repeating event, rescheduling it for its next occurrence.
sub _do_repeating_event {
  my ($self, $interval, $func)=@_;
  # First, reschedule it.
  my $nexttime=time()+$interval;
  my $nextsub=sub {
                $self->_do_repeating_event($interval, $func);
	      };
  $self->add_event($nexttime,$nextsub);
  # Update the table
  $self->{Repeating}->{"$func.$interval"}=[$nexttime,$nextsub];
  # Execute it.
  &$func();
}

1;
