PageRenderTime 37ms CodeModel.GetById 16ms app.highlight 17ms RepoModel.GetById 2ms app.codeStats 0ms

/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 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;