/src/yolk-cache-string_keys.adb

http://github.com/ThomasLocke/yolk · Ada · 332 lines · 196 code · 55 blank · 81 comment · 6 complexity · 1fdf5662299027c1e7027c8fa744231d MD5 · raw file

  1. -------------------------------------------------------------------------------
  2. -- --
  3. -- Copyright (C) 2010-, Thomas ¸cke --
  4. -- --
  5. -- This library is free software; you can redistribute it and/or modify --
  6. -- it under terms of the GNU General Public License as published by the --
  7. -- Free Software Foundation; either version 3, or (at your option) any --
  8. -- later version. This library is distributed in the hope that it will be --
  9. -- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of --
  10. -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
  11. -- --
  12. -- As a special exception under Section 7 of GPL version 3, you are --
  13. -- granted additional permissions described in the GCC Runtime Library --
  14. -- Exception, version 3.1, as published by the Free Software Foundation. --
  15. -- --
  16. -- You should have received a copy of the GNU General Public License and --
  17. -- a copy of the GCC Runtime Library Exception along with this program; --
  18. -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
  19. -- <http://www.gnu.org/licenses/>. --
  20. -- --
  21. -------------------------------------------------------------------------------
  22. with Ada.Calendar;
  23. with Ada.Containers.Hashed_Maps;
  24. with Ada.Strings.Unbounded;
  25. with Ada.Strings.Unbounded.Hash;
  26. package body Yolk.Cache.String_Keys is
  27. use Ada.Containers;
  28. use Ada.Strings.Unbounded;
  29. function U
  30. (S : in String)
  31. return Unbounded_String
  32. renames To_Unbounded_String;
  33. type Element_Container is
  34. record
  35. Added_Timestamp : Ada.Calendar.Time;
  36. Element : Element_Type;
  37. end record;
  38. Null_Container : Element_Container;
  39. pragma Unmodified (Null_Container);
  40. function Equivalent_Keys
  41. (Left : in Unbounded_String;
  42. Right : in Unbounded_String)
  43. return Boolean;
  44. -- Used by the Element_Map to determine equivalence between values.
  45. function Key_Hash
  46. (Key : in Unbounded_String)
  47. return Hash_Type;
  48. -- Used by Element_Map to hash keys.
  49. package Element_Map is new Hashed_Maps
  50. (Key_Type => Unbounded_String,
  51. Element_Type => Element_Container,
  52. Hash => Key_Hash,
  53. Equivalent_Keys => Equivalent_Keys);
  54. protected P_Element_List is
  55. procedure Cleanup;
  56. -- ????
  57. procedure Clear;
  58. -- ????
  59. procedure Clear
  60. (Key : in String);
  61. -- ????
  62. function Is_Valid
  63. (Key : in String)
  64. return Boolean;
  65. -- ????
  66. function Length
  67. return Natural;
  68. -- ????
  69. procedure Read
  70. (Key : in String;
  71. Valid : out Boolean;
  72. Value : out Element_Type);
  73. -- ????
  74. procedure Write
  75. (Key : in String;
  76. Value : in Element_Type);
  77. -- ????
  78. private
  79. Element_List : Element_Map.Map;
  80. Virgin : Boolean := True;
  81. end P_Element_List;
  82. ----------------------
  83. -- P_Element_List --
  84. ----------------------
  85. protected body P_Element_List is
  86. ---------------
  87. -- Cleanup --
  88. ---------------
  89. procedure Cleanup
  90. is
  91. use Ada.Calendar;
  92. use Element_Map;
  93. Cursor : Element_Map.Cursor := Element_List.First;
  94. Now : constant Time := Clock;
  95. begin
  96. while Has_Element (Cursor) loop
  97. if (Now - Element (Cursor).Added_Timestamp) >= Max_Element_Age then
  98. Element_List.Delete (Position => Cursor);
  99. end if;
  100. Next (Cursor);
  101. end loop;
  102. while Integer (Element_List.Length) >= Cleanup_Size loop
  103. Cursor := Element_List.First;
  104. Element_List.Delete (Position => Cursor);
  105. end loop;
  106. end Cleanup;
  107. -------------
  108. -- Clear --
  109. -------------
  110. procedure Clear
  111. is
  112. begin
  113. Element_List.Clear;
  114. end Clear;
  115. -------------
  116. -- Clear --
  117. -------------
  118. procedure Clear
  119. (Key : in String)
  120. is
  121. begin
  122. Element_List.Exclude (Key => U (Key));
  123. end Clear;
  124. ----------------
  125. -- Is_Valid - -
  126. ----------------
  127. function Is_Valid
  128. (Key : in String)
  129. return Boolean
  130. is
  131. use Ada.Calendar;
  132. begin
  133. return (Element_List.Contains (Key => U (Key))) and then
  134. (Clock - Element_List.Element (Key => U (Key)).Added_Timestamp <
  135. Max_Element_Age);
  136. end Is_Valid;
  137. --------------
  138. -- Length --
  139. --------------
  140. function Length
  141. return Natural
  142. is
  143. begin
  144. return Natural (Element_List.Length);
  145. end Length;
  146. ------------
  147. -- Read --
  148. ------------
  149. procedure Read
  150. (Key : in String;
  151. Valid : out Boolean;
  152. Value : out Element_Type)
  153. is
  154. use Ada.Calendar;
  155. begin
  156. Valid := Is_Valid (Key => Key);
  157. if Valid then
  158. Value := Element_List.Element (Key => U (Key)).Element;
  159. else
  160. Clear (Key => Key);
  161. Value := Null_Container.Element;
  162. end if;
  163. end Read;
  164. -------------
  165. -- Write --
  166. -------------
  167. procedure Write
  168. (Key : in String;
  169. Value : in Element_Type)
  170. is
  171. begin
  172. if Virgin then
  173. Element_List.Reserve_Capacity
  174. (Capacity => Count_Type (Reserved_Capacity));
  175. Virgin := False;
  176. end if;
  177. if Cleanup_On_Write and
  178. Integer (Element_List.Length) >= Cleanup_Size
  179. then
  180. Cleanup;
  181. end if;
  182. Element_List.Include
  183. (Key => U (Key),
  184. New_Item => (Added_Timestamp => Ada.Calendar.Clock,
  185. Element => Value));
  186. end Write;
  187. end P_Element_List;
  188. ---------------
  189. -- Cleanup --
  190. ---------------
  191. procedure Cleanup
  192. is
  193. begin
  194. P_Element_List.Cleanup;
  195. end Cleanup;
  196. -------------
  197. -- Clear --
  198. -------------
  199. procedure Clear
  200. is
  201. begin
  202. P_Element_List.Clear;
  203. end Clear;
  204. -------------
  205. -- Clear --
  206. -------------
  207. procedure Clear
  208. (Key : in String)
  209. is
  210. begin
  211. P_Element_List.Clear (Key => Key);
  212. end Clear;
  213. -----------------------
  214. -- Equivalent_Keys --
  215. -----------------------
  216. function Equivalent_Keys
  217. (Left : in Unbounded_String;
  218. Right : in Unbounded_String)
  219. return Boolean
  220. is
  221. begin
  222. return Left = Right;
  223. end Equivalent_Keys;
  224. ----------------
  225. -- Is_Valid --
  226. ----------------
  227. function Is_Valid
  228. (Key : in String)
  229. return Boolean
  230. is
  231. begin
  232. return P_Element_List.Is_Valid (Key => Key);
  233. end Is_Valid;
  234. ----------------
  235. -- Key_Hash --
  236. ----------------
  237. function Key_Hash
  238. (Key : in Unbounded_String)
  239. return Hash_Type
  240. is
  241. begin
  242. return Ada.Strings.Unbounded.Hash (Key => Key);
  243. end Key_Hash;
  244. --------------
  245. -- Length --
  246. --------------
  247. function Length
  248. return Natural
  249. is
  250. begin
  251. return P_Element_List.Length;
  252. end Length;
  253. ------------
  254. -- Read --
  255. ------------
  256. procedure Read
  257. (Key : in String;
  258. Is_Valid : out Boolean;
  259. Value : out Element_Type)
  260. is
  261. begin
  262. P_Element_List.Read (Key => Key,
  263. Valid => Is_Valid,
  264. Value => Value);
  265. end Read;
  266. -------------
  267. -- Write --
  268. -------------
  269. procedure Write
  270. (Key : in String;
  271. Value : in Element_Type)
  272. is
  273. begin
  274. P_Element_List.Write (Key => Key,
  275. Value => Value);
  276. end Write;
  277. end Yolk.Cache.String_Keys;