Merge branch 'mr/tmpfile' into 'master'

Add new functions Load_Index and Save_Index in GNATCOLL.File_Indexes

See merge request eng/toolchain/gnatcoll-core!216

Author: lambourg

core/src/gnatcoll-file_indexes.adb

@@ -22,15 +22,25 @@
 ------------------------------------------------------------------------------
 
 with GNAT.OS_Lib;
+with GNATCOLL.JSON;
+with GNATCOLL.OS.FS;
+with Ada.Calendar;
+with Ada.Strings.Unbounded;
 
 package body GNATCOLL.File_Indexes is
 
+   package JSON renames GNATCOLL.JSON;
+   package FS renames GNATCOLL.OS.FS;
+
+   JSON_INDEX_MIMETYPE : constant String := "text/json+file-index-1.0";
+
    procedure Internal_Hash
-      (Self            : in out File_Index;
-       Normalized_Path : UTF8.UTF_8_String;
-       Attrs           : Stat.File_Attributes;
-       State           : out Entry_State;
-       Digest          : out File_Index_Digest);
+     (Self            : in out File_Index;
+      Normalized_Path : UTF8.UTF_8_String;
+      Attrs           : Stat.File_Attributes;
+      State           : out Entry_State;
+      Digest          : out File_Index_Digest;
+      Trust_Cache     : Boolean := False);
 
    -----------------
    -- Clear_Cache --
@@ -47,56 +57,71 @@ package body GNATCOLL.File_Indexes is
    ----------
 
    function Hash
-      (Self  : in out File_Index;
-       Path  : UTF8.UTF_8_String)
+     (Self        : in out File_Index;
+      Path        : UTF8.UTF_8_String;
+      Trust_Cache : Boolean := False)
       return File_Index_Digest
    is
       State : Entry_State;
       Digest : File_Index_Digest;
    begin
-      Hash (Self => Self, Path => Path, State => State, Digest => Digest);
+      Hash
+        (Self        => Self,
+         Path        => Path,
+         State       => State,
+         Digest      => Digest,
+         Trust_Cache => Trust_Cache);
       return Digest;
    end Hash;
 
    procedure Hash
       (Self   : in out File_Index;
        Path   : UTF8.UTF_8_String;
        State  : out Entry_State;
-       Digest : out File_Index_Digest)
+       Digest : out File_Index_Digest;
+       Trust_Cache : Boolean := False)
    is
       Normalized_Path : constant String := GNAT.OS_Lib.Normalize_Pathname
          (Path, Resolve_Links => False);
    begin
       Internal_Hash
-         (Self, Normalized_Path, Stat.Stat (Normalized_Path), State, Digest);
+        (Self,
+         Normalized_Path,
+         Stat.Stat (Normalized_Path),
+         State,
+         Digest,
+         Trust_Cache);
    end Hash;
 
    procedure Hash
-      (Self       : in out File_Index;
-       Path       : UTF8.UTF_8_String;
-       Attrs      : Stat.File_Attributes;
-       State      : out Entry_State;
-       Digest     : out File_Index_Digest)
+     (Self        : in out File_Index;
+      Path        : UTF8.UTF_8_String;
+      Attrs       : Stat.File_Attributes;
+      State       : out Entry_State;
+      Digest      : out File_Index_Digest;
+      Trust_Cache : Boolean := False)
    is
    begin
       Internal_Hash
          (Self,
           GNAT.OS_Lib.Normalize_Pathname (Path, Resolve_Links => False),
           Attrs,
           State,
-          Digest);
+          Digest,
+          Trust_Cache);
    end Hash;
 
    -------------------
    -- Internal_Hash --
    -------------------
 
    procedure Internal_Hash
-      (Self            : in out File_Index;
-       Normalized_Path : UTF8.UTF_8_String;
-       Attrs           : Stat.File_Attributes;
-       State           : out Entry_State;
-       Digest          : out File_Index_Digest)
+     (Self            : in out File_Index;
+      Normalized_Path : UTF8.UTF_8_String;
+      Attrs           : Stat.File_Attributes;
+      State           : out Entry_State;
+      Digest          : out File_Index_Digest;
+      Trust_Cache     : Boolean := False)
    is
       use File_Maps;
       use type Stat.File_Attributes;
@@ -106,40 +131,48 @@ package body GNATCOLL.File_Indexes is
       Prev_Cursor    : Cursor := Find (Self.DB, Normalized_Path);
       Prev_Hash      : File_Index_Digest := No_Digest;
       New_Hash       : File_Index_Digest := No_Digest;
