CentrED/UCacheManager.pas

288 lines
6.5 KiB
Plaintext
Raw Normal View History

(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2010 Andreas Schneider
*)
unit UCacheManager;
{$mode objfpc}{$H+}
{$interfaces corba}
interface
uses
SysUtils, Classes;
type
ICacheable = interface['{0ABAA4DE-8128-47B3-ABFE-5250A74A0428}']
function CanBeRemoved: Boolean;
procedure RemoveFromCache;
end;
{ TCacheManager }
generic TCacheManager<T> = class
public type
{ Types }
TRemoveObjectEvent = procedure(AObject: T) of object;
PCacheEntry = ^TCacheEntry;
TCacheEntry = record
ID: Integer;
Obj: T;
Next: PCacheEntry;
end;
protected
{ Members }
FSize: Integer;
FFirst: PCacheEntry;
FLast: PCacheEntry;
FOnRemoveObject: TRemoveObjectEvent;
procedure DoRemoveObject(var AObject: T; ANotify: Boolean = True);
public
constructor Create(ASize: Integer);
destructor Destroy; override;
{ Fields }
property OnRemoveObject: TRemoveObjectEvent read FOnRemoveObject
write FOnRemoveObject;
{ Methods }
function QueryID(const AID: Integer; out AObj: T): Boolean;
procedure StoreID(AID: Integer; AObj: T);
procedure DiscardID(AID: Integer);
procedure DiscardObj(AObj: T);
procedure RemoveID(AID: Integer);
procedure Clear;
function Iterate(var ACacheEntry: PCacheEntry): Boolean;
end;
implementation
uses
Logging;
{ TCacheManager }
procedure TCacheManager.DoRemoveObject(var AObject: T; ANotify: Boolean = True);
var
cacheable: ICacheable;
begin
if ANotify and Assigned(FOnRemoveObject) then FOnRemoveObject(AObject);
if TObject(AObject).GetInterface(ICacheable, cacheable) then
cacheable.RemoveFromCache
else
TObject(AObject).Free;
TObject(AObject) := nil;
end;
constructor TCacheManager.Create(ASize: Integer);
var
i: Integer;
current: PCacheEntry;
begin
FOnRemoveObject := nil;
FSize := ASize;
if FSize > 0 then
begin
New(FFirst);
current := FFirst;
current^.ID := LongInt($FFFFFFFF);
current^.Obj := nil;
for i := 2 to FSize do
begin
New(current^.Next);
FLast := current;
current := current^.Next;
current^.ID := LongInt($FFFFFFFF);
current^.Obj := nil;
end;
current^.Next := nil;
end;
end;
destructor TCacheManager.Destroy;
var
i: Integer;
current, last: PCacheEntry;
begin
current := FFirst;
for i := 1 to FSize do
begin
if Pointer(current^.Obj) <> nil then
DoRemoveObject(current^.Obj);
last := current;
current := current^.Next;
Dispose(last);
end;
inherited;
end;
procedure TCacheManager.DiscardID(AID: Integer);
var
current: PCacheEntry;
begin
current := FFirst;
while (current <> nil) do
begin
if (current^.ID = AID) then
begin
current^.ID := LongInt($FFFFFFFF);
current^.Obj := nil;
current := nil;
end else
current := current^.Next;
end;
end;
procedure TCacheManager.DiscardObj(AObj: T);
var
current: PCacheEntry;
begin
current := FFirst;
while (current <> nil) do
begin
if (current^.Obj = AObj) then
begin
current^.ID := LongInt($FFFFFFFF);
current^.Obj := nil;
current := nil;
end else
current := current^.Next;
end;
end;
procedure TCacheManager.RemoveID(AID: Integer);
var
current: PCacheEntry;
begin
current := FFirst;
FLast := current;
while (current <> nil) do
begin
if (current^.ID = AID) then
begin
current^.ID := LongInt($FFFFFFFF);
if Pointer(current^.Obj) <> nil then
DoRemoveObject(current^.Obj, False);
end;
if (current^.Next <> nil) then
FLast := current;
current := current^.Next;
end;
end;
procedure TCacheManager.Clear;
var
current: PCacheEntry;
begin
current := FFirst;
while current <> nil do
begin
if Pointer(current^.Obj) <> nil then
begin
current^.ID := LongInt($FFFFFFFF);
DoRemoveObject(current^.Obj);
end;
current := current^.Next;
end;
end;
function TCacheManager.Iterate(var ACacheEntry: PCacheEntry): Boolean;
begin
if ACacheEntry = nil then
ACacheEntry := FFirst
else
ACacheEntry := ACacheEntry^.Next;
Result := ACacheEntry <> nil;
end;
function TCacheManager.QueryID(const AID: Integer;
out AObj: T): Boolean;
var
current: PCacheEntry;
begin
current := FFirst;
FLast := current;
Result := False;
while (current <> nil) and (not Result) do
begin
if (current^.ID = AID) then
begin
Result := True;
AObj := current^.Obj;
if current <> FFirst then
begin
FLast^.Next := current^.Next;
current^.Next := FFirst;
FFirst := current;
end;
end;
if (current^.Next <> nil) then
FLast := current;
current := current^.Next;
end;
end;
procedure TCacheManager.StoreID(AID: Integer; AObj: T);
var
current: PCacheEntry;
cacheable: ICacheable;
i: Integer;
begin
current := FLast^.Next; //well, FLast is not really the last, but the one before the last ;)
FLast^.Next := nil;
current^.Next := FFirst;
FFirst := current;
if Pointer(FFirst^.Obj) <> nil then //if the last cache entry did contain an object, remove it now or grow
begin
if TObject(FFirst^.Obj).GetInterface(ICacheable, cacheable) and
not cacheable.CanBeRemoved then
begin
Logger.Send([lcInfo], 'Cache growing (%s)', [ClassName]);
New(FLast^.Next);
current := FLast^.Next;
current^.ID := FFirst^.ID;
current^.Obj := FFirst^.Obj;
for i := 2 to FSize do
begin
New(current^.Next);
FLast := current;
current := current^.Next;
current^.ID := LongInt($FFFFFFFF);
current^.Obj := nil;
end;
current^.Next := nil;
FSize := FSize * 2;
end else
DoRemoveObject(current^.Obj);
end;
FFirst^.ID := AID;
FFirst^.Obj := AObj;
end;
end.