diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..ff3b896 --- /dev/null +++ b/.gitignore @@ -0,0 +1,45 @@ +modules/ +dist/ +static/ +**/Win32/ +**/Win64/ +**/Linux64/ +**/__history/ +**/__recovery/ +src/*.~* +*.res +*.exe +*.dll +*.bpl +*.bpi +*.dcp +*.so +*.apk +*.drc +*.map +*.dres +*.rsm +*.tds +*.dcu +*.lib +*.a +*.o +*.ocx +*.local +*.identcache +*.projdata +*.tvsconfig +*.dsk +*.dcu +*.exe +*.so +*.~* +*.a +*.stat + +# Mac +*.DS_Store + +#FPC/Laz +lib/ +backup/ diff --git a/boss-lock.json b/boss-lock.json new file mode 100644 index 0000000..e0286c2 --- /dev/null +++ b/boss-lock.json @@ -0,0 +1,5 @@ +{ + "hash": "d41d8cd98f00b204e9800998ecf8427e", + "updated": "2021-03-26T00:33:03.1669505-03:00", + "installedModules": {} +} \ No newline at end of file diff --git a/boss.json b/boss.json new file mode 100644 index 0000000..dde3a1c --- /dev/null +++ b/boss.json @@ -0,0 +1,9 @@ +{ + "name": "pool-manager", + "description": "Pool manager for Delphi objects", + "version": "1.0.0", + "homepage": "https://github.com/CarlosHe/pool-manager", + "mainsrc": "./src/", + "projects": [], + "dependencies": {} +} \ No newline at end of file diff --git a/src/PoolManager.pas b/src/PoolManager.pas new file mode 100644 index 0000000..591d8d7 --- /dev/null +++ b/src/PoolManager.pas @@ -0,0 +1,251 @@ +unit PoolManager; + +interface + +uses + System.SyncObjs, + System.Generics.Collections, + System.Classes, + System.SysUtils; + +type + + TPoolItem = class + private + FMultiReadExclusiveWriteSynchronizer: TMultiReadExclusiveWriteSynchronizer; + FInstance: T; + FRefCount: Integer; + FIdleTime: TDateTime; + FInstanceOwner: Boolean; + public + function GetRefCount: Integer; + function IsIdle(out AIdleTime: TDateTime): Boolean; + function Acquire: T; + procedure Release; + constructor Create(AInstance: T; const AInstanceOwner: Boolean = True); + destructor Destroy; override; + end; + + TPoolManager = class(TThread) + private + { private declarations } + FMultiReadExclusiveWriteSynchronizer: TMultiReadExclusiveWriteSynchronizer; + FEvent: TEvent; + FPoolItemList: TObjectList>; + FMaxRefCountPerItem: Integer; + FMaxIdleSeconds: Int64; + FMinPoolCount: Integer; + protected + { protected declarations } + procedure FreeInternalInternalInstances; + procedure DoReleaseItems; + public + { public declarations } + procedure DoGetInstance(var AInstance: T; var AInstanceOwner: Boolean); virtual; abstract; + procedure SetMaxRefCountPerItem(AMaxRefCountPerItem: Integer); + procedure SetMaxIdleSeconds(AMaxIdleSeconds: Int64); + procedure SetMinPoolCount(AMinPoolCount: Integer); + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + procedure Execute; override; + function TryGetItem: TPoolItem; + end; + +implementation + +uses + System.DateUtils; + +{ TPoolItem } + +function TPoolItem.Acquire: T; +begin + FMultiReadExclusiveWriteSynchronizer.BeginWrite; + try + TInterlocked.Increment(FRefCount); + Result := FInstance; + finally + FMultiReadExclusiveWriteSynchronizer.EndWrite + end; +end; + +constructor TPoolItem.Create(AInstance: T; const AInstanceOwner: Boolean = True); +begin + FMultiReadExclusiveWriteSynchronizer := TMultiReadExclusiveWriteSynchronizer.Create; + FInstance := AInstance; + FInstanceOwner := AInstanceOwner; + FIdleTime := Now(); +end; + +destructor TPoolItem.Destroy; +begin + if FInstanceOwner then + FInstance.Free; + FMultiReadExclusiveWriteSynchronizer.Free; + inherited; +end; + +function TPoolItem.GetRefCount: Integer; +begin + FMultiReadExclusiveWriteSynchronizer.BeginRead; + try + Result := FRefCount; + finally + FMultiReadExclusiveWriteSynchronizer.EndRead; + end; +end; + +function TPoolItem.IsIdle(out AIdleTime: TDateTime): Boolean; +begin + FMultiReadExclusiveWriteSynchronizer.BeginRead; + try + Result := FRefCount = 0; + if Result then + AIdleTime := FIdleTime; + finally + FMultiReadExclusiveWriteSynchronizer.EndRead; + end; +end; + +procedure TPoolItem.Release; +begin + FMultiReadExclusiveWriteSynchronizer.BeginWrite; + try + if FRefCount > 0 then + TInterlocked.Decrement(FRefCount); + if FRefCount = 0 then + FIdleTime := Now; + finally + FMultiReadExclusiveWriteSynchronizer.EndWrite; + end; +end; + +{ TPoolManager } + +function TPoolManager.TryGetItem: TPoolItem; +var + I: Integer; + LPoolItem: TPoolItem; + LInstance: T; + LInstanceOwner: Boolean; +begin + Result := nil; + FMultiReadExclusiveWriteSynchronizer.BeginWrite; + try + for I := 0 to Pred(FPoolItemList.Count) do + begin + if FPoolItemList.Items[I].GetRefCount < FMaxRefCountPerItem then + begin + Result := FPoolItemList.Items[I]; + Break; + end; + end; + if Result = nil then + begin + try + LInstance := nil; + LInstanceOwner := False; + DoGetInstance(LInstance, LInstanceOwner); + finally + if LInstance <> nil then + begin + LPoolItem := TPoolItem.Create(LInstance, LInstanceOwner); + Result := LPoolItem; + FPoolItemList.Add(LPoolItem); + end; + end; + end; + finally + FMultiReadExclusiveWriteSynchronizer.EndWrite; + end; +end; + +procedure TPoolManager.AfterConstruction; +begin + inherited; + FreeOnTerminate := False; + FMinPoolCount := 0; + FMaxRefCountPerItem := 1; + FMaxIdleSeconds := 60; + FEvent := TEvent.Create; + FPoolItemList := TObjectList < TPoolItem < T >>.Create; + FMultiReadExclusiveWriteSynchronizer := TMultiReadExclusiveWriteSynchronizer.Create; +end; + +procedure TPoolManager.BeforeDestruction; +begin + Terminate; + FEvent.SetEvent; + WaitFor; + FreeInternalInternalInstances; + inherited; +end; + +procedure TPoolManager.DoReleaseItems; +var + I: Integer; + LIdleTime: TDateTime; +begin + FMultiReadExclusiveWriteSynchronizer.BeginWrite; + try + for I := Pred(FPoolItemList.Count) downto 0 do + begin + if CheckTerminated then + Break; + if (FPoolItemList.Items[I].IsIdle(LIdleTime)) and (FPoolItemList.Count > FMinPoolCount) then + begin + if SecondsBetween(Now, LIdleTime) >= FMaxIdleSeconds then + begin + FPoolItemList.Delete(I); + end; + end; + end; + finally + FMultiReadExclusiveWriteSynchronizer.EndWrite; + end; +end; + +procedure TPoolManager.Execute; +var + LWaitResult: TWaitResult; +begin + inherited; + while not CheckTerminated do + begin + try + LWaitResult := FEvent.WaitFor(100); + if CheckTerminated then + Exit; + if LWaitResult = wrTimeout then + DoReleaseItems; + if LWaitResult = wrSignaled then + Break; + except + continue; + end; + end; +end; + +procedure TPoolManager.FreeInternalInternalInstances; +begin + FPoolItemList.Free; + FEvent.Free; + FMultiReadExclusiveWriteSynchronizer.Free; +end; + +procedure TPoolManager.SetMaxIdleSeconds(AMaxIdleSeconds: Int64); +begin + FMaxIdleSeconds := AMaxIdleSeconds; +end; + +procedure TPoolManager.SetMaxRefCountPerItem(AMaxRefCountPerItem: Integer); +begin + FMaxRefCountPerItem := AMaxRefCountPerItem; +end; + +procedure TPoolManager.SetMinPoolCount(AMinPoolCount: Integer); +begin + FMinPoolCount := AMinPoolCount; +end; + +end.