Componentes.Terceros.RemObjects/internal/5.0.23.613/1/Data Abstract for Delphi/Source/uDACache.pas

unit uDACache;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Core Library                                       }
{                                                                            }
{ compiler: Delphi 6 and up, Kylix 3 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the Data Abstract              }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I DataAbstract.inc}

interface

uses
  Classes, SysUtils, SyncObjs,
  uROClasses, uROTypes, uDAInterfaces;

type
  { TDACacheElement }
  TDACacheElementOption = (ceoFlushOnUpdate);
  TDACacheElementOptions = set of TDACacheElementOption;

  TDACacheElement = class(TCollectionItem)
  private
    fEnabled: boolean;
    fMaxReads: integer;
    fReferencedDataset: string;
    fOptions: TDACacheElementOptions;
    fDuration: integer;
    procedure SetDuration(const Value: integer);
    procedure SetMaxReads(const Value: integer);

  protected
    function GetDisplayName: string; override;

  public
    constructor Create(aCollection : TCollection); override;

  published
    property ReferencedDataset : string read fReferencedDataset write fReferencedDataset;
    property Enabled : boolean read fEnabled write fEnabled;
    property Options : TDACacheElementOptions read fOptions write fOptions;
    property MaxReads : integer read fMaxReads write SetMaxReads;
    property Duration : integer read fDuration write SetDuration;
  end;

  { TDACacheElementCollection  }
  TDACacheElementCollection = class(TCollection)
  private
    function GetItems(Index: integer): TDACacheElement;
  protected
  public
    constructor Create;
    destructor Destroy; override;

    function Add : TDACacheElement;
    function FindByDatasetName(aDatasetName : string) : TDACacheElement;

    property Items[Index : integer] : TDACacheElement read GetItems; default;
  end;

  { IDACacheEntry }
  IDACacheEntry = interface
  ['{87F5AFF3-590C-4749-A3D7-BD4F8B2D5166}']
    function GetInvalid: boolean;
    function GetData: TStream;
    function GetExpirationTime: TDateTime;
    function GetMaxReads: integer;
    function GetName: string;
    function GetOwnsStream: boolean;
    function GetReadCount: integer;
    function GetRecordCount: integer;
    procedure SetReadCount(const Value: integer);

    property Name : string read GetName;
    property Data : TStream read GetData;
    property ReadCount : integer read GetReadCount write SetReadCount;

    property RecordCount : integer read GetRecordCount;

    property ExpirationTime : TDateTime read GetExpirationTime;

    property MaxReads : integer read GetMaxReads;
    property OwnsStream : boolean read GetOwnsStream;
    property Invalid : boolean read GetInvalid;
 end;

  { TDACacheEntry }
  TDACacheEntry = class(TInterfacedObject, IDACacheEntry)
  private
    fOwnsStream : boolean;
    fData: TStream;
    fMaxReads: integer;
    fReadCount: integer;
    fName: string;
    fExpirationTime: TDateTime;
    fRecordCount: integer;

  protected
    { IDACacheEntry }
    function GetInvalid: boolean;
    function GetData: TStream;
    function GetExpirationTime: TDateTime;
    function GetMaxReads: integer;
    function GetName: string;
    function GetOwnsStream: boolean;
    function GetReadCount: integer;
    function GetRecordCount: integer;
    procedure SetReadCount(const Value: integer);

  public
    constructor Create(const aName : string; aData : TStream; aRecordCount : integer;
                       aOwnsStream : boolean; aMaxReads : integer = -1; aDuration : integer = -1);
    destructor Destroy; override;
  end;

  { TDACache }
  TDACache = class(TComponent)
  private
    fTimer : TROThreadTimer;
    fEntries : TInterfaceList;
    fCritical : TCriticalSection;

    function GetEntries(Index: integer): IDACacheEntry;
    function GetEntryCount: integer;

  protected
    procedure OnTimerTick(CurrentTickCount : cardinal);

  public
    constructor Create(aOwner : TComponent); override;
    destructor Destroy; override;

    procedure Store(const anEntryName : string; Data : TStream;
                    CopyStream : boolean; RecordCount : integer = -1;
                    MaxReads : integer = -1; Duration : integer = -1);
    function Get(const anEntryName : string) : IDACacheEntry;
    procedure Flush(const anEntryName : string);

    function Find(const anEntryName : string) : integer;

    property Entries[Index : integer] : IDACacheEntry read GetEntries;
    property EntryCount : integer read GetEntryCount;

  end;

implementation

uses
  DateUtils;

{ TDACacheElementCollection }

function TDACacheElementCollection.Add: TDACacheElement;
begin
  result := TDACacheElement(inherited Add);
end;

constructor TDACacheElementCollection.Create;
begin
  inherited Create(TDACacheElement);
end;

destructor TDACacheElementCollection.Destroy;
begin

  inherited;
end;

function TDACacheElementCollection.FindByDatasetName(
  aDatasetName: string): TDACacheElement;
var i : integer;
begin
  result := NIL;

  for i := 0 to (Count-1) do
    if SameText(Items[i].ReferencedDataset, aDatasetName) then begin
      result := Items[i];
      Exit;
    end;
end;

function TDACacheElementCollection.GetItems(
  Index: integer): TDACacheElement;
begin
  result := TDACacheElement(inherited Items[Index]);
end;

{ TDACacheElement }

