ada_ado_de4b3c95/src/ado-schemas-databases.adb

-----------------------------------------------------------------------
--  ado-schemas-databases -- Database creation and upgrade
--  Copyright (C) 2018, 2019, 2022, 2023 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Directories;
with Ada.Characters.Handling;

with Util.Log.Loggers;
with Util.Files;
with Util.Strings;
with ADO.SQL;
with ADO.Model;
with ADO.Connections;
with ADO.Statements;
package body ADO.Schemas.Databases is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Schemas.Databases");

   function Is_Space (C : in Character) return Boolean
     is (Ada.Characters.Handling.Is_Space (C)
           or else Ada.Characters.Handling.Is_Line_Terminator (C));

   function Depend_Version (Dep : in String; Name : in String) return Natural;

   function Depend_Version (Dep : in String; Name : in String) return Natural is
      Pos : Positive := Dep'First;
      Sep1 : Natural;
      Sep2 : Natural;
   begin
      while Pos <= Dep'Last loop
         while Is_Space (Dep (Pos)) and then Pos <= Dep'Last loop
            Pos := Pos + 1;
         end loop;
         exit when Pos > Dep'Last;
         Sep1 := Util.Strings.Index (Dep, ':', Pos);
         exit when Sep1 = 0;
         Sep2 := Util.Strings.Index (Dep, ' ', Sep1);
         if Sep2 = 0 then
            Sep2 := Dep'Last;
         else
            Sep2 := Sep2 - 1;
         end if;
         if Dep (Pos .. Sep1 - 1) = Name then
            begin
               return Natural'Value (Dep (Sep1 + 1 .. Sep2));

            exception
               when Constraint_Error =>
                  return 0;
            end;
         end if;
         Pos := Sep2 + 1;
      end loop;
      return 0;
   end Depend_Version;

   function "<" (Left, Right : in Upgrade_Type) return Boolean is
   begin
      if Left.Name = Right.Name then
         return Left.Version < Right.Version;
      end if;

      declare
         Left_Depend : constant String := To_String (Left.Depend);
         Right_Depend : constant String := To_String (Right.Depend);
         D1, D2 : Natural;
      begin
         D1 := Depend_Version (Right_Depend, To_String (Left.Name));
         if D1 > 0 then
            if Left.Version < D1 then
               return True;
            elsif Left.Version > D1 then
               return False;
            end if;
         end if;

         D2 := Depend_Version (Left_Depend, To_String (Right.Name));
         if D2 > 0 then
            if D2 > Right.Version then
               return False;
            elsif D2 < Right.Version then
               return True;
            elsif D1 > 0 then
               return False;
            end if;
         elsif D1 > 0 then
            return True;
         end if;

         if Left_Depend'Length /= Right_Depend'Length then
            return Left_Depend'Length < Right_Depend'Length;
         end if;
      end;

      return Left.Name < Right.Name;
   end "<";

   --  ------------------------------
   --  Create the database and initialize it with the schema SQL file.
   --  ------------------------------
   procedure Create_Database (Admin       : in ADO.Sessions.Sources.Data_Source'Class;
                              Config      : in ADO.Sessions.Sources.Data_Source'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector) is
      use type Connections.Driver_Access;

      Name   : constant String := Config.Get_Driver;
      Driver : constant Connections.Driver_Access := Connections.Get_Driver (Name);
   begin
      if Driver = null then
         raise ADO.Configs.Connection_Error with "Database driver '" & Name & "' not found";
      end if;
      Messages.Clear;
      Driver.Create_Database (Admin       => Admin,
                              Config      => Config,
                              Schema_Path => Schema_Path,
                              Messages    => Messages);
   end Create_Database;

   --  ------------------------------
   --  Scan the directory for migration script and check with the database to define
   --  the database upgrade scripts that must be executed.  The result list must then
   --  be sorted by using `Sort_Migration` to honor the module dependencies.
   --  ------------------------------
   procedure Scan_Migration (Session : in ADO.Sessions.Session'Class;
                             Path    : in String;
                             Result  : in out Upgrade_List) is
      use Ada.Directories;

      function Get_Module_Version (Name : in String) return Natural;
      procedure Module_Migration (Path : in String;
                                  Name : in String);
      procedure Add_Migration (Path : in String;
                               Name : in String;
                               Version : in Positive);

      function Is_Number (Item : in String) return Boolean
         is (for all C of Item => C in '0' .. '9');

      --  Special case for ado module migration.  If ado_version does not exist,
      --  we must not run the SELECT on ado_version to get a module version and
      --  we want to proceed.
      Has_Version_Table : constant Boolean := Session.Has_Table ("ado_version");

      procedure Add_Migration (Path : in String;
                               Name : in String;
                               Version : in Positive) is
         Upgrade : Upgrade_Type;
      begin
         Upgrade.Name := To_Unbounded_String (Name);
         Upgrade.Path := To_Unbounded_String (Path);
         Upgrade.Version := Version;
         declare
            procedure Read (Line : in String);

            Dep_Path : constant String := Util.Files.Compose (Path, "depend.conf");

            procedure Read (Line : in String) is
               First : Natural := Line'First;
               Last  : Natural := Line'Last;
            begin
               while First <= Last and then Is_Space (Line (First)) loop
                  First := First + 1;
               end loop;
               while Last >= First and then Is_Space (Line (Last)) loop
                  Last := Last - 1;
               end loop;
               if First < Last then
                  if Length (Upgrade.Depend) > 0 then
                     Append (Upgrade.Depend, " ");
                  end if;
                  Append (Upgrade.Depend, Line (First .. Last));
               end if;
            end Read;
         begin
            if Ada.Directories.Exists (Dep_Path) then
               Util.Files.Read_File (Dep_Path, Read'Access);
            end if;
         end;
         Result.Append (Upgrade);
      end Add_Migration;

      function Get_Module_Version (Name : in String) return Natural is
      begin
         if not Has_Version_Table then
            return 0;
         end if;
         declare
            Stmt : ADO.Statements.Query_Statement
              := Session.Create_Statement ("SELECT version FROM ado_version WHERE name = ?");
         begin
            Stmt.Add_Param (Name);
            Stmt.Execute;
            return Stmt.Get_Result_Integer;
         end;
      end Get_Module_Version;

      procedure Module_Migration (Path : in String;
                                  Name : in String) is
         Current_Version : constant Natural := Get_Module_Version (Name);
         Filter  : constant Filter_Type := (Ordinary_File => False,
                                            Directory     => True,
                                            others        => False);
         Search  : Search_Type;
         Ent     : Ada.Directories.Directory_Entry_Type;
      begin
         Start_Search (Search, Directory => Path,
                      Pattern => "*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Upgrade : constant String := Ada.Directories.Simple_Name (Ent);
               Version : Natural;
            begin
               --  The directory is a number that indicates the upgraded version.
               if Is_Number (Upgrade) then
                  Version := Natural'Value (Upgrade);
                  if Version > Current_Version then
                     Add_Migration (Ada.Directories.Full_Name (Ent), Name, Version);
                  end if;
               end if;
            end;
         end loop;
      end Module_Migration;

      --  Look only at directories, each directory name indicates a database module.
      Filter  : constant Filter_Type := (Ordinary_File => False,
                                         Directory     => True,
                                         others        => False);
      Search  : Search_Type;
      Ent     : Ada.Directories.Directory_Entry_Type;
   begin
      Log.Debug ("Scan directory {0} for database migration", Path);

      Start_Search (Search, Directory => Path,
                    Pattern => "*", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Name : constant String := Ada.Directories.Simple_Name (Ent);
         begin
            if Name /= "." and then Name /= ".." then
               Module_Migration (Ada.Directories.Full_Name (Ent), Name);
            end if;
         end;
      end loop;

      Log.Info ("Scan migration found{0} upgrades in {1}", Result.Length'Image, Path);
   end Scan_Migration;

   --  ------------------------------
   --  Sort the list of upgrade directories depending on the module dependencies.
   --  ------------------------------
   procedure Sort_Migration (List : in out Upgrade_List) is
      function Find (Name : in String; Version : in Positive) return String;
      procedure Add_Dependencies (Upgrade : in out Upgrade_Type;
                                  Depend  : in String);
      procedure Update_Dependencies (Upgrade : in out Upgrade_Type);

      package Sort is
         new Upgrade_Lists.Generic_Sorting ("<" => "<");

      function Find (Name : in String; Version : in Positive) return String is
      begin
         for Upgrade of List loop
            if Upgrade.Version = Version and then Upgrade.Name = Name then
               return To_String (Upgrade.Depend);
            end if;
         end loop;
         return "";
      end Find;

      procedure Add_Dependencies (Upgrade : in out Upgrade_Type;
                                  Depend  : in String) is
         Pos    : Positive := Depend'First;
         Sep1   : Natural;
         Sep2   : Natural;
      begin
         while Pos <= Depend'Last loop
            while Is_Space (Depend (Pos)) and then Pos <= Depend'Last loop
               Pos := Pos + 1;
            end loop;
            exit when Pos > Depend'Last;
            Sep1 := Util.Strings.Index (Depend, ':', Pos);
            exit when Sep1 = 0;
            Sep2 := Util.Strings.Index (Depend, ' ', Sep1);
            if Sep2 = 0 then
               Sep2 := Depend'Last;
            else
               Sep2 := Sep2 - 1;
            end if;
            declare
               Version : constant Natural
                 := Depend_Version (To_String (Upgrade.Depend), Depend (Pos .. Sep1 - 1));
            begin
               if Version = 0 then
                  Append (Upgrade.Depend, " ");
                  Append (Upgrade.Depend, Depend (Pos .. Sep2));

                  Log.Debug ("Add dependency {0} to {1}, now using {2}",
                             Depend (Pos .. Sep2), To_String (Upgrade.Name),
                             To_String (Upgrade.Depend));
               end if;
            end;
            Pos := Sep2 + 1;
         end loop;
      end Add_Dependencies;

      procedure Update_Dependencies (Upgrade : in out Upgrade_Type) is
         Depend : constant String := To_String (Upgrade.Depend);
         Pos    : Positive := Depend'First;
         Sep1   : Natural;
         Sep2   : Natural;
      begin
         while Pos <= Depend'Last loop
            while Is_Space (Depend (Pos)) and then Pos <= Depend'Last loop
               Pos := Pos + 1;
            end loop;
            exit when Pos > Depend'Last;
            Sep1 := Util.Strings.Index (Depend, ':', Pos);
            exit when Sep1 = 0;
            Sep2 := Util.Strings.Index (Depend, ' ', Sep1);
            if Sep2 = 0 then
               Sep2 := Depend'Last;
            else
               Sep2 := Sep2 - 1;
            end if;

            --  Add the dependencies defined for the component+version we depend on.
            declare
               Version : Positive;
            begin
               Version := Positive'Value (Depend (Sep1 + 1 .. Sep2));
               Add_Dependencies (Upgrade, Find (Depend (Pos .. Sep1 - 1), Version));

            exception
               when Constraint_Error =>
                  null;
            end;
            Pos := Sep2 + 1;
         end loop;
      end Update_Dependencies;

   begin
      for Upgrade of List loop
         Update_Dependencies (Upgrade);
      end loop;

      Sort.Sort (List);
   end Sort_Migration;

   --  ------------------------------
   --  Prepare the database migration described by the `Upgrade` record.
   --  Collect the SQL files according to the current database driver,
   --  sort them and return the list of absolute pathes in `Files`.
   --  ------------------------------
   procedure Prepare_Migration (Session : in ADO.Sessions.Session'Class;
                                Upgrade : in Upgrade_Type;
                                Files   : in out Util.Strings.Vectors.Vector) is
      use Ada.Directories;

      package Sort is
         new Util.Strings.Vectors.Generic_Sorting ("<");

      Filter  : constant Filter_Type := (Ordinary_File => True,
                                         Directory     => False,
                                         others        => False);
      Path    : constant String := To_String (Upgrade.Path);
      Driver  : constant String := Session.Get_Driver.Get_Driver_Name & "-";
      Search  : Search_Type;
      Ent     : Ada.Directories.Directory_Entry_Type;
   begin
      Log.Debug ("Prepare SQL migration list from directory {0}", Path);

      Files.Clear;
      Start_Search (Search, Directory => Path,
                    Pattern => "*.sql", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Name : constant String := Ada.Directories.Simple_Name (Ent);
            File_Path : constant String := Ada.Directories.Full_Name (Ent);
            Pos  : Natural;
         begin
            Pos := Util.Strings.Index (Name, '-');
            if Pos = 0 or else Util.Strings.Starts_With (Name (Pos + 1 .. Name'Last), Driver)
              or else Util.Strings.Starts_With (Name (Pos + 1 .. Name'Last), "all-")
            then
               Files.Append (File_Path);
            end if;
         end;
      end loop;

      Sort.Sort (Files);
      Log.Info ("Prepare migration found{0} SQL files in {1}", Files.Length'Image, Path);
   end Prepare_Migration;

   --  ------------------------------
   --  Run the database migration scripts described by the `Upgrade` record.
   --  If the `Files` is not empty and matches the `Upgrade` path, the list of
   --  files is used to perform the database migration.  Otherwise, `Prepare_Migration`
   --  is executed.  For each SQL file, read and execute each SQL statement
   --  by executing the `Execute` procedure.  At the end, the version associated
   --  with the module is updated to match the value defined in `Upgrade`.
   --  ------------------------------
   procedure Run_Migration (Session : in ADO.Sessions.Master_Session'Class;
                            Upgrade : in Upgrade_Type;
                            Files   : in out Util.Strings.Vectors.Vector;
                            Execute : not null
                              access procedure (Session : in ADO.Sessions.Session'Class;
                                                SQL : in String)) is
      function Need_Prepare return Boolean;
      procedure Process (SQL : in String);

      function Need_Prepare return Boolean is
      begin
         if Files.Is_Empty then
            return True;
         end if;
         declare
            Path : constant String := Files.Element (1);
            Dir  : constant String := Ada.Directories.Containing_Directory (Path);
         begin
            return Dir /= To_String (Upgrade.Path);
         end;
      end Need_Prepare;

      procedure Process (SQL : in String) is
      begin
         Execute (Session, SQL);
      end Process;
   begin
      if Need_Prepare then
         Prepare_Migration (Session, Upgrade, Files);
      end if;

      for File of Files loop
         ADO.SQL.Read_File (File, Process'Access);
      end loop;

      declare
         Stmt : ADO.Statements.Update_Statement
            := Session.Create_Statement (ADO.Model.VERSION_TABLE'Access);
         Result : Integer;
      begin
         Stmt.Save_Field ("version", Upgrade.Version);
         Stmt.Set_Filter ("name = :name AND version < :version");
         Stmt.Bind_Param ("name", Upgrade.Name);
         Stmt.Bind_Param ("version", Upgrade.Version);
         Stmt.Execute (Result);
         if Result > 0 then
            Log.Info ("Database module {0} upgraded to version{1}",
                      Upgrade.Name, Upgrade.Version'Image);
            return;
         end if;
      end;

      declare
         Stmt : ADO.Statements.Insert_Statement
            := Session.Create_Statement (ADO.Model.VERSION_TABLE'Access);
         Result : Integer;
      begin
         Stmt.Save_Field ("name", Upgrade.Name);
         Stmt.Save_Field ("version", Upgrade.Version);
         Stmt.Execute (Result);

         Log.Info ("Database module {0} created with version{1}",
                   Upgrade.Name, Upgrade.Version'Image);
      end;
   end Run_Migration;

end ADO.Schemas.Databases;