+      Prev           : Index_Element;
       Trust_New_Hash : Boolean := True;
    begin
 
       if Prev_Cursor /= No_Element then
-         declare
-            Prev : constant Index_Element := Element (Prev_Cursor);
-         begin
-            if Prev.Trust_Hash and then Attrs = Prev.Attrs then
-               State := UNCHANGED_FILE;
-               Digest := Prev.Hash_Digest;
-               return;
-            end if;
+         Prev := Element (Prev_Cursor);
 
-            --  Two possibilities:
-            --  - Hash is going to be recomputed
-            --  - File does not exist anymore
-            --  In both cases, previous file length must be removed
-            --  from the total length.
+         if Prev.Trust_Hash and then Attrs = Prev.Attrs then
+            State := UNCHANGED_FILE;
+            Digest := Prev.Hash_Digest;
 
-            Self.Total_Size := Self.Total_Size - Stat.Length (Prev.Attrs);
+            --  Using a pre-existing element, so mark it as still in use so
+            --  requiring to be saved on disk.
 
-            if not Stat.Exists (Attrs) then
-               Delete (Self.DB, Prev_Cursor);
-               State  := REMOVED_FILE;
-               Digest := No_Digest;
-               return;
+            if not Prev.Save_On_Disk then
+               Prev.Save_On_Disk := True;
+               Self.DB.Replace_Element (Prev_Cursor, Prev);
             end if;
 
-            --  default state is now UPDATED_FILE
-            State := UPDATED_FILE;
+            return;
+         end if;
+
+         --  Two possibilities:
+         --  - Hash is going to be recomputed
+         --  - File does not exist anymore
+         --  In both cases, previous file length must be removed
+         --  from the total length.
+
+         Self.Total_Size := Self.Total_Size - Stat.Length (Prev.Attrs);
 
-            --  Keep track of prev hash
-            Prev_Hash := Prev.Hash_Digest;
-         end;
+         if not Stat.Exists (Attrs) then
+            Delete (Self.DB, Prev_Cursor);
+            State  := REMOVED_FILE;
+            Digest := No_Digest;
+            return;
+         end if;
+
+         --  default state is now UPDATED_FILE
+         State := UPDATED_FILE;
+
+         --  Keep track of prev hash
+         Prev_Hash := Prev.Hash_Digest;
       else
          --  This is a new file
          State := NEW_FILE;
@@ -161,11 +194,12 @@ package body GNATCOLL.File_Indexes is
       --  modified less than 1s ago, there is a possible race condition in
       --  which the file is modified again in the same second after we updated
       --  the File_Index DB. In those cases don't trust the hash (i.e: always
-      --  recompute it in the next query).
-      Trust_New_Hash :=
-         (Ada.Calendar.Clock - Stat.Modification_Time (Attrs)) > 1.0;
+      --  recompute it in the next query), unless the caller explicitly specify
+      --  that the value is to be trusted.
+      Trust_New_Hash := Trust_Cache
+        or else (Ada.Calendar.Clock - Stat.Modification_Time (Attrs)) > 1.0;
 