constructor TDACacheElement.Create(aCollection: TCollection);
begin
  inherited;

  fEnabled := TRUE;
  fMaxReads := -1;
  fDuration := -1;
  fOptions := [ceoFlushOnUpdate];
end;

function TDACacheElement.GetDisplayName: string;
begin
  if fReferencedDataset<>''
    then result := fReferencedDataset
    else result := '<Unassigned>'
end;

procedure TDACacheElement.SetDuration(const Value: integer);
begin
  if (Value=-1) or (Value>0)
    then fDuration := Value;
end;

procedure TDACacheElement.SetMaxReads(const Value: integer);
begin
  if (Value=-1) or (Value>0)
    then fMaxReads := Value;
end;

{ TDACache }

constructor TDACache.Create(aOwner: TComponent);
begin
  inherited;

  fTimer := TROThreadTimer.Create(OnTimerTick, 60); // Checks every minute

  fCritical := TCriticalSection.Create;
  fEntries := TInterfaceList.Create;
end;

destructor TDACache.Destroy;
begin
  fTimer.Terminate;
  fTimer.Free;

  fEntries.Free;
  fCritical.Free;

  inherited;
end;

function TDACache.Find(const anEntryName: string): integer;
var i : integer;
begin
  result := -1;
  for i := 0 to (fEntries.Count-1) do
    if SameText(Entries[i].Name, anEntryName) then begin
      result := i;
      Exit;
    end;
end;

procedure TDACache.Flush(const anEntryName: string);
var idx : integer;
begin
  fCritical.Enter;
  try
    idx := Find(anEntryName);
    if (idx>=0)
      then fEntries.Delete(idx);
  finally
    fCritical.Leave;
  end;
end;

function TDACache.Get(const anEntryName: string): IDACacheEntry;
var idx : integer;
begin
  result := NIL;
  fCritical.Enter;
  try
    idx := Find(anEntryName);
    if (idx>=0) then begin
      result := Entries[idx];

      if result.Invalid then begin
        result := NIL;
        fEntries.Delete(idx);
        Exit;
      end
      else begin
        result.ReadCount := result.ReadCount+1;
      end;
    end;
  finally
    fCritical.Leave;
  end;
end;

function TDACache.GetEntries(Index: integer): IDACacheEntry;
begin
  result := fEntries[Index] as IDACacheEntry;
end;

function TDACache.GetEntryCount: integer;
begin
  result := fEntries.Count;
end;

procedure TDACache.OnTimerTick(CurrentTickCount: cardinal);
var i : integer;
begin
  fCritical.Enter;
  try
    for i := fEntries.Count-1 downto 0 do begin
      if Entries[i].Invalid
        then fEntries.Delete(i);
    end;
  finally
    fCritical.Leave;
  end;
end;

procedure TDACache.Store(const anEntryName: string; Data: TStream; CopyStream : boolean;
  RecordCount, MaxReads, Duration: integer);
var entry : TDACacheEntry;
    nme : string;
    idx : integer;
    newstream : Binary;
begin
  nme := UpperCase(anEntryName);

  fCritical.Enter;
  try
    idx := Find(nme);

    if (idx<0) then begin
      if CopyStream then begin
        newstream := Binary.Create;
        newstream.CopyFrom(Data, 0);
        entry := TDACacheEntry.Create(nme, newstream, RecordCount, TRUE, MaxReads, Duration);
      end
      else entry := TDACacheEntry.Create(nme, Data, RecordCount, FALSE, MaxReads, Duration);

      fEntries.Add(entry);
    end
    else raise Exception.Create('Duplicated name '+anEntryName);
  finally
    fCritical.Leave;
  end;
end;

{ TDACacheEntry }

constructor TDACacheEntry.Create(const aName : string; aData : TStream; aRecordCount : integer;
                       aOwnsStream : boolean; aMaxReads : integer = -1; aDuration : integer = -1);
begin
  inherited Create;

  fName := aName;
  fData := aData;
  fRecordCount := aRecordCount;

  if (aDuration>0)
    then fExpirationTime := IncMinute(Now, aDuration)
    else fExpirationTime := -1;

  fReadCount := 0;
  fMaxReads := aMaxReads;
end;

destructor TDACacheEntry.Destroy;
begin
  if fOwnsStream
    then fData.Free;

  inherited;
end;

function TDACacheEntry.GetData: TStream;
begin
  result := fData;
  //Inc(fReadCount);
end;

function TDACacheEntry.GetExpirationTime: TDateTime;
begin
  result := fExpirationTime
end;

function TDACacheEntry.GetInvalid: boolean;
begin
  result := ((fMaxReads<>-1) and (fReadCount>=fMaxReads))
            or
            ((fExpirationTime<>-1) and (fExpirationTime<=Now));
end;

function TDACacheEntry.GetMaxReads: integer;
begin
  result := fMaxReads
end;

function TDACacheEntry.GetName: string;
begin
  result := fName
end;

function TDACacheEntry.GetOwnsStream: boolean;
begin
  result := fOwnsStream
end;

function TDACacheEntry.GetReadCount: integer;
begin
  result := fReadCount
end;

function TDACacheEntry.GetRecordCount: integer;
begin
  result := fRecordCount
end;

procedure TDACacheEntry.SetReadCount(const Value: integer);
begin
  if (Value>=0)
    then fReadCount := Value
end;

end.