package Mud::Scheduler;
use strict;
use Mud::CoreTools;

use Mud::IOManager;

use vars qw(
  @EventQueue
  %EventsByObject
  
  $Now $Running $Quit
  
  $IOManager
);

###

=head1 Description

Mud::Scheduler manages the main event loop of the mud.

=head1 Operation

The scheduler maintains a queue of 'event objects', sorted by time-to-call.
An object may not be placed in the queue more than once. An object may
be explicitly removed from the queue.

=cut

### Internal ##################################################################

use constant SCH_EPOCH_ADJUSTMENT => IS_MACOS ? 2082844801 : 0;
BEGIN {
  eval q{
    use Time::HiRes ();
    use constant SCH_HIRES_LOADED => 1;
  };
  if ($@) {
    if ($@ =~ /Can't locate/) {
      eval "use constant SCH_HIRES_LOADED => 0";
    } else {
      die $@;
    }
  }
}

sub _clock {
  if (SCH_HIRES_LOADED) {
    return scalar Time::HiRes::gettimeofday();
  } else {
    return time() + SCH_EPOCH_ADJUSTMENT;
  }
}

$IOManager = 'Mud::IOManager';

### Methods ###################################################################

=head1 Methods

Note that these are class methods. There may be an actual instance involved,
but you don't need to call it directly.

=over 4

=item CM now()

Returns the current time. Note that during the execution of one event, this
method will always return the same value - the time at which the event was
intended to execute.

The return value is of unspecified resolution and epoch.

=cut

sub now {
  #my ($class) = @_;
  return $Now || _clock();
}

=item CM time_system(NOW)

Converts NOW, a number returned from ->now(), into a time in the system's
epoch.

=cut

sub time_system {
  my ($class, $now) = @_;
  
  return $now - SCH_EPOCH_ADJUSTMENT;
}

=item CM run()

Runs the event loop  until the variable C<$Mud::Scheduler::Quit> is defined. 
Returns the value of C<$Mud::Scheduler::Quit>.

=cut

sub run {
  my ($class) = @_;
  
  local $Running = 1;
  $Quit = undef;
  
  mudlog "Entering event loop.";
  
  eval {
    EVENT: while (not defined $Quit) {
      #print "sch loop: now "._clock().(@EventQueue?", event at $EventQueue[0]{time}":"")."\n"; 
      $IOManager->block_for(
        @EventQueue
          ? do {my $t = $EventQueue[0]{time} - _clock(); $t < 0 ? 0 : $t}
          : undef
      );
        
      # NOTE: processing I/O may have added an event, so we can't
      # cache $EventQueue[0]{time}.
      
      local $Now = _clock();
      if (@EventQueue and $EventQueue[0]{time} <= $Now) {
        my $evrec = shift @EventQueue;
        next EVENT if $evrec->{dead};
        
        my $evobj = $evrec->{object};
        delete $EventsByObject{$evobj->proxy_real_obj}; # NOTE: overload-unsafe
        
        #FIXME
        #my $trans = MTransaction->open();
        
        eval {$evobj->scheduled_event_run()};
        
        if ($@) {
          my $at = $@;
          #$trans->close;
          # if threads are used, here we need code to retry the event later if it fails
          mudlog "ERROR/SCHEDULER: exception while executing event $evrec->{name}:\n$at";
        } else {
          #$trans->commit;
          #$trans->close;
        }
      }
    }
  };
  
  mudlog ($@ ? "ERROR/SCHEDULER: exception in event loop:\n$@"
             : "Exiting event loop.");
             
  return $Quit;
}

=item CM add(EVENT, ...)

Add an object to the queue.

=cut

sub add {
  my ($self, @events) = @_;
  for (map {$_->proxy_is ? $_ : $_->po_proxy} @events) {
  
    next if exists $EventsByObject{$_->proxy_real_obj};
  
    my $etime = $_->scheduled_event_time();
    my $evrec = {
      object => $_,
      time => $etime,
      name => $_->scheduled_event_name(),
    };
        
    # find the place to insert the event in the queue
    my $insert_pos = &{sub{
      return 0 if     !@EventQueue or $etime <= $EventQueue[ 0]{'time'}; # case of goes into head of queue or empty queue
      return scalar @EventQueue if    $etime >= $EventQueue[-1]{'time'}; # case of goes into tail of queue
      
      # none of the simple cases worked out, do a binary search
      
      # establish the initial range
      my ($lower, $upper) = (0, $#EventQueue);
      
      # this should always be true
      while ($lower < $upper) {
        # if the range has two elements, the new item goes between them
        return $upper if $lower + 1 == $upper;
        
        # compute midpoint of range
        my $middle = int(($upper - $lower) / 2 + $lower);
        
        # then check which side of range we should search
        my $midtime = $EventQueue[$middle]{'time'};
        if ($etime > $midtime) {
          $lower = $middle;
        } elsif ($etime < $midtime) {
          $upper = $middle;
        } else {
          # equal to the middle, we can insert it right after there
          return $middle + 1;
        }
      }
      warn "dainbramage: scheduler queue not sorted, or the binary search malfunctioned";
      return scalar @EventQueue;
    }};

    $EventsByObject{$_->proxy_real_obj} = $evrec;
    splice @EventQueue, $insert_pos, 0, $evrec;
  }
}

=back

=cut

##################################################################

=head1 Interface for Event Objects

=over 4

=item scheduled_event_run()

Called at the appropriate time.

=item scheduled_event_time()

Returns the time at which C<scheduled_event_run> should be called. This
method will not be called except when the event is added.

=item scheduled_event_name()

A description of the event, for status displays.

=back

=cut

##################################################################

1;
__END__
