[JEDI.NET-commits] main/run Jedi.Timers.EventScheduler.pas,NONE,1.1

[Marcel B. <jed...@us...>]

Update of /cvsroot/jedidotnet/main/run
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3028/main/run

Added Files:
	Jedi.Timers.EventScheduler.pas 
Log Message:
New class: EventScheduler.

--- NEW FILE: Jedi.Timers.EventScheduler.pas ---
{---------------------------------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you
may not use this file except in compliance with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
KIND, either expressed or implied. See the License for the specific language governing rights and
limitations under the License.

The Original Code is: Jedi.Timers.EventScheduler.pas, released on --.

The Initial Developer of the Original Code is Marcel Bestebroer
Portions created by Marcel Bestebroer are Copyright (C) 2004 Marcel Bestebroer
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the JEDI.NET home page, located at
http://sf.net/projects/jedidotnet

Known Issues:
---------------------------------------------------------------------------------------------------}
// $Id: Jedi.Timers.EventScheduler.pas,v 1.1 2005/01/25 10:25:55 jedi_mbe Exp $
unit Jedi.Timers.EventScheduler;

interface

{$REGION 'implementation uses'}
uses
  System.Collections,
  System.Threading,
  Jedi.System.SourceVersioning;
{$ENDREGION}

{$REGION 'Scheduled event class'}
type
  ScheduledEvent = class;

  [JediSourceInfo('$Header: /cvsroot/jedidotnet/main/run/Jedi.Timers.EventScheduler.pas,v 1.1 2005/01/25 10:25:55 jedi_mbe Exp $')]
  ScheduledEventCallback = procedure(event: ScheduledEvent) of object;

  [JediSourceInfo('$Header: /cvsroot/jedidotnet/main/run/Jedi.Timers.EventScheduler.pas,v 1.1 2005/01/25 10:25:55 jedi_mbe Exp $')]
  ScheduledEvent = class sealed (&Object)
  {$REGION 'Constructor'}
  public
    constructor Create(interval: Int64; callback: ScheduledEventCallback);
  {$ENDREGION}
  {$REGION 'Data'}
  strict private
    FCallback: ScheduledEventCallback;
    FInterval: Int64;
    FScheduledFor: Int64;
  {$ENDREGION}
  {$REGION 'Internal methods'}
  strict private
    procedure Reschedule(fromNow: Boolean);
  protected
    procedure RunAndReschedule(state: &Object);
  {$ENDREGION}
  {$REGION 'Property access methods'}
  public
    procedure set_Interval(value: Int64);
  {$ENDREGION}
  {$REGION 'Properties'}
  public
    property Interval: Int64 read FInterval write set_Interval;
    property ScheduledFor: Int64 read FScheduledFor;
  {$ENDREGION}
  end;
{$ENDREGION}

{$REGION 'Scheduled events background thread'}
type
  [JediSourceInfo('$Header: /cvsroot/jedidotnet/main/run/Jedi.Timers.EventScheduler.pas,v 1.1 2005/01/25 10:25:55 jedi_mbe Exp $')]
  ScheduledEvents = class sealed (&Object)
  {$REGION 'Constructors'}
  strict private
    class constructor Create;
  strict protected
    constructor Create;
  {$ENDREGION}
  {$REGION 'Data'}
  strict private
    class var FThread: Thread;
    class var FEvents: ArrayList;
    class var FNotifier: AutoResetEvent;
    class var FNotifications: ArrayList;
  {$ENDREGION}
  {$REGION 'Data for information on the scheduler'}
  strict protected
    class var FHasStarted: Boolean;
    class var FHasStopped: Boolean;
    class var FQueueCount: Integer;
    class var FWaitEndedCount: Integer;
    class var FEventTriggerChecks: Integer;
  {$ENDREGION}
  {$REGION 'Information on the scheduler'}
  public
    class function EventsWaiting: Integer; static;
    class function NotificationsWaiting: Integer; static;
    class property HasStarted: Boolean read FHasStarted;
    class property HasStopped: Boolean read FHasStopped;
    class property QueueCount: Integer read FQueueCount;
    class property WaitEndedCount: Integer read FWaitEndedCount;
    class property EventTriggerChecks: Integer read FEventTriggerChecks;
  {$ENDREGION}
  {$REGION 'Internal methods'}
  strict protected
    class function CompareTimes: IComparer; static;
    class procedure ProcessNotifications; static;
    class procedure TimerLoop; static;
  {$ENDREGION}
  {$REGION 'Notification methods'}
  protected
    class procedure AddEvent(event: ScheduledEvent); static;
    class procedure RemoveEvent(event: ScheduledEvent); static;
  {$ENDREGION}
  end;
{$ENDREGION}

implementation

{$REGION 'implementation uses'}
uses
  Jedi.System.FrameworkResources;
{$ENDREGION}

{$REGION 'protected types'}
type
  NotificationType = (Add, Delete);
  NotificationInfo = record
  strict private
    FEvent: ScheduledEvent;
    FNotificationType: NotificationType;
  public
    constructor Create(notificationType: NotificationType; event: ScheduledEvent);
    property Event: ScheduledEvent read FEvent;
    property NotificationType: NotificationType read FNotificationType;
  end;

type
  TimeComparer = class (&Object, IComparer)
  strict private
    class constructor Create;
  strict private
    class var FDefault: TimeComparer;
  strict protected
    function Compare(x, y: &Object): Integer;
  public
    class function Default: IComparer; static;
  end;
{$ENDREGION}

{$REGION 'NotificationInfo'}
constructor NotificationInfo.Create(notificationType: NotificationType; event: ScheduledEvent);
begin
  inherited Create;
  FEvent := event;
  FNotificationType := notificationType;
