2
0

Quick.Pooling.pas 8.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317
  1. { ***************************************************************************
  2. Copyright (c) 2016-2020 Kike Pérez
  3. Unit : Quick.Pooling
  4. Description : Pooling objects
  5. Author : Kike Pérez
  6. Version : 1.9
  7. Created : 28/02/2020
  8. Modified : 29/02/2020
  9. This file is part of QuickLib: https://github.com/exilon/QuickLib
  10. ***************************************************************************
  11. Licensed under the Apache License, Version 2.0 (the "License");
  12. you may not use this file except in compliance with the License.
  13. You may obtain a copy of the License at
  14. http://www.apache.org/licenses/LICENSE-2.0
  15. Unless required by applicable law or agreed to in writing, software
  16. distributed under the License is distributed on an "AS IS" BASIS,
  17. WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  18. See the License for the specific language governing permissions and
  19. limitations under the License.
  20. *************************************************************************** }
  21. unit Quick.Pooling;
  22. {$i QuickLib.inc}
  23. interface
  24. uses
  25. {$IFDEF DEBUG_OBJPOOL}
  26. Quick.Debug.Utils,
  27. {$ENDIF}
  28. System.SysUtils,
  29. System.SyncObjs,
  30. System.DateUtils,
  31. Quick.Commons,
  32. Quick.Threads;
  33. type
  34. IPoolItem<T : class, constructor> = interface
  35. ['{D52E794B-FDC1-42C1-94BA-823DB74703E4}']
  36. function Item : T;
  37. function GetRefCount : Integer;
  38. function GetItemIndex : Integer;
  39. function GetLastAccess: TDateTime;
  40. property RefCount: Integer read GetRefCount;
  41. property ItemIndex : Integer read GetItemIndex;
  42. property LastAccess: TDateTime read GetLastAccess;
  43. end;
  44. TCreateDelegator<T> = reference to procedure(var aInstance : T);
  45. TPoolItem<T : class, constructor> = class(TInterfacedObject,IPoolItem<T>)
  46. private
  47. fItem : T;
  48. fItemIndex : Integer;
  49. fLastAccess : TDateTime;
  50. function GetRefCount : Integer;
  51. function GetLastAccess: TDateTime;
  52. function GetItemIndex : Integer;
  53. protected
  54. fLock : TCriticalSection;
  55. fSemaphore : TSemaphore;
  56. function _AddRef: Integer; stdcall;
  57. function _Release: Integer; stdcall;
  58. public
  59. constructor Create(aSemaphore : TSemaphore; aLock : TCriticalSection; aItemIndex : Integer; aCreateProc : TCreateDelegator<T>);
  60. destructor Destroy; override;
  61. function Item : T;
  62. property RefCount: Integer read GetRefCount;
  63. property ItemIndex : Integer read GetItemIndex;
  64. property LastAccess: TDateTime read GetLastAccess;
  65. end;
  66. IObjectPool<T : class, constructor> = interface
  67. ['{AA856DFB-AE8C-46FE-A107-034677010A58}']
  68. function GetPoolSize: Integer;
  69. function Get : IPoolItem<T>;
  70. property PoolSize : Integer read GetPoolSize;
  71. function TimeoutMs(aTimeout : Integer) : IObjectPool<T>;
  72. function CreateDelegate(aCreateProc : TCreateDelegator<T>) : IObjectPool<T>;
  73. function AutoFreeIdleItemTimeMs(aIdleTimeMs : Integer) : IObjectPool<T>;
  74. end;
  75. TObjectPool<T : class, constructor> = class(TInterfacedObject,IObjectPool<T>)
  76. private
  77. fPool : TArray<IPoolItem<T>>;
  78. fPoolSize : Integer;
  79. fWaitTimeoutMs : Integer;
  80. fLock : TCriticalSection;
  81. fDelegate : TCreateDelegator<T>;
  82. fSemaphore : TSemaphore;
  83. fAutoFreeIdleItemTimeMs : Integer;
  84. fScheduler : TScheduledTasks;
  85. function GetPoolSize: Integer;
  86. procedure CreateScheduler;
  87. procedure CheckForIdleItems;
  88. public
  89. constructor Create(aPoolSize : Integer; aAutoFreeIdleItemTimeMs : Integer = 30000; aCreateProc : TCreateDelegator<T> = nil);
  90. destructor Destroy; override;
  91. property PoolSize : Integer read GetPoolSize;
  92. function TimeoutMs(aTimeout : Integer) : IObjectPool<T>;
  93. function CreateDelegate(aCreateProc : TCreateDelegator<T>) : IObjectPool<T>;
  94. function AutoFreeIdleItemTimeMs(aIdleTimeMs : Integer) : IObjectPool<T>;
  95. function Get : IPoolItem<T>;
  96. end;
  97. implementation
  98. { TObjectPool<T> }
  99. function TObjectPool<T>.AutoFreeIdleItemTimeMs(aIdleTimeMs: Integer): IObjectPool<T>;
  100. begin
  101. Result := Self;
  102. fAutoFreeIdleItemTimeMs := aIdleTimeMs;
  103. end;
  104. constructor TObjectPool<T>.Create(aPoolSize : Integer; aAutoFreeIdleItemTimeMs : Integer = 30000; aCreateProc : TCreateDelegator<T> = nil);
  105. begin
  106. fLock := TCriticalSection.Create;
  107. fPoolSize := aPoolSize;
  108. fWaitTimeoutMs := 30000;
  109. fDelegate := aCreateProc;
  110. fAutoFreeIdleItemTimeMs := aAutoFreeIdleItemTimeMs;
  111. fSemaphore := TSemaphore.Create(nil,fPoolSize,fPoolSize,'');
  112. CreateScheduler;
  113. end;
  114. procedure TObjectPool<T>.CreateScheduler;
  115. begin
  116. fScheduler := TScheduledTasks.Create;
  117. fScheduler.AddTask('IdleCleaner',[],True,procedure(task : ITask)
  118. begin
  119. CheckForIdleItems;
  120. end)
  121. .StartInSeconds(10).RepeatEvery(fAutoFreeIdleItemTimeMs,TTimeMeasure.tmMilliseconds);
  122. fScheduler.Start;
  123. end;
  124. procedure TObjectPool<T>.CheckForIdleItems;
  125. var
  126. i : Integer;
  127. begin
  128. fLock.Enter;
  129. try
  130. for i := low(fPool) to High(fPool) do
  131. begin
  132. //check if item was not used for long time
  133. if (fPool[i] <> nil) and (fPool[i].RefCount = 1) and (MilliSecondsBetween(Now,fPool[i].LastAccess) > fAutoFreeIdleItemTimeMs) then
  134. begin
  135. fPool[i] := nil;
  136. end;
  137. end;
  138. finally
  139. fLock.Leave;
  140. end;
  141. end;
  142. function TObjectPool<T>.CreateDelegate(aCreateProc: TCreateDelegator<T>): IObjectPool<T>;
  143. begin
  144. Result := Self;
  145. fDelegate := aCreateProc;
  146. end;
  147. destructor TObjectPool<T>.Destroy;
  148. var
  149. i: Integer;
  150. begin
  151. fScheduler.Stop;
  152. fScheduler.Free;
  153. fLock.Enter;
  154. try
  155. for i := Low(fPool) to High(fPool) do fPool[i] := nil;
  156. SetLength(FPool,0);
  157. finally
  158. fLock.Leave;
  159. end;
  160. fLock.Free;
  161. fSemaphore.Free;
  162. inherited;
  163. end;
  164. function TObjectPool<T>.Get: IPoolItem<T>;
  165. var
  166. i : Integer;
  167. waitResult: TWaitResult;
  168. begin
  169. Result := nil;
  170. {$IFDEF DEBUG_OBJPOOL}
  171. TDebugger.Trace(Self,'Waiting for get idle Pool Item...');
  172. {$ENDIF}
  173. waitResult := fSemaphore.WaitFor(fWaitTimeoutMs);
  174. if waitResult <> TWaitResult.wrSignaled then raise Exception.Create('Connection Pool Timeout: Cannot obtain a connection');
  175. fLock.Enter;
  176. try
  177. if High(fPool) < fPoolSize then SetLength(fPool,High(fPool)+2);
  178. for i := Low(fPool) to High(fPool) do
  179. begin
  180. if fPool[i] = nil then
  181. begin
  182. fPool[i] := TPoolItem<T>.Create(fSemaphore,fLock,i,fDelegate);
  183. {$IFDEF DEBUG_OBJPOOL}
  184. TDebugger.Trace(Self,'Create Pool Item: %d',[i]);
  185. {$ENDIF}
  186. Exit(fPool[i]);
  187. end;
  188. if fPool[i].RefCount = 1 then
  189. begin
  190. //writeln('get ' + i.ToString);
  191. {$IFDEF DEBUG_OBJPOOL}
  192. TDebugger.Trace(Self,'Get Idle Pool Item: %d',[i]);
  193. {$ENDIF}
  194. Exit(fPool[i]);
  195. end
  196. {$IFDEF DEBUG_OBJPOOL}
  197. else
  198. TDebugger.Trace(Self,'Pool Item: %d is busy (RefCount: %d)',[i,fPool[i].RefCount]);
  199. {$ENDIF}
  200. end;
  201. finally
  202. fLock.Leave;
  203. end;
  204. end;
  205. function TObjectPool<T>.GetPoolSize: Integer;
  206. begin
  207. Result := fPoolSize;
  208. end;
  209. function TObjectPool<T>.TimeoutMs(aTimeout: Integer): IObjectPool<T>;
  210. begin
  211. fWaitTimeoutMs := aTimeout;
  212. end;
  213. { TPoolItem<T> }
  214. function TPoolItem<T>.Item: T;
  215. begin
  216. fLastAccess := Now();
  217. Result := fItem;
  218. end;
  219. constructor TPoolItem<T>.Create(aSemaphore : TSemaphore; aLock : TCriticalSection; aItemIndex : Integer; aCreateProc : TCreateDelegator<T>);
  220. begin
  221. fLastAccess := Now();
  222. fItemIndex := aItemIndex;
  223. if Assigned(aCreateProc) then aCreateProc(fItem)
  224. else fItem := T.Create;
  225. fLock := aLock;
  226. fSemaphore := aSemaphore;
  227. end;
  228. destructor TPoolItem<T>.Destroy;
  229. begin
  230. if Assigned(fItem) then fItem.Free;
  231. inherited;
  232. end;
  233. function TPoolItem<T>.GetItemIndex: Integer;
  234. begin
  235. Result := fItemIndex;
  236. end;
  237. function TPoolItem<T>.GetLastAccess: TDateTime;
  238. begin
  239. Result := fLastAccess;
  240. end;
  241. function TPoolItem<T>.GetRefCount: Integer;
  242. begin
  243. Result := FRefCount;
  244. end;
  245. function TPoolItem<T>._AddRef: Integer;
  246. begin
  247. fLock.Enter;
  248. {$IFDEF DEBUG_OBJPOOL}
  249. TDebugger.Trace(Self,'Got Pool item');
  250. {$ENDIF}
  251. try
  252. Inc(FRefCount);
  253. Result := FRefCount;
  254. finally
  255. fLock.Leave;
  256. end;
  257. end;
  258. function TPoolItem<T>._Release: Integer;
  259. begin
  260. {$IFDEF DEBUG_OBJPOOL}
  261. TDebugger.Trace(Self,'Released Pool item');
  262. {$ENDIF}
  263. try
  264. result:=AtomicDecrement(fRefCount);
  265. if Result = 0 then
  266. begin
  267. FreeAndNil(fItem);
  268. // The following is take from TInterfacedObject._Release()
  269. // Mark the refcount field so that any refcounting during destruction doesn't infinitely recurse.
  270. __MarkDestroying(Self);
  271. Destroy;
  272. end
  273. else fLastAccess := Now;
  274. finally
  275. if fRefCount = 1 then fSemaphore.Release;
  276. end;
  277. end;
  278. end.