|
@@ -0,0 +1,764 @@
|
|
|
+{ ***************************************************************************
|
|
|
+
|
|
|
+ Copyright (c) 2016-2019 Kike Pérez
|
|
|
+
|
|
|
+ Unit : Quick.MemoryCache
|
|
|
+ Description : Cache objects with expiration control
|
|
|
+ Author : Kike Pérez
|
|
|
+ Version : 1.0
|
|
|
+ Created : 14/07/2019
|
|
|
+ Modified : 02/11/2019
|
|
|
+
|
|
|
+ This file is part of QuickLib: https://github.com/exilon/QuickLib
|
|
|
+
|
|
|
+ ***************************************************************************
|
|
|
+
|
|
|
+ Licensed under the Apache License, Version 2.0 (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.apache.org/licenses/LICENSE-2.0
|
|
|
+
|
|
|
+ Unless required by applicable law or agreed to in writing, software
|
|
|
+ distributed under the License is distributed on an "AS IS" BASIS,
|
|
|
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
|
+ See the License for the specific language governing permissions and
|
|
|
+ limitations under the License.
|
|
|
+
|
|
|
+ *************************************************************************** }
|
|
|
+
|
|
|
+unit Quick.MemoryCache;
|
|
|
+
|
|
|
+{$i QuickLib.inc}
|
|
|
+
|
|
|
+interface
|
|
|
+
|
|
|
+uses
|
|
|
+ System.SysUtils,
|
|
|
+ System.Generics.Collections,
|
|
|
+ System.DateUtils,
|
|
|
+ System.TypInfo,
|
|
|
+ RTTI,
|
|
|
+ Quick.Commons,
|
|
|
+ Quick.Value,
|
|
|
+ Quick.Threads,
|
|
|
+ Quick.Cache.Intf,
|
|
|
+ Quick.MemoryCache.Types,
|
|
|
+ Quick.MemoryCache.Serializer.Json,
|
|
|
+ Quick.MemoryCache.Compressor.GZip;
|
|
|
+
|
|
|
+type
|
|
|
+
|
|
|
+ TCacheFlushedEvent = reference to procedure(aRemovedEntries : Integer);
|
|
|
+ TBeginPurgerJobEvent = reference to procedure;
|
|
|
+ TEndPurgerJobEvent = reference to procedure(aPurgedEntries : Integer);
|
|
|
+ TPurgerJobErrorEvent = reference to procedure(const aErrorMsg : string);
|
|
|
+
|
|
|
+ IMemoryCache<T> = interface
|
|
|
+ ['{57927AD7-C993-4C3C-B552-43A39F99E73A}']
|
|
|
+ function GetCompression: Boolean;
|
|
|
+ procedure SetCompression(const Value: Boolean);
|
|
|
+ function GetCachedObjects: Integer;
|
|
|
+ function GetCacheSize: Integer;
|
|
|
+ procedure SetOnBeginPurgerJob(const Value: TBeginPurgerJobEvent);
|
|
|
+ procedure SetOnCacheFlushed(const Value: TCacheFlushedEvent);
|
|
|
+ procedure SetOnEndPurgerJob(const Value: TEndPurgerJobEvent);
|
|
|
+ procedure SetOnPurgerJobError(const Value: TPurgerJobErrorEvent);
|
|
|
+ property Compression : Boolean read GetCompression write SetCompression;
|
|
|
+ property CachedObjects : Integer read GetCachedObjects;
|
|
|
+ property CacheSize : Integer read GetCacheSize;
|
|
|
+ property OnCacheFlushed : TCacheFlushedEvent write SetOnCacheFlushed;
|
|
|
+ property OnBeginPurgerJob : TBeginPurgerJobEvent write SetOnBeginPurgerJob;
|
|
|
+ property OnEndPurgerJob : TEndPurgerJobEvent write SetOnEndPurgerJob;
|
|
|
+ property OnPurgeJobError : TPurgerJobErrorEvent write SetOnPurgerJobError;
|
|
|
+ procedure SetValue(const aKey : string; aValue : T; aExpirationMillisecons : Integer = 0); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : T; aExpirationDate : TDateTime); overload;
|
|
|
+ function GetValue(const aKey : string) : T;
|
|
|
+ function TryGetValue(const aKey : string; out aValue : T) : Boolean;
|
|
|
+ procedure RemoveValue(const aKey : string);
|
|
|
+ procedure Flush;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ IMemoryCache = interface(ICache)
|
|
|
+ ['{F109AE78-43D7-4983-B8ED-52A41533EEED}']
|
|
|
+ function GetCompression: Boolean;
|
|
|
+ procedure SetCompression(const Value: Boolean);
|
|
|
+ function GetCachedObjects: Integer;
|
|
|
+ function GetCacheSize: Integer;
|
|
|
+ procedure SetOnBeginPurgerJob(const Value: TBeginPurgerJobEvent);
|
|
|
+ procedure SetOnCacheFlushed(const Value: TCacheFlushedEvent);
|
|
|
+ procedure SetOnEndPurgerJob(const Value: TEndPurgerJobEvent);
|
|
|
+ procedure SetOnPurgerJobError(const Value: TPurgerJobErrorEvent);
|
|
|
+ property Compression : Boolean read GetCompression write SetCompression;
|
|
|
+ property CachedObjects : Integer read GetCachedObjects;
|
|
|
+ property CacheSize : Integer read GetCacheSize;
|
|
|
+ property OnCacheFlushed : TCacheFlushedEvent write SetOnCacheFlushed;
|
|
|
+ property OnBeginPurgerJob : TBeginPurgerJobEvent write SetOnBeginPurgerJob;
|
|
|
+ property OnEndPurgerJob : TEndPurgerJobEvent write SetOnEndPurgerJob;
|
|
|
+ property OnPurgeJobError : TPurgerJobErrorEvent write SetOnPurgerJobError;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TObject; aExpirationMilliseconds : Integer = 0); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TObject; aExpirationDate : TDateTime); overload;
|
|
|
+ procedure SetValue(const aKey, aValue : string; aExpirationMilliseconds : Integer = 0); overload;
|
|
|
+ procedure SetValue(const aKey, aValue : string; aExpirationDate : TDateTime); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TArray<string>; aExpirationMilliseconds : Integer = 0); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TArray<string>; aExpirationDate : TDateTime); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TArray<TObject>; aExpirationMilliseconds : Integer = 0); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TArray<TObject>; aExpirationDate : TDateTime); overload;
|
|
|
+ function GetValue(const aKey : string) : string; overload;
|
|
|
+ function TryGetValue(const aKey : string; aValue : TObject) : Boolean; overload;
|
|
|
+ function TryGetValue(const aKey : string; out aValue : string) : Boolean; overload;
|
|
|
+ function TryGetValue(const aKey : string; out aValue : TArray<string>) : Boolean; overload;
|
|
|
+ function TryGetValue(const aKey : string; out aValue : TArray<TObject>) : Boolean; overload;
|
|
|
+ procedure RemoveValue(const aKey : string);
|
|
|
+ procedure Flush;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TCacheEntry = class(TInterfacedObject,ICacheEntry)
|
|
|
+ private
|
|
|
+ fCreationDate : TDateTime;
|
|
|
+ fExpiration : Cardinal;
|
|
|
+ fExpirationDate : TDateTime;
|
|
|
+ fCompression : Boolean;
|
|
|
+ fCompressor : ICacheCompressor;
|
|
|
+ fData : string;
|
|
|
+ fIsCompressed : Boolean;
|
|
|
+ function GetCreationDate: TDateTime;
|
|
|
+ function GetData: string;
|
|
|
+ function GetExpiration: Cardinal;
|
|
|
+ procedure SetCreationDate(const Value: TDateTime);
|
|
|
+ procedure SetData(const Value: string);
|
|
|
+ procedure SetExpiration(aMilliseconds : Cardinal);
|
|
|
+ function GetExpirationDate: TDateTime;
|
|
|
+ procedure SetExpirationDate(const Value: TDateTime);
|
|
|
+ public
|
|
|
+ constructor Create(aCompression : Boolean; aCacheCompressor : ICacheCompressor);
|
|
|
+ property CreationDate : TDateTime read GetCreationDate write SetCreationDate;
|
|
|
+ property Expiration : Cardinal read GetExpiration write SetExpiration;
|
|
|
+ property ExpirationDate : TDateTime read GetExpirationDate write SetExpirationDate;
|
|
|
+ property Data : string read GetData write SetData;
|
|
|
+ function Size : Integer;
|
|
|
+ function IsExpired : Boolean;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TMemoryCacheBase = class(TInterfacedObject)
|
|
|
+ private
|
|
|
+ fPurgerInterval : Integer;
|
|
|
+ fMaxSize : Integer;
|
|
|
+ fCachedObjects : Integer;
|
|
|
+ fCacheSize : Integer;
|
|
|
+ fCompression : Boolean;
|
|
|
+ fLock : TMultiReadExclusiveWriteSynchronizer;
|
|
|
+ fCacheJobs : TScheduledTasks;
|
|
|
+ fOnCacheFlushed : TCacheFlushedEvent;
|
|
|
+ fOnPurgerJobError : TPurgerJobErrorEvent;
|
|
|
+ fOnBeginPurgerJob : TBeginPurgerJobEvent;
|
|
|
+ fOnEndPurgerJob : TEndPurgerJobEvent;
|
|
|
+ procedure CreatePurgerJobs;
|
|
|
+ procedure RemoveExpiredCacheEntries; virtual;
|
|
|
+ procedure SetPurgerInterval(const Value: Integer);
|
|
|
+ protected
|
|
|
+ fItems : TDictionary<string,ICacheEntry>;
|
|
|
+ fSerializer : ICacheSerializer;
|
|
|
+ fCompressor : ICacheCompressor;
|
|
|
+ function GetCachedObjects: Integer;
|
|
|
+ function GetCacheSize: Integer;
|
|
|
+ procedure SetOnBeginPurgerJob(const Value: TBeginPurgerJobEvent);
|
|
|
+ procedure SetOnCacheFlushed(const Value: TCacheFlushedEvent);
|
|
|
+ procedure SetOnEndPurgerJob(const Value: TEndPurgerJobEvent);
|
|
|
+ procedure SetOnPurgerJobError(const Value: TPurgerJobErrorEvent);
|
|
|
+ function GetCompression: Boolean;
|
|
|
+ procedure SetCompression(const Value: Boolean);
|
|
|
+ public
|
|
|
+ constructor Create(aPurgerInterval : Integer = 20; aCacheSerializer : ICacheSerializer = nil; aCacheCompressor : ICacheCompressor = nil); virtual;
|
|
|
+ destructor Destroy; override;
|
|
|
+ property MaxSize : Integer read fMaxSize write fMaxSize;
|
|
|
+ property PurgerInterval : Integer read fPurgerInterval;
|
|
|
+ property Compression : Boolean read GetCompression write SetCompression;
|
|
|
+ property CachedObjects : Integer read GetCachedObjects;
|
|
|
+ property CacheSize : Integer read GetCacheSize;
|
|
|
+ property OnCacheFlushed : TCacheFlushedEvent read fOnCacheFlushed write SetOnCacheFlushed;
|
|
|
+ property OnBeginPurgerJob : TBeginPurgerJobEvent read fOnBeginPurgerJob write SetOnBeginPurgerJob;
|
|
|
+ property OnEndPurgerJob : TEndPurgerJobEvent read fOnEndPurgerJob write SetOnEndPurgerJob;
|
|
|
+ property OnPurgeJobError : TPurgerJobErrorEvent read fOnPurgerJobError write SetOnPurgerJobError;
|
|
|
+ procedure RemoveValue(const aKey : string); virtual;
|
|
|
+ procedure Flush; virtual;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TMemoryCache<T> = class(TMemoryCacheBase,IMemoryCache<T>)
|
|
|
+ private
|
|
|
+ procedure SetValue(const aKey : string; aValue : T; aExpirationMilliseconds : Integer; aExpirationDate : TDateTime); overload;
|
|
|
+ public
|
|
|
+ constructor Create(aPurgerInterval : Integer = 20; aCacheSerializer : ICacheSerializer = nil; aCacheCompressor : ICacheCompressor = nil); override;
|
|
|
+ procedure SetValue(const aKey : string; aValue : T; aExpirationMillisecons : Integer = 0); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : T; aExpirationDate : TDateTime); overload;
|
|
|
+ function GetValue(const aKey : string) : T;
|
|
|
+ function TryGetValue(const aKey : string; out oValue : T) : Boolean;
|
|
|
+ procedure RemoveValue(const aKey : string); override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TMemoryCache = class(TMemoryCacheBase,IMemoryCache)
|
|
|
+ private
|
|
|
+ procedure SetValue(const aKey: string; aValue: TObject; aExpirationMilliseconds : Integer; aExpirationDate : TDateTime); overload;
|
|
|
+ procedure SetValue(const aKey, aValue: string; aExpirationMilliseconds : Integer; aExpirationDate : TDateTime); overload;
|
|
|
+ public
|
|
|
+ procedure SetValue(const aKey, aValue : string; aExpirationMilliseconds : Integer = 0); overload;
|
|
|
+ procedure SetValue(const aKey, aValue : string; aExpirationDate : TDateTime); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TObject; aExpirationMilliseconds : Integer = 0); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TObject; aExpirationDate : TDateTime); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TArray<string>; aExpirationMilliseconds : Integer = 0); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TArray<string>; aExpirationDate : TDateTime); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TArray<TObject>; aExpirationMilliseconds : Integer = 0); overload;
|
|
|
+ procedure SetValue(const aKey : string; aValue : TArray<TObject>; aExpirationDate : TDateTime); overload;
|
|
|
+ function GetValue(const aKey : string) : string; overload;
|
|
|
+ function TryGetValue(const aKey : string; out aValue : string) : Boolean; overload;
|
|
|
+ function TryGetValue(const aKey : string; aValue : TObject) : Boolean; overload;
|
|
|
+ function TryGetValue<T>(const aKey : string; out oValue : T) : Boolean; overload;
|
|
|
+ function TryGetValue(const aKey : string; out aValue : TArray<string>) : Boolean; overload;
|
|
|
+ function TryGetValue(const aKey : string; out aValue : TArray<TObject>) : Boolean; overload;
|
|
|
+ end;
|
|
|
+
|
|
|
+ EMemoryCacheConfigError = class(Exception);
|
|
|
+ EMemoryCacheSetError = class(Exception);
|
|
|
+ EMemoryCacheGetError = class(Exception);
|
|
|
+ EMemoryCacheFlushError = class(Exception);
|
|
|
+
|
|
|
+
|
|
|
+implementation
|
|
|
+
|
|
|
+{ TMemoryCacheBase }
|
|
|
+
|
|
|
+constructor TMemoryCacheBase.Create(aPurgerInterval : Integer = 20; aCacheSerializer : ICacheSerializer = nil; aCacheCompressor : ICacheCompressor = nil);
|
|
|
+begin
|
|
|
+ fCompression := True;
|
|
|
+ SetPurgerInterval(aPurgerInterval);
|
|
|
+ fCachedObjects := 0;
|
|
|
+ fCacheSize := 0;
|
|
|
+ fLock := TMultiReadExclusiveWriteSynchronizer.Create;
|
|
|
+ if aCacheSerializer <> nil then fSerializer := aCacheSerializer
|
|
|
+ else fSerializer := TCacheJsonSerializer.Create;
|
|
|
+ if aCacheCompressor <> nil then fCompressor := aCacheCompressor
|
|
|
+ else fCompressor := TCacheCompressorGZip.Create;
|
|
|
+
|
|
|
+ fItems := TDictionary<string,ICacheEntry>.Create;
|
|
|
+ fCacheJobs := TScheduledTasks.Create;
|
|
|
+ CreatePurgerJobs;
|
|
|
+ fCacheJobs.Start;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCacheBase.CreatePurgerJobs;
|
|
|
+begin
|
|
|
+ fCacheJobs.AddTask('RemoveExpired',procedure (task : ITask)
|
|
|
+ begin
|
|
|
+ RemoveExpiredCacheEntries;
|
|
|
+ end
|
|
|
+ ).OnException(procedure(task : ITask; aException : Exception)
|
|
|
+ begin
|
|
|
+ if Assigned(fOnPurgerJobError) then fOnPurgerJobError(aException.Message);
|
|
|
+ end
|
|
|
+ ).StartInSeconds(fPurgerInterval).RepeatEvery(fPurgerInterval,TTimeMeasure.tmSeconds);
|
|
|
+end;
|
|
|
+
|
|
|
+destructor TMemoryCacheBase.Destroy;
|
|
|
+begin
|
|
|
+ fItems.Free;
|
|
|
+ fLock.Free;
|
|
|
+ fCacheJobs.Stop;
|
|
|
+ fCacheJobs.Free;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCacheBase.Flush;
|
|
|
+begin
|
|
|
+ fLock.BeginWrite;
|
|
|
+ try
|
|
|
+ fItems.Clear;
|
|
|
+ if Assigned(fOnCacheFlushed) then fOnCacheFlushed(fCachedObjects);
|
|
|
+ fCachedObjects := 0;
|
|
|
+ fCacheSize := 0;
|
|
|
+ finally
|
|
|
+ fLock.EndWrite;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCacheBase.RemoveExpiredCacheEntries;
|
|
|
+var
|
|
|
+ pair : TPair<string,ICacheEntry>;
|
|
|
+ removedentries : Integer;
|
|
|
+begin
|
|
|
+ if Assigned(fOnBeginPurgerJob) then fOnBeginPurgerJob;
|
|
|
+ removedentries := 0;
|
|
|
+ fLock.BeginRead;
|
|
|
+ try
|
|
|
+ for pair in fItems do
|
|
|
+ begin
|
|
|
+ if pair.Value.IsExpired then
|
|
|
+ begin
|
|
|
+ fLock.BeginWrite;
|
|
|
+ try
|
|
|
+ //decrease cacheitem size to cachesize
|
|
|
+ AtomicDecrement(fCacheSize,pair.Value.Size);
|
|
|
+ //remove cacheitem from cache
|
|
|
+ fItems.Remove(pair.Key);
|
|
|
+ //decrease cachedobjects
|
|
|
+ AtomicDecrement(fCachedObjects,1);
|
|
|
+ Inc(removedentries);
|
|
|
+ finally
|
|
|
+ fLock.EndWrite;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ finally
|
|
|
+ fLock.EndRead;
|
|
|
+ if Assigned(fOnEndPurgerJob) then fOnEndPurgerJob(removedentries);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCacheBase.RemoveValue(const aKey: string);
|
|
|
+var
|
|
|
+ cacheitem : ICacheEntry;
|
|
|
+begin
|
|
|
+ if fItems.TryGetValue(aKey,cacheitem) then
|
|
|
+ begin
|
|
|
+ //decrease cacheitem size to cachesize
|
|
|
+ AtomicDecrement(fCacheSize,cacheitem.Size);
|
|
|
+ //remove cacheitem from cache
|
|
|
+ fItems.Remove(aKey);
|
|
|
+ //decrease cachedobjects
|
|
|
+ AtomicDecrement(fCachedObjects,1);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TMemoryCacheBase.GetCachedObjects: Integer;
|
|
|
+begin
|
|
|
+ Result := fCachedObjects;
|
|
|
+end;
|
|
|
+
|
|
|
+function TMemoryCacheBase.GetCacheSize: Integer;
|
|
|
+begin
|
|
|
+ Result := fCacheSize;
|
|
|
+end;
|
|
|
+
|
|
|
+function TMemoryCacheBase.GetCompression: Boolean;
|
|
|
+begin
|
|
|
+ Result := fCompression;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCacheBase.SetCompression(const Value: Boolean);
|
|
|
+begin
|
|
|
+ fCompression := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCacheBase.SetOnBeginPurgerJob(const Value: TBeginPurgerJobEvent);
|
|
|
+begin
|
|
|
+ fOnBeginPurgerJob := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCacheBase.SetOnCacheFlushed(const Value: TCacheFlushedEvent);
|
|
|
+begin
|
|
|
+ fOnCacheFlushed := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCacheBase.SetOnEndPurgerJob(const Value: TEndPurgerJobEvent);
|
|
|
+begin
|
|
|
+ fOnEndPurgerJob := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCacheBase.SetOnPurgerJobError(const Value: TPurgerJobErrorEvent);
|
|
|
+begin
|
|
|
+ fOnPurgerJobError := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCacheBase.SetPurgerInterval(const Value: Integer);
|
|
|
+begin
|
|
|
+ if Value > 5 then
|
|
|
+ begin
|
|
|
+ fPurgerInterval := Value;
|
|
|
+ end
|
|
|
+ else raise EMemoryCacheConfigError.Create('Purger Interval must be greater than 5 seconds');
|
|
|
+end;
|
|
|
+
|
|
|
+{ TCacheItem }
|
|
|
+
|
|
|
+constructor TCacheEntry.Create(aCompression : Boolean; aCacheCompressor : ICacheCompressor);
|
|
|
+begin
|
|
|
+ fIsCompressed := False;
|
|
|
+ fCompression := aCompression;
|
|
|
+ fCompressor := aCacheCompressor;
|
|
|
+end;
|
|
|
+
|
|
|
+function TCacheEntry.GetCreationDate: TDateTime;
|
|
|
+begin
|
|
|
+ Result := fCreationDate;
|
|
|
+end;
|
|
|
+
|
|
|
+function TCacheEntry.GetData: string;
|
|
|
+begin
|
|
|
+ if fIsCompressed then Result := fCompressor.Decompress(fData)
|
|
|
+ else Result := fData;
|
|
|
+end;
|
|
|
+
|
|
|
+function TCacheEntry.GetExpiration: Cardinal;
|
|
|
+begin
|
|
|
+ Result := fExpiration;
|
|
|
+end;
|
|
|
+
|
|
|
+function TCacheEntry.GetExpirationDate: TDateTime;
|
|
|
+begin
|
|
|
+ Result := fExpirationDate;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TCacheEntry.SetCreationDate(const Value: TDateTime);
|
|
|
+begin
|
|
|
+ fCreationDate := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TCacheEntry.SetExpiration(aMilliseconds: Cardinal);
|
|
|
+begin
|
|
|
+ fExpiration := aMilliseconds;
|
|
|
+ fExpirationDate := IncMilliSecond(fCreationDate,fExpiration);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TCacheEntry.SetExpirationDate(const Value: TDateTime);
|
|
|
+begin
|
|
|
+ fExpiration := MilliSecondOf(Value);
|
|
|
+ fExpirationDate := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+function TCacheEntry.IsExpired: Boolean;
|
|
|
+begin
|
|
|
+ if fExpiration = 0 then Result := False
|
|
|
+ else Result := Now() > fExpirationDate;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TCacheEntry.SetData(const Value: string);
|
|
|
+begin
|
|
|
+ fIsCompressed := False;
|
|
|
+ //var a := value;
|
|
|
+ //var b := value.Length;
|
|
|
+ if fCompression then
|
|
|
+ begin
|
|
|
+ if ((Value.Length + 1) * 2) > 1024 then
|
|
|
+ begin
|
|
|
+ fData := fCompressor.Compress(Value);
|
|
|
+ fIsCompressed := True;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ fData := Value;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else fData := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+function TCacheEntry.Size: Integer;
|
|
|
+begin
|
|
|
+ //Result := (fData.Length + 1) * SizeOf(Char);
|
|
|
+ Result := (fData.Length + 1) * StringElementSize(fData);
|
|
|
+end;
|
|
|
+
|
|
|
+{ TMemoryCache<T> }
|
|
|
+
|
|
|
+constructor TMemoryCache<T>.Create(aPurgerInterval: Integer; aCacheSerializer: ICacheSerializer; aCacheCompressor: ICacheCompressor);
|
|
|
+begin
|
|
|
+ inherited Create(aPurgerInterval,aCacheSerializer,aCacheCompressor);
|
|
|
+end;
|
|
|
+
|
|
|
+function TMemoryCache<T>.GetValue(const aKey: string): T;
|
|
|
+var
|
|
|
+ cacheitem : ICacheEntry;
|
|
|
+begin
|
|
|
+ fLock.BeginRead;
|
|
|
+ try
|
|
|
+ fItems.TryGetValue(aKey,cacheitem);
|
|
|
+ finally
|
|
|
+ fLock.EndRead;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache<T>.RemoveValue(const aKey: string);
|
|
|
+begin
|
|
|
+ inherited RemoveValue(aKey);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache<T>.SetValue(const aKey: string; aValue: T; aExpirationDate: TDateTime);
|
|
|
+begin
|
|
|
+ SetValue(aKey,aValue,0,aExpirationDate);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache<T>.SetValue(const aKey: string; aValue: T; aExpirationMillisecons: Integer);
|
|
|
+begin
|
|
|
+ SetValue(aKey,aValue,aExpirationMillisecons,0.0);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache<T>.SetValue(const aKey: string; aValue: T; aExpirationMilliseconds : Integer; aExpirationDate : TDateTime);
|
|
|
+var
|
|
|
+ serialized : string;
|
|
|
+ cacheitem : TCacheEntry;
|
|
|
+begin
|
|
|
+ fLock.BeginWrite;
|
|
|
+ try
|
|
|
+ cacheitem := TCacheEntry.Create(fCompression,fCompressor);
|
|
|
+ cacheitem.CreationDate := Now();
|
|
|
+ cacheitem.Expiration := aExpirationMilliseconds;
|
|
|
+ if aExpirationDate > 0.0 then cacheitem.ExpirationDate := aExpirationDate;
|
|
|
+ //add object to cache
|
|
|
+ case PTypeInfo(TypeInfo(T))^.Kind of
|
|
|
+ tkClass, tkPointer :
|
|
|
+ begin
|
|
|
+ //object type need to be serialized
|
|
|
+ cacheitem.Data := fSerializer.Serialize(PObject(@aValue)^);
|
|
|
+ end;
|
|
|
+ tkString, tkWideString, tkUString, tkChar, tkWideChar : cacheitem.Data := string((@aValue)^);
|
|
|
+ {$IFNDEF NEXTGEN}
|
|
|
+ tkAnsiString : cacheitem.Data := string(AnsiString((@aValue)^));
|
|
|
+ {$ENDIF}
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ raise EMemoryCacheSetError.Create('Type not supported as cache');
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ RemoveValue(aKey);
|
|
|
+ fItems.Add(aKey,cacheitem);
|
|
|
+ //add cacheitem size to cachesize
|
|
|
+ AtomicIncrement(fCacheSize,cacheitem.Size);
|
|
|
+ //increment cacheobjects
|
|
|
+ AtomicIncrement(fCachedObjects,1);
|
|
|
+ finally
|
|
|
+ fLock.EndWrite;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TMemoryCache<T>.TryGetValue(const aKey: string; out oValue: T): Boolean;
|
|
|
+var
|
|
|
+ cacheitem : ICacheEntry;
|
|
|
+ flexvalue : TFlexValue;
|
|
|
+ obj : TObject;
|
|
|
+begin
|
|
|
+ fLock.BeginRead;
|
|
|
+ try
|
|
|
+ Result := fItems.TryGetValue(aKey,cacheitem);
|
|
|
+ //check if cacheitem already expired
|
|
|
+ if Result and cacheitem.IsExpired then Exit(False);
|
|
|
+ finally
|
|
|
+ fLock.EndRead;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if Result then
|
|
|
+ begin
|
|
|
+ flexvalue.AsString := cacheitem.Data;
|
|
|
+ case PTypeInfo(TypeInfo(T))^.Kind of
|
|
|
+ tkInteger : oValue := TValue.From(flexvalue.AsInteger).AsType<T>;
|
|
|
+ tkInt64 : oValue := TValue.From(flexvalue.AsInt64).AsType<T>;
|
|
|
+ tkFloat :
|
|
|
+ begin
|
|
|
+ if TypeInfo(T) = TypeInfo(TDateTime) then oValue := TValue.From(flexvalue.AsDateTime).AsType<T>
|
|
|
+ else oValue := TValue.From(flexvalue.AsExtended).AsType<T>;
|
|
|
+ end;
|
|
|
+ tkString,
|
|
|
+ tkUString : oValue := TValue.From(flexvalue.AsString).AsType<T>;
|
|
|
+ {$IFDEF MSWINDOWS}
|
|
|
+ tkAnsiString : oValue := TValue.From(flexvalue.AsAnsiString).AsType<T>;
|
|
|
+ tkWideString : oValue := TValue.From(flexvalue.AsWideString).AsType<T>;
|
|
|
+ {$ENDIF}
|
|
|
+ tkEnumeration :
|
|
|
+ begin
|
|
|
+ if TypeInfo(T) = TypeInfo(Boolean) then oValue := TValue.From(flexvalue.AsBoolean).AsType<T>
|
|
|
+ else oValue := TValue.From(flexvalue.AsInteger).AsType<T>;
|
|
|
+ end;
|
|
|
+ tkClass, tkPointer :
|
|
|
+ begin
|
|
|
+ obj := PTypeInfo(TypeInfo(T))^.TypeData.ClassType.Create;
|
|
|
+ fSerializer.Deserialize(cacheitem.Data,obj);
|
|
|
+ oValue := TValue.From(obj).AsType<T>;
|
|
|
+ //oValue := T((@obj)^);
|
|
|
+ end
|
|
|
+ else raise EMemoryCacheGetError.Create('Error casting value from cache');
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{ TMemoryCache }
|
|
|
+
|
|
|
+function TMemoryCache.GetValue(const aKey: string): string;
|
|
|
+var
|
|
|
+ cacheitem : ICacheEntry;
|
|
|
+begin
|
|
|
+ if fItems.TryGetValue(aKey,cacheitem) then Result := cacheitem.Data;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache.SetValue(const aKey, aValue: string; aExpirationMilliseconds: Integer);
|
|
|
+begin
|
|
|
+ SetValue(aKey,aValue,aExpirationMilliseconds,0.0);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache.SetValue(const aKey, aValue: string; aExpirationDate: TDateTime);
|
|
|
+begin
|
|
|
+ SetValue(aKey,aValue,0,aExpirationDate);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache.SetValue(const aKey: string; aValue: TObject; aExpirationMilliseconds: Integer);
|
|
|
+begin
|
|
|
+ SetValue(aKey,aValue,aExpirationMilliseconds,0.0);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache.SetValue(const aKey: string; aValue: TObject; aExpirationDate: TDateTime);
|
|
|
+begin
|
|
|
+ SetValue(aKey,aValue,0,aExpirationDate);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache.SetValue(const aKey: string; aValue: TObject; aExpirationMilliseconds : Integer; aExpirationDate : TDateTime);
|
|
|
+begin
|
|
|
+ SetValue(aKey,fSerializer.Serialize(aValue),aExpirationMilliseconds,aExpirationDate);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache.SetValue(const aKey, aValue: string; aExpirationMilliseconds : Integer; aExpirationDate : TDateTime);
|
|
|
+var
|
|
|
+ cacheitem : TCacheEntry;
|
|
|
+begin
|
|
|
+ fLock.BeginWrite;
|
|
|
+ try
|
|
|
+ cacheitem := TCacheEntry.Create(fCompression,fCompressor);
|
|
|
+ cacheitem.CreationDate := Now();
|
|
|
+ cacheitem.Expiration := aExpirationMilliseconds;
|
|
|
+ if aExpirationDate > 0.0 then cacheitem.ExpirationDate := aExpirationDate;
|
|
|
+ //add object to cache
|
|
|
+ cacheitem.Data := aValue;
|
|
|
+ RemoveValue(aKey);
|
|
|
+ fItems.Add(aKey,cacheitem);
|
|
|
+ //add cacheitem size to cachesize
|
|
|
+ AtomicIncrement(fCacheSize,cacheitem.Size);
|
|
|
+ //increment cacheobjects
|
|
|
+ AtomicIncrement(fCachedObjects,1);
|
|
|
+ finally
|
|
|
+ fLock.EndWrite;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache.SetValue(const aKey: string; aValue: TArray<string>; aExpirationDate: TDateTime);
|
|
|
+begin
|
|
|
+ SetValue(aKey,fSerializer.Serialize(aValue),0,aExpirationDate);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache.SetValue(const aKey: string; aValue: TArray<string>; aExpirationMilliseconds: Integer);
|
|
|
+begin
|
|
|
+ SetValue(aKey,fSerializer.Serialize(aValue),aExpirationMilliseconds,0.0);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache.SetValue(const aKey: string; aValue: TArray<TObject>; aExpirationDate: TDateTime);
|
|
|
+begin
|
|
|
+ SetValue(aKey,fSerializer.Serialize(aValue),0,aExpirationDate);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TMemoryCache.SetValue(const aKey: string; aValue: TArray<TObject>; aExpirationMilliseconds: Integer);
|
|
|
+begin
|
|
|
+ SetValue(aKey,fSerializer.Serialize(aValue),aExpirationMilliseconds,0.0);
|
|
|
+end;
|
|
|
+
|
|
|
+function TMemoryCache.TryGetValue(const aKey: string; aValue : TObject): Boolean;
|
|
|
+var
|
|
|
+ cacheitem : ICacheEntry;
|
|
|
+begin
|
|
|
+ fLock.BeginRead;
|
|
|
+ try
|
|
|
+ if aValue = nil then raise EMemoryCacheGetError.Create('Cannot passed a nil object as param');
|
|
|
+
|
|
|
+ Result := fItems.TryGetValue(aKey,cacheitem);
|
|
|
+ //check if cacheitem already expired
|
|
|
+ if (not Result) or (cacheitem.IsExpired) then Exit(False);
|
|
|
+ finally
|
|
|
+ fLock.EndRead;
|
|
|
+ end;
|
|
|
+ fSerializer.Deserialize(cacheitem.Data,aValue);
|
|
|
+end;
|
|
|
+
|
|
|
+function TMemoryCache.TryGetValue(const aKey: string; out aValue: string): Boolean;
|
|
|
+begin
|
|
|
+ Result := TryGetValue<string>(aKey,aValue);
|
|
|
+end;
|
|
|
+
|
|
|
+function TMemoryCache.TryGetValue<T>(const aKey: string; out oValue: T): Boolean;
|
|
|
+var
|
|
|
+ cacheitem : ICacheEntry;
|
|
|
+ flexvalue : TFlexValue;
|
|
|
+ obj : TObject;
|
|
|
+begin
|
|
|
+ fLock.BeginRead;
|
|
|
+ try
|
|
|
+ Result := fItems.TryGetValue(aKey,cacheitem);
|
|
|
+ //check if cacheitem already expired
|
|
|
+ if Result and cacheitem.IsExpired then Exit(False);
|
|
|
+ finally
|
|
|
+ fLock.EndRead;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if Result then
|
|
|
+ begin
|
|
|
+ flexvalue.AsString := cacheitem.Data;
|
|
|
+ case PTypeInfo(TypeInfo(T))^.Kind of
|
|
|
+ tkInteger : oValue := TValue.From(flexvalue.AsInteger).AsType<T>;
|
|
|
+ tkInt64 : oValue := TValue.From(flexvalue.AsInt64).AsType<T>;
|
|
|
+ tkFloat :
|
|
|
+ begin
|
|
|
+ if TypeInfo(T) = TypeInfo(TDateTime) then oValue := TValue.From(flexvalue.AsDateTime).AsType<T>
|
|
|
+ else oValue := TValue.From(flexvalue.AsExtended).AsType<T>;
|
|
|
+ end;
|
|
|
+ tkString,
|
|
|
+ tkUString : oValue := TValue.From(flexvalue.AsString).AsType<T>;
|
|
|
+ {$IFDEF MSWINDOWS}
|
|
|
+ tkAnsiString : oValue := TValue.From(flexvalue.AsAnsiString).AsType<T>;
|
|
|
+ tkWideString : oValue := TValue.From(flexvalue.AsWideString).AsType<T>;
|
|
|
+ {$ENDIF}
|
|
|
+ tkEnumeration :
|
|
|
+ begin
|
|
|
+ if TypeInfo(T) = TypeInfo(Boolean) then oValue := TValue.From(flexvalue.AsBoolean).AsType<T>
|
|
|
+ else oValue := TValue.From(flexvalue.AsInteger).AsType<T>;
|
|
|
+ end;
|
|
|
+ tkClass, tkPointer :
|
|
|
+ begin
|
|
|
+ obj := PTypeInfo(TypeInfo(T))^.TypeData.ClassType.Create;
|
|
|
+ fSerializer.Deserialize(flexvalue.AsString,obj);
|
|
|
+ oValue := TValue.From(obj).AsType<T>;
|
|
|
+ end;
|
|
|
+ else raise EMemoryCacheGetError.Create('Error casting value from cache');
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TMemoryCache.TryGetValue(const aKey: string; out aValue: TArray<string>): Boolean;
|
|
|
+var
|
|
|
+ cacheitem : ICacheEntry;
|
|
|
+ flexvalue : TFlexValue;
|
|
|
+ obj : TObject;
|
|
|
+begin
|
|
|
+ fLock.BeginRead;
|
|
|
+ try
|
|
|
+ Result := fItems.TryGetValue(aKey,cacheitem);
|
|
|
+ //check if cacheitem already expired
|
|
|
+ if Result and cacheitem.IsExpired then Exit(False);
|
|
|
+ finally
|
|
|
+ fLock.EndRead;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if Result then fSerializer.Deserialize(cacheitem.Data,aValue);
|
|
|
+end;
|
|
|
+
|
|
|
+function TMemoryCache.TryGetValue(const aKey: string; out aValue: TArray<TObject>): Boolean;
|
|
|
+var
|
|
|
+ cacheitem : ICacheEntry;
|
|
|
+ flexvalue : TFlexValue;
|
|
|
+ obj : TObject;
|
|
|
+begin
|
|
|
+ fLock.BeginRead;
|
|
|
+ try
|
|
|
+ Result := fItems.TryGetValue(aKey,cacheitem);
|
|
|
+ //check if cacheitem already expired
|
|
|
+ if Result and cacheitem.IsExpired then Exit(False);
|
|
|
+ finally
|
|
|
+ fLock.EndRead;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if Result then fSerializer.Deserialize(cacheitem.Data,aValue);
|
|
|
+end;
|
|
|
+
|
|
|
+end.
|