-      --  Compute Hash
+      --  Add the new entry
       Include
          (Self.DB,
           Normalized_Path,
@@ -194,4 +228,146 @@ package body GNATCOLL.File_Indexes is
       return Self.Total_Size;
    end Indexed_Content_Size;
 
+   ----------------
+   -- Save_Index --
+   ----------------
+
+   procedure Save_Index (Self : File_Index; Filename : UTF8.UTF_8_String)
+   is
+      use File_Maps;
+      Result     : constant JSON.JSON_Value := JSON.Create_Object;
+      JSON_DB    : constant JSON.JSON_Value := JSON.Create_Object;
+      Result_Str : Ada.Strings.Unbounded.Unbounded_String;
+      FD         : FS.File_Descriptor;
+
+   begin
+      --  The mime field is only used by the Load_Index function and ensures
+      --  we don't try to load a file a distinct format
+      Result.Set_Field ("mimetype", JSON_INDEX_MIMETYPE);
+
+      --  Dump global data
+      Result.Set_Field ("total_size", JSON.Create (Self.Total_Size));
+
+      --  Iterate over the database
+      declare
+         C : Cursor := First (Self.DB);
+      begin
+         while C /= No_Element loop
+            --  For each element the following data structure is created:
+            --
+            --  {
+            --    "trust": bool,
+            --    "hash": str,
+            --    "stat": [...]  # stat information
+            --  }
+            declare
+               El        : constant Index_Element := Element (C);
+               JSON_El   : constant JSON.JSON_Value := JSON.Create_Object;
+               Stat_Data : constant JSON.JSON_Value := JSON.Create
+                  (JSON.Empty_Array);
+            begin
+               if El.Save_On_Disk then
+                  JSON_El.Set_Field ("trust", El.Trust_Hash);
+                  JSON_El.Set_Field ("hash", El.Hash_Digest);
+
+                  Stat_Data.Append (JSON.Create (Stat.Exists (El.Attrs)));
+                  Stat_Data.Append (JSON.Create (Stat.Is_Writable (El.Attrs)));
+                  Stat_Data.Append (JSON.Create (Stat.Is_Readable (El.Attrs)));
+                  Stat_Data.Append
+                    (JSON.Create (Stat.Is_Executable (El.Attrs)));
+                  Stat_Data.Append
+                    (JSON.Create (Stat.Is_Symbolic_Link (El.Attrs)));
+                  Stat_Data.Append (JSON.Create (Stat.Is_File (El.Attrs)));
+                  Stat_Data.Append
+                    (JSON.Create (Stat.Is_Directory (El.Attrs)));
+                  Stat_Data.Append
+                    (JSON.Create (Stat.Modification_Stamp (El.Attrs)));
+                  Stat_Data.Append (JSON.Create (Stat.Length (El.Attrs)));
+                  JSON_El.Set_Field ("stat", Stat_Data);
+
+                  JSON_DB.Set_Field (Key (C), JSON_El);
+               end if;
+            end;
+
+            C := Next (C);
+         end loop;
+      end;
+      Result.Set_Field ("db", JSON_DB);
+
+      --  Write the final JSON
+      Result_Str := JSON.Write (Result, Compact => False);
+      FD := FS.Open (Filename, Mode => FS.Write_Mode);
+      FS.Write_Unbounded (FD, Result_Str);
+      FS.Close (FD);
+   end Save_Index;
+
+   ----------------
+   -- Load_Index --
+   ----------------
+
+   function Load_Index (Filename : UTF8.UTF_8_String) return File_Index
+   is
+      JSON_Result : JSON.Read_Result;
+      JSON_Data   : JSON.JSON_Value;
+      Result      : File_Index;
+
+      procedure Process_Entry
+         (Name : JSON.UTF8_String; Value : JSON.JSON_Value);
+      --  Function called on each file entry
+
+      procedure Process_Entry
+         (Name : JSON.UTF8_String; Value : JSON.JSON_Value)
+      is
+         V : Index_Element;
+         JSON_Stat : constant JSON.JSON_Array := JSON.Get (Value, "stat");
+      begin
+         V :=
+           (Attrs        => Stat.New_File_Attributes
+              (Exists        => JSON.Get (JSON.Get (JSON_Stat, 1)),
+               Writable      => JSON.Get (JSON.Get (JSON_Stat, 2)),
+               Readable      => JSON.Get (JSON.Get (JSON_Stat, 3)),
+               Executable    => JSON.Get (JSON.Get (JSON_Stat, 4)),
+               Symbolic_Link => JSON.Get (JSON.Get (JSON_Stat, 5)),
+               Regular       => JSON.Get (JSON.Get (JSON_Stat, 6)),
+               Directory     => JSON.Get (JSON.Get (JSON_Stat, 7)),
+               Stamp         => JSON.Get (JSON.Get (JSON_Stat, 8)),
+               Length        => JSON.Get (JSON.Get (JSON_Stat, 9))),
+            Hash_Digest  => JSON.Get (Value, "hash"),
+            Trust_Hash   => JSON.Get (Value, "trust"),
+            Save_On_Disk => False);
+         Result.DB.Include (Name, V);
+      end Process_Entry;
+
+   begin
+      JSON_Result := JSON.Read_File (Filename);
+
+      if not JSON_Result.Success then
+         --  Silently ignore index errors
+         return Result;
+      end if;
+
+      JSON_Data := JSON_Result.Value;
+
+      if not JSON.Has_Field (JSON_Data, "mimetype") or else
+         not JSON.Has_Field (JSON_Data, "total_size")
+      then
+         return Result;
+      end if;
+
+      declare
+         Mimetype : constant String := JSON.Get (JSON_Data, "mimetype");
+      begin
+         if Mimetype /= JSON_INDEX_MIMETYPE then
+            return Result;
+         end if;
+
+         Result.Total_Size  :=
+            JSON.Get (JSON.Get (JSON_Data, "total_size"));
+
+         JSON.Map_JSON_Object
+            (JSON.Get (JSON_Data, "db"), Process_Entry'Unrestricted_Access);
+      end;
+      return Result;
+   end Load_Index;
+
 end GNATCOLL.File_Indexes;