/src/yolk-cache-string_keys.adb
Ada | 332 lines | 196 code | 55 blank | 81 comment | 6 complexity | 1fdf5662299027c1e7027c8fa744231d MD5 | raw file
1------------------------------------------------------------------------------- 2-- -- 3-- Copyright (C) 2010-, Thomas Lø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 23with Ada.Calendar; 24with Ada.Containers.Hashed_Maps; 25with Ada.Strings.Unbounded; 26with Ada.Strings.Unbounded.Hash; 27 28package body Yolk.Cache.String_Keys is 29 30 use Ada.Containers; 31 use Ada.Strings.Unbounded; 32 33 function U 34 (S : in String) 35 return Unbounded_String 36 renames To_Unbounded_String; 37 38 type Element_Container is 39 record 40 Added_Timestamp : Ada.Calendar.Time; 41 Element : Element_Type; 42 end record; 43 44 Null_Container : Element_Container; 45 pragma Unmodified (Null_Container); 46 47 function Equivalent_Keys 48 (Left : in Unbounded_String; 49 Right : in Unbounded_String) 50 return Boolean; 51 -- Used by the Element_Map to determine equivalence between values. 52 53 function Key_Hash 54 (Key : in Unbounded_String) 55 return Hash_Type; 56 -- Used by Element_Map to hash keys. 57 58 package Element_Map is new Hashed_Maps 59 (Key_Type => Unbounded_String, 60 Element_Type => Element_Container, 61 Hash => Key_Hash, 62 Equivalent_Keys => Equivalent_Keys); 63 64 protected P_Element_List is 65 procedure Cleanup; 66 -- ???? 67 68 procedure Clear; 69 -- ???? 70 71 procedure Clear 72 (Key : in String); 73 -- ???? 74 75 function Is_Valid 76 (Key : in String) 77 return Boolean; 78 -- ???? 79 80 function Length 81 return Natural; 82 -- ???? 83 84 procedure Read 85 (Key : in String; 86 Valid : out Boolean; 87 Value : out Element_Type); 88 -- ???? 89 90 procedure Write 91 (Key : in String; 92 Value : in Element_Type); 93 -- ???? 94 private 95 Element_List : Element_Map.Map; 96 Virgin : Boolean := True; 97 end P_Element_List; 98 99 ---------------------- 100 -- P_Element_List -- 101 ---------------------- 102 103 protected body P_Element_List is 104 --------------- 105 -- Cleanup -- 106 --------------- 107 108 procedure Cleanup 109 is 110 use Ada.Calendar; 111 use Element_Map; 112 113 Cursor : Element_Map.Cursor := Element_List.First; 114 Now : constant Time := Clock; 115 begin 116 while Has_Element (Cursor) loop 117 if (Now - Element (Cursor).Added_Timestamp) >= Max_Element_Age then 118 Element_List.Delete (Position => Cursor); 119 end if; 120 Next (Cursor); 121 end loop; 122 123 while Integer (Element_List.Length) >= Cleanup_Size loop 124 Cursor := Element_List.First; 125 Element_List.Delete (Position => Cursor); 126 end loop; 127 end Cleanup; 128 129 ------------- 130 -- Clear -- 131 ------------- 132 133 procedure Clear 134 is 135 begin 136 Element_List.Clear; 137 end Clear; 138 139 ------------- 140 -- Clear -- 141 ------------- 142 143 procedure Clear 144 (Key : in String) 145 is 146 begin 147 Element_List.Exclude (Key => U (Key)); 148 end Clear; 149 150 ---------------- 151 -- Is_Valid - - 152 ---------------- 153 154 function Is_Valid 155 (Key : in String) 156 return Boolean 157 is 158 use Ada.Calendar; 159 begin 160 return (Element_List.Contains (Key => U (Key))) and then 161 (Clock - Element_List.Element (Key => U (Key)).Added_Timestamp < 162 Max_Element_Age); 163 end Is_Valid; 164 165 -------------- 166 -- Length -- 167 -------------- 168 169 function Length 170 return Natural 171 is 172 begin 173 return Natural (Element_List.Length); 174 end Length; 175 176 ------------ 177 -- Read -- 178 ------------ 179 180 procedure Read 181 (Key : in String; 182 Valid : out Boolean; 183 Value : out Element_Type) 184 is 185 use Ada.Calendar; 186 begin 187 Valid := Is_Valid (Key => Key); 188 189 if Valid then 190 Value := Element_List.Element (Key => U (Key)).Element; 191 else 192 Clear (Key => Key); 193 Value := Null_Container.Element; 194 end if; 195 end Read; 196 197 ------------- 198 -- Write -- 199 ------------- 200 201 procedure Write 202 (Key : in String; 203 Value : in Element_Type) 204 is 205 begin 206 if Virgin then 207 Element_List.Reserve_Capacity 208 (Capacity => Count_Type (Reserved_Capacity)); 209 Virgin := False; 210 end if; 211 212 if Cleanup_On_Write and 213 Integer (Element_List.Length) >= Cleanup_Size 214 then 215 Cleanup; 216 end if; 217 218 Element_List.Include 219 (Key => U (Key), 220 New_Item => (Added_Timestamp => Ada.Calendar.Clock, 221 Element => Value)); 222 end Write; 223 end P_Element_List; 224 225 --------------- 226 -- Cleanup -- 227 --------------- 228 229 procedure Cleanup 230 is 231 begin 232 P_Element_List.Cleanup; 233 end Cleanup; 234 235 ------------- 236 -- Clear -- 237 ------------- 238 239 procedure Clear 240 is 241 begin 242 P_Element_List.Clear; 243 end Clear; 244 245 ------------- 246 -- Clear -- 247 ------------- 248 249 procedure Clear 250 (Key : in String) 251 is 252 begin 253 P_Element_List.Clear (Key => Key); 254 end Clear; 255 256 ----------------------- 257 -- Equivalent_Keys -- 258 ----------------------- 259 260 function Equivalent_Keys 261 (Left : in Unbounded_String; 262 Right : in Unbounded_String) 263 return Boolean 264 is 265 begin 266 return Left = Right; 267 end Equivalent_Keys; 268 269 ---------------- 270 -- Is_Valid -- 271 ---------------- 272 273 function Is_Valid 274 (Key : in String) 275 return Boolean 276 is 277 begin 278 return P_Element_List.Is_Valid (Key => Key); 279 end Is_Valid; 280 281 ---------------- 282 -- Key_Hash -- 283 ---------------- 284 285 function Key_Hash 286 (Key : in Unbounded_String) 287 return Hash_Type 288 is 289 begin 290 return Ada.Strings.Unbounded.Hash (Key => Key); 291 end Key_Hash; 292 293 -------------- 294 -- Length -- 295 -------------- 296 297 function Length 298 return Natural 299 is 300 begin 301 return P_Element_List.Length; 302 end Length; 303 304 ------------ 305 -- Read -- 306 ------------ 307 308 procedure Read 309 (Key : in String; 310 Is_Valid : out Boolean; 311 Value : out Element_Type) 312 is 313 begin 314 P_Element_List.Read (Key => Key, 315 Valid => Is_Valid, 316 Value => Value); 317 end Read; 318 319 ------------- 320 -- Write -- 321 ------------- 322 323 procedure Write 324 (Key : in String; 325 Value : in Element_Type) 326 is 327 begin 328 P_Element_List.Write (Key => Key, 329 Value => Value); 330 end Write; 331 332end Yolk.Cache.String_Keys;