end;
{$ENDREGION}

{$REGION 'ScheduledEvent'}
constructor ScheduledEvent.Create(interval: Int64; callback: ScheduledEventCallback);
begin
  inherited Create;
  FCallback := callback;
  set_Interval(interval);
end;

procedure ScheduledEvent.Reschedule(fromNow: Boolean);
begin
  Monitor.Enter(Self);
  try
    if Interval > 0 then
    begin
      if fromNow or (FScheduledFor = 0) then
        FScheduledFor := DateTime.UtcNow.Ticks + Interval
      else
        FScheduledFor := FScheduledFor + Interval;
      ScheduledEvents.AddEvent(Self);
    end;
  finally
    Monitor.&Exit(Self);
  end;
end;

procedure ScheduledEvent.RunAndReschedule(state: &Object);
begin
  FCallback(Self);
  Reschedule(False);
end;

procedure ScheduledEvent.set_Interval(value: Int64);
begin
  Monitor.Enter(Self);
  try
    if value < 0 then
      raise ArgumentOutOfRangeException.Create('Interval',
        MscorlibResources.GetResourceString('ArgumentOutOfRange_NeedNonNegNum'));
    if value <> Interval then
    begin
      FInterval := value;
      ScheduledEvents.RemoveEvent(Self);
      if value > 0 then
        Reschedule(True);
    end;
  finally
    Monitor.&Exit(Self);
  end;
end;
{$ENDREGION}

{$REGION 'ScheduledEvents'}
class constructor ScheduledEvents.Create;
begin
  FEvents := ArrayList.Create;
  FNotifier := AutoResetEvent.Create(False);
  FNotifications := ArrayList.Create;
  FThread := Thread.Create(ScheduledEvents.TimerLoop);
  FThread.IsBackground := True;
  FThread.Start;
end;

constructor ScheduledEvents.Create;
begin
  inherited Create;
end;

class procedure ScheduledEvents.AddEvent(event: ScheduledEvent);
begin
  Monitor.Enter(FNotifications);
  try
    FNotifications.Add(NotificationInfo.Create(Add, event));
  finally
    Monitor.Exit(FNotifications);
    FNotifier.&Set;
  end;
end;

class function ScheduledEvents.CompareTimes: IComparer;
begin
  Result := TimeComparer.Default;
end;

class procedure ScheduledEvents.ProcessNotifications;
var
  info: NotificationInfo;
  idx: Integer;
begin
  Monitor.Enter(FNotifications);
  try
    for info in FNotifications do
    begin
      if info.NotificationType = Add then
      begin
        idx := FEvents.BinarySearch(&Object(info.Event), CompareTimes);
        if idx < 0 then
          idx := not idx;
        FEvents.Insert(idx, info.Event);
      end
      else
      if info.NotificationType = Delete then
        FEvents.Remove(info.Event);
    end;
    FNotifications.Clear;
  finally
    Monitor.Exit(FNotifications);
  end;
end;

class procedure ScheduledEvents.RemoveEvent(event: ScheduledEvent);
begin
  Monitor.Enter(FNotifications);
  try
    FNotifications.Add(NotificationInfo.Create(Delete, event));
  finally
    Monitor.Exit(FNotifications);
    FNotifier.&Set;
  end;
end;

class procedure ScheduledEvents.TimerLoop;
var
  maxWait: Int64;
  notified: Boolean;
  nowTicks: Int64;
  event: ScheduledEvent;
begin
  FHasStarted := True;
  try
    while True do
    begin
      if FEvents.Count > 0 then
      begin
        maxWait := ScheduledEvent(FEvents[0]).ScheduledFor - DateTime.UtcNow.Ticks;
        if maxWait < 0 then
          maxWait := 1;
        notified := FNotifier.WaitOne(TimeSpan.Create(maxWait), False);
      end
      else
        notified := FNotifier.WaitOne(Timeout.Infinite, False);
      Inc(FWaitEndedCount);
      if notified then
        ProcessNotifications;
      nowTicks := DateTime.UtcNow.Ticks;
      Inc(FEventTriggerChecks);
      while (FEvents.Count > 0) and (ScheduledEvent(FEvents[0]).ScheduledFor <= nowTicks) do
      begin
        event := ScheduledEvent(FEvents[0]);
        FEvents.RemoveAt(0);
        ThreadPool.QueueUserWorkItem(event.RunAndReschedule);
        Inc(FQueueCount);
      end;
    end;
  finally
    FHasStopped := True;
  end;
end;

class function ScheduledEvents.EventsWaiting: Integer;
begin
  Result := FEvents.Count;
end;

class function ScheduledEvents.NotificationsWaiting: Integer;
begin
  Result := FNotifications.Count;
end;
{$ENDREGION}

{$REGION 'TimeComparer'}
class constructor TimeComparer.Create;
begin
  FDefault := TimeComparer.Create;
end;

function TimeComparer.Compare(x, y: &Object): Integer;
var
  ev1: ScheduledEvent;
  ev2: ScheduledEvent;
begin
  if not Assigned(x) and not Assigned(y) then
    Result := 0
  else
  if not Assigned(x) then
    Result := 1
  else
  if not Assigned(y) then
    Result := -1
  else
  begin
    ev1 := ScheduledEvent(x);
    ev2 := ScheduledEvent(y);
    if not Assigned(ev1) then
      raise ArgumentException.Create('', 'x');
    if not Assigned(ev2) then
      raise ArgumentException.Create('', 'y');
    Result := ev1.ScheduledFor.CompareTo(&Object(ev2.ScheduledFor));
  end;
end;

class function TimeComparer.Default: IComparer;
begin
  Result := FDefault;
end;
{$ENDREGION}

end.