-----------------------------------------------------------------------
--  ADO Sqlite Database -- SQLite Database connections
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 2017, 2018 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 Interfaces.C.Strings;

with Util.Log;
with Util.Log.Loggers;
with Util.Processes.Tools;
with ADO.Sessions;
with ADO.Statements.Sqlite;
with ADO.Schemas.Sqlite;

package body ADO.Drivers.Connections.Sqlite is

   use ADO.Statements.Sqlite;
   use Interfaces.C;

   pragma Linker_Options ("-lsqlite3");

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

   Driver_Name : aliased constant String := "sqlite";
   Driver      : aliased Sqlite_Driver;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access is
      pragma Unreferenced (Database);
   begin
      return Driver'Access;
   end Get_Driver;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Query => Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a delete statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Rollback;

   --  ------------------------------
   --  Closes the database connection
   --  ------------------------------
   overriding
   procedure Close (Database : in out Database_Connection) is
   begin
      Log.Info ("Close connection {0}", Database.Name);
      Database.Server := null;
   end Close;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   overriding
   procedure Load_Schema (Database : in Database_Connection;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      ADO.Schemas.Sqlite.Load_Schema (Database, Schema);
   end Load_Schema;

   protected body Sqlite_Connections is

      procedure Open (Config : in Configuration'Class;
                      Result : in out Ref.Ref'Class) is
         use Strings;

         URI      : constant String := Config.Get_URI;
         Database : Database_Connection_Access;
         Pos      : Database_List.Cursor := Database_List.First (List);
         DB       : SQLite_Database;
      begin
         --  Look first in the database list.
         while Database_List.Has_Element (Pos) loop
            DB := Database_List.Element (Pos);
            if DB.URI = URI then
               Database := new Database_Connection;
               Database.URI := DB.URI;
               Database.Name := DB.Name;
               Database.Server := DB.Server;
               Result := Ref.Create (Database.all'Access);
               return;
            end if;
            Database_List.Next (Pos);
         end loop;

         --  Now we can open a new database connection.
         declare
            Name     : constant String := Config.Get_Database;
            Filename : Strings.chars_ptr;
            Status   : int;
            Handle   : aliased access Sqlite3;
            Flags    : constant int
              := Sqlite3_H.SQLITE_OPEN_FULLMUTEX + Sqlite3_H.SQLITE_OPEN_READWRITE;
         begin
            Filename := Strings.New_String (Name);
            Status := Sqlite3_H.sqlite3_open_v2 (Filename, Handle'Address,
                                                 Flags,
                                                 Strings.Null_Ptr);

            Strings.Free (Filename);
            if Status /= Sqlite3_H.SQLITE_OK then
               declare
                  Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Status);
                  Msg   : constant String := Strings.Value (Error);
               begin
                  Log.Error ("Cannot open SQLite database: {0}", Msg);
                  raise ADO.Configs.Connection_Error with "Cannot open database: " & Msg;
               end;
            end if;

            Database := new Database_Connection;
            declare

               procedure Configure (Name : in String;
                                    Item : in Util.Properties.Value);
               function Escape (Value : in Util.Properties.Value) return String;

               function Escape (Value : in Util.Properties.Value) return String is
                  S : constant String := Util.Properties.To_String (Value);
               begin
                  if S'Length > 0 and then S (S'First) >= '0' and then S (S'First) <= '9' then
                     return S;
                  elsif S'Length > 0 and then S (S'First) = ''' then
                     return S;
                  else
                     return "'" & S & "'";
                  end if;
               end Escape;

               procedure Configure (Name : in String;
                                    Item : in Util.Properties.Value) is
                  SQL : constant String := "PRAGMA " & Name & "=" & Escape (Item);
               begin
                  if Util.Strings.Index (Name, '.') = 0 then
                     Log.Info ("Configure database with {0}", SQL);
                     ADO.Statements.Sqlite.Execute (Database.Server, SQL);
                  end if;

               exception
                  when SQL_Error =>
                     null;
               end Configure;

            begin
               Database.Server := Handle;
               Database.Name   := To_Unbounded_String (Config.Get_Database);
               Database.URI    := To_Unbounded_String (URI);
               Result := Ref.Create (Database.all'Access);

               DB.Server := Handle;
               DB.Name := Database.Name;
               DB.URI := Database.URI;
               Database_List.Prepend (Container => List, New_Item => DB);

               --  Configure the connection by setting up the SQLite 'pragma X=Y' SQL commands.
               --  Typical configuration includes:
               --    synchronous=OFF
               --    temp_store=MEMORY
               --    encoding='UTF-8'
               Config.Iterate (Process => Configure'Access);
            end;
         end;
      end Open;

      procedure Clear is
         DB     : SQLite_Database;
         Result : int;
      begin
         while not Database_List.Is_Empty (List) loop
            DB := Database_List.First_Element (List);
            Database_List.Delete_First (List);
            if DB.Server /= null then
               Result := Sqlite3_H.sqlite3_close_v2 (DB.Server);
               if Result /= Sqlite3_H.SQLITE_OK then
                  declare
                     Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Result);
                     Msg   : constant String := Strings.Value (Error);
                  begin
                     Log.Error ("Cannot close database {0}: {1}", To_String (DB.Name), Msg);
                  end;
               end if;
            end if;
         end loop;
      end Clear;

   end Sqlite_Connections;

   --  ------------------------------
   --  Initialize the database connection manager.
   --  ------------------------------
   procedure Create_Connection (D      : in out Sqlite_Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
   begin
      D.Map.Open (Config, Result);
   end Create_Connection;

   --  ------------------------------
   --  Create the database and initialize it with the schema SQL file.
   --  The `Admin` parameter describes the database connection with administrator access.
   --  The `Config` parameter describes the target database connection.
   --  ------------------------------
   overriding
   procedure Create_Database (D           : in out Sqlite_Driver;
                              Admin       : in Configs.Configuration'Class;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector) is
      pragma Unreferenced (D, Admin);

      Status        : Integer;
      Database_Path : constant String := Config.Get_Database;
      Command       : constant String :=
        "sqlite3 --batch --init " & Schema_Path & " " & Database_Path;
   begin
      Log.Info ("Creating SQLite database {0}", Database_Path);
      Util.Processes.Tools.Execute (Command, Messages, Status);

      if Status = 0 then
         Log.Info ("Database schema created successfully.");
      elsif Status = 255 then
         Messages.Append ("Command not found: " & Command);
         Log.Error ("Command not found: {0}", Command);
      else
         Messages.Append ("Command " & Command & " failed with exit code "
                            & Util.Strings.Image (Status));
         Log.Error ("Command {0} failed with exit code {1}", Command,
                    Util.Strings.Image (Status));
      end if;
   end Create_Database;

   --  ------------------------------
   --  Initialize the SQLite driver.
   --  ------------------------------
   procedure Initialize is
      use type Util.Strings.Name_Access;
   begin
      Log.Debug ("Initializing sqlite driver");

      if Driver.Name = null then
         Driver.Name := Driver_Name'Access;
         Register (Driver'Access);
      end if;
   end Initialize;

   --  ------------------------------
   --  Deletes the SQLite driver.
   --  ------------------------------
   overriding
   procedure Finalize (D : in out Sqlite_Driver) is
   begin
      Log.Debug ("Deleting the sqlite driver");
      D.Map.Clear;
   end Finalize;

end ADO.Drivers.Connections.Sqlite;

-----------------------------------------------------------------------
--  ADO Sqlite Database -- SQLite Database connections
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 2017, 2018 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 Interfaces.C.Strings;

with Util.Log;
with Util.Log.Loggers;
with Util.Processes.Tools;
with ADO.Sessions;
with ADO.Statements.Sqlite;
with ADO.Schemas.Sqlite;

package body ADO.Drivers.Connections.Sqlite is

   use ADO.Statements.Sqlite;
   use Interfaces.C;

   pragma Linker_Options ("-lsqlite3");

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

   Driver_Name : aliased constant String := "sqlite";
   Driver      : aliased Sqlite_Driver;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access is
      pragma Unreferenced (Database);
   begin
      return Driver'Access;
   end Get_Driver;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Query => Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a delete statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Rollback;

   --  ------------------------------
   --  Closes the database connection
   --  ------------------------------
   overriding
   procedure Close (Database : in out Database_Connection) is
   begin
      Log.Info ("Close connection {0}", Database.Name);
      Database.Server := null;
   end Close;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   overriding
   procedure Load_Schema (Database : in Database_Connection;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      ADO.Schemas.Sqlite.Load_Schema (Database, Schema);
   end Load_Schema;

   protected body Sqlite_Connections is

      procedure Open (Config : in Configuration'Class;
                      Result : in out Ref.Ref'Class) is
         use Strings;

         URI      : constant String := Config.Get_URI;
         Database : Database_Connection_Access;
         Pos      : Database_List.Cursor := Database_List.First (List);
         DB       : SQLite_Database;
      begin
         --  Look first in the database list.
         while Database_List.Has_Element (Pos) loop
            DB := Database_List.Element (Pos);
            if DB.URI = URI then
               Database := new Database_Connection;
               Database.URI := DB.URI;
               Database.Name := DB.Name;
               Database.Server := DB.Server;
               Result := Ref.Create (Database.all'Access);
               return;
            end if;
            Database_List.Next (Pos);
         end loop;

         --  Now we can open a new database connection.
         declare
            Name     : constant String := Config.Get_Database;
            Filename : Strings.chars_ptr;
            Status   : int;
            Handle   : aliased access Sqlite3;
            Flags    : int
              := Sqlite3_H.SQLITE_OPEN_FULLMUTEX + Sqlite3_H.SQLITE_OPEN_READWRITE;
         begin
            if Config.Get_Property ("create") = "1" then
               Flags := Flags + Sqlite3_H.SQLITE_OPEN_CREATE;
            end if;
            Filename := Strings.New_String (Name);
            Status := Sqlite3_H.sqlite3_open_v2 (Filename, Handle'Address,
                                                 Flags,
                                                 Strings.Null_Ptr);

            Strings.Free (Filename);
            if Status /= Sqlite3_H.SQLITE_OK then
               declare
                  Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Status);
                  Msg   : constant String := Strings.Value (Error);
               begin
                  Log.Error ("Cannot open SQLite database: {0}", Msg);
                  raise ADO.Configs.Connection_Error with "Cannot open database: " & Msg;
               end;
            end if;

            Database := new Database_Connection;
            declare

               procedure Configure (Name : in String;
                                    Item : in Util.Properties.Value);
               function Escape (Value : in Util.Properties.Value) return String;

               function Escape (Value : in Util.Properties.Value) return String is
                  S : constant String := Util.Properties.To_String (Value);
               begin
                  if S'Length > 0 and then S (S'First) >= '0' and then S (S'First) <= '9' then
                     return S;
                  elsif S'Length > 0 and then S (S'First) = ''' then
                     return S;
                  else
                     return "'" & S & "'";
                  end if;
               end Escape;

               procedure Configure (Name : in String;
                                    Item : in Util.Properties.Value) is
                  SQL : constant String := "PRAGMA " & Name & "=" & Escape (Item);
               begin
                  if Util.Strings.Index (Name, '.') = 0 then
                     Log.Info ("Configure database with {0}", SQL);
                     ADO.Statements.Sqlite.Execute (Database.Server, SQL);
                  end if;

               exception
                  when SQL_Error =>
                     null;
               end Configure;

            begin
               Database.Server := Handle;
               Database.Name   := To_Unbounded_String (Config.Get_Database);
               Database.URI    := To_Unbounded_String (URI);
               Result := Ref.Create (Database.all'Access);

               DB.Server := Handle;
               DB.Name := Database.Name;
               DB.URI := Database.URI;
               Database_List.Prepend (Container => List, New_Item => DB);

               --  Configure the connection by setting up the SQLite 'pragma X=Y' SQL commands.
               --  Typical configuration includes:
               --    synchronous=OFF
               --    temp_store=MEMORY
               --    encoding='UTF-8'
               Config.Iterate (Process => Configure'Access);
            end;
         end;
      end Open;

      procedure Clear is
         DB     : SQLite_Database;
         Result : int;
      begin
         while not Database_List.Is_Empty (List) loop
            DB := Database_List.First_Element (List);
            Database_List.Delete_First (List);
            if DB.Server /= null then
               Result := Sqlite3_H.sqlite3_close_v2 (DB.Server);
               if Result /= Sqlite3_H.SQLITE_OK then
                  declare
                     Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Result);
                     Msg   : constant String := Strings.Value (Error);
                  begin
                     Log.Error ("Cannot close database {0}: {1}", To_String (DB.Name), Msg);
                  end;
               end if;
            end if;
         end loop;
      end Clear;

   end Sqlite_Connections;

   --  ------------------------------
   --  Initialize the database connection manager.
   --  ------------------------------
   procedure Create_Connection (D      : in out Sqlite_Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
   begin
      D.Map.Open (Config, Result);
   end Create_Connection;

   --  ------------------------------
   --  Create the database and initialize it with the schema SQL file.
   --  The `Admin` parameter describes the database connection with administrator access.
   --  The `Config` parameter describes the target database connection.
   --  ------------------------------
   overriding
   procedure Create_Database (D           : in out Sqlite_Driver;
                              Admin       : in Configs.Configuration'Class;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector) is
      pragma Unreferenced (D, Admin);

      Status        : Integer;
      Database_Path : constant String := Config.Get_Database;
      Command       : constant String :=
        "sqlite3 --batch --init " & Schema_Path & " " & Database_Path;
   begin
      Log.Info ("Creating SQLite database {0}", Database_Path);
      Util.Processes.Tools.Execute (Command, Messages, Status);

      if Status = 0 then
         Log.Info ("Database schema created successfully.");
      elsif Status = 255 then
         Messages.Append ("Command not found: " & Command);
         Log.Error ("Command not found: {0}", Command);
      else
         Messages.Append ("Command " & Command & " failed with exit code "
                            & Util.Strings.Image (Status));
         Log.Error ("Command {0} failed with exit code {1}", Command,
                    Util.Strings.Image (Status));
      end if;
   end Create_Database;

   --  ------------------------------
   --  Initialize the SQLite driver.
   --  ------------------------------
   procedure Initialize is
      use type Util.Strings.Name_Access;
   begin
      Log.Debug ("Initializing sqlite driver");

      if Driver.Name = null then
         Driver.Name := Driver_Name'Access;
         Register (Driver'Access);
      end if;
   end Initialize;

   --  ------------------------------
   --  Deletes the SQLite driver.
   --  ------------------------------
   overriding
   procedure Finalize (D : in out Sqlite_Driver) is
   begin
      Log.Debug ("Deleting the sqlite driver");
      D.Map.Clear;
   end Finalize;

end ADO.Drivers.Connections.Sqlite;

Add create property to setup the create flag when opening the SQLite database


-----------------------------------------------------------------------
--  util-system-os -- Unix system operations
--  Copyright (C) 2011, 2012, 2014 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 System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;
with Util.Systems.Constants;
with Util.Systems.Types;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Integer;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Interfaces.C.int) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

   function Sys_Stat (Path : in Ptr;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Stat, "stat");

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Fstat, "fstat");

end Util.Systems.Os;

-----------------------------------------------------------------------
--  util-system-os -- Unix system operations
--  Copyright (C) 2011, 2012, 2014 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 System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;
with Util.Systems.Constants;
with Util.Systems.Types;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Integer;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Interfaces.C.int) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

   function Sys_Stat (Path : in Ptr;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Stat, Util.Systems.Types.STAT_NAME);

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Fstat, Util.Systems.Types.FSTAT_NAME);

end Util.Systems.Os;

Use the generated system call name for stat() and fstat()


-----------------------------------------------------------------------
--  util-beans-vectors -- Object vectors
--  Copyright (C) 2011, 2017 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.Containers.Vectors;
with Util.Beans.Basic;
package Util.Beans.Objects.Vectors is

   package Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Object);

   subtype Cursor is Vectors.Cursor;
   subtype Vector is Vectors.Vector;

   --  Make all the Vectors operations available (a kind of 'use Vectors' for anybody).
   function Length (Container : in Vector) return Ada.Containers.Count_Type renames Vectors.Length;
   function Is_Empty (Container : in Vector) return Boolean renames Vectors.Is_Empty;
   procedure Clear (Container : in out Vector) renames Vectors.Clear;
   function First (Container : in Vector) return Cursor renames Vectors.First;
   function Last (Container : in Vector) return Cursor renames Vectors.Last;
   function Element (Container : in Vector;
                     Position  : in Natural) return Object renames Vectors.Element;

   procedure Append (Container : in out Vector;
                     New_Item  : in Object;
                     Count     : in Ada.Containers.Count_Type := 1) renames Vectors.Append;
   procedure Query_Element (Position : in Cursor;
                            Process  : not null access procedure (Element : Object))
                            renames Vectors.Query_Element;
   procedure Update_Element (Container : in out Vector;
                             Position  : in Cursor;
                             Process   : not null access procedure (Element : in out Object))
                             renames Vectors.Update_Element;

   function Has_Element (Position : Cursor) return Boolean renames Vectors.Has_Element;
   function Element (Position : Cursor) return Object renames Vectors.Element;
   procedure Next (Position : in out Cursor) renames Vectors.Next;
   function Next (Position : Cursor) return Cursor renames Vectors.Next;
   function Previous (Position : Cursor) return Cursor renames Vectors.Previous;
   procedure Previous (Position : in out Cursor) renames Vectors.Previous;

   --  ------------------------------
   --  Map Bean
   --  ------------------------------
   --  The Map_Bean is a map of objects that also exposes the Bean interface.
   --  This allows the map to be available and accessed from an Object instance.
   type Vector_Bean is new Vectors.Vector and Util.Beans.Basic.Array_Bean with private;
   type Vector_Bean_Access is access all Vector_Bean'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Vector_Bean;
                       Name : in String) return Object;

   --  Get the number of elements in the list.
   overriding
   function Get_Count (From : in Vector_Bean) return Natural;

   --  Get the element at the given position.
   overriding
   function Get_Row (From     : in Vector_Bean;
                     Position : in Natural) return Util.Beans.Objects.Object;

   --  Create an object that contains a <tt>Vector_Bean</tt> instance.
   function Create return Object;

private

   type Vector_Bean is new Vectors.Vector and Util.Beans.Basic.Array_Bean with null record;

end Util.Beans.Objects.Vectors;

-----------------------------------------------------------------------
--  util-beans-vectors -- Object vectors
--  Copyright (C) 2011, 2017, 2022 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.Containers.Vectors;
with Util.Beans.Basic;

--  == Object vectors ==
--  The `Util.Beans.Objects.Vectors` package provides a vector of objects.
--  To create an instance of the vector, it is possible to use the `Create` function
--  as follows:
--
--    List : Util.Beans.Objects.Object := Util.Beans.Objects.Vectors.Create;
--
package Util.Beans.Objects.Vectors is

   package Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Object);

   subtype Cursor is Vectors.Cursor;
   subtype Vector is Vectors.Vector;

   --  Make all the Vectors operations available (a kind of 'use Vectors' for anybody).
   function Length (Container : in Vector) return Ada.Containers.Count_Type renames Vectors.Length;
   function Is_Empty (Container : in Vector) return Boolean renames Vectors.Is_Empty;
   procedure Clear (Container : in out Vector) renames Vectors.Clear;
   function First (Container : in Vector) return Cursor renames Vectors.First;
   function Last (Container : in Vector) return Cursor renames Vectors.Last;
   function Element (Container : in Vector;
                     Position  : in Natural) return Object renames Vectors.Element;

   procedure Append (Container : in out Vector;
                     New_Item  : in Object;
                     Count     : in Ada.Containers.Count_Type := 1) renames Vectors.Append;
   procedure Query_Element (Position : in Cursor;
                            Process  : not null access procedure (Element : Object))
                            renames Vectors.Query_Element;
   procedure Update_Element (Container : in out Vector;
                             Position  : in Cursor;
                             Process   : not null access procedure (Element : in out Object))
                             renames Vectors.Update_Element;

   function Has_Element (Position : Cursor) return Boolean renames Vectors.Has_Element;
   function Element (Position : Cursor) return Object renames Vectors.Element;
   procedure Next (Position : in out Cursor) renames Vectors.Next;
   function Next (Position : Cursor) return Cursor renames Vectors.Next;
   function Previous (Position : Cursor) return Cursor renames Vectors.Previous;
   procedure Previous (Position : in out Cursor) renames Vectors.Previous;

   --  ------------------------------
   --  Vector Bean
   --  ------------------------------
   --  The `Vector_Bean` is a vector of objects that also exposes the <b>Bean</b> interface.
   --  This allows the vector to be available and accessed from an Object instance.
   type Vector_Bean is new Vectors.Vector and Util.Beans.Basic.Array_Bean with private;
   type Vector_Bean_Access is access all Vector_Bean'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Vector_Bean;
                       Name : in String) return Object;

   --  Get the number of elements in the list.
   overriding
   function Get_Count (From : in Vector_Bean) return Natural;

   --  Get the element at the given position.
   overriding
   function Get_Row (From     : in Vector_Bean;
                     Position : in Natural) return Util.Beans.Objects.Object;

   --  Create an object that contains a `Vector_Bean` instance.
   function Create return Object;

   --  Iterate over the vectors or array elements.
   --  If the object is not a `Vector_Bean` or an array, the operation does nothing.
   procedure Iterate (From    : in Object;
                      Process : not null access procedure (Item : in Object));

private

   type Vector_Bean is new Vectors.Vector and Util.Beans.Basic.Array_Bean with null record;

end Util.Beans.Objects.Vectors;

Declare the Iterate procedure and add some documentation


-----------------------------------------------------------------------
--  util-locales -- Locale support
--  Copyright (C) 2001, 2002, 2003, 2009, 2010, 2011, 2015, 2018 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.Strings.Hash;

package body Util.Locales is

   --  ------------------------------
   --  Get the lowercase two-letter ISO-639 code.
   --  ------------------------------
   function Get_Language (Loc : in Locale) return String is
   begin
      if Loc = null then
         return "";
      else
         return Loc (1 .. 2);
      end if;
   end Get_Language;

   --  ------------------------------
   --  Get the ISO 639-2 language code.
   --  ------------------------------
   function Get_ISO3_Language (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 3 then
         return "";
      end if;
      if Loc'Length <= 6 then
         return Loc (4 .. 6);
      end if;
      return Loc (7 .. 9);
   end Get_ISO3_Language;

   --  ------------------------------
   --  Get the uppercase two-letter ISO-3166 code.
   --  ------------------------------
   function Get_Country (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 2 or else Loc (3) /= '_' then
         return "";
      else
         return Loc (4 .. 5);
      end if;
   end Get_Country;

   --  ------------------------------
   --  Get the ISO-3166-2 country code.
   --  ------------------------------
   function Get_ISO3_Country (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 5 then
         return "";
      else
         return Loc (10 .. Loc'Last);
      end if;
   end Get_ISO3_Country;

   --  ------------------------------
   --  Get the variant code
   --  ------------------------------
   function Get_Variant (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 13 then
         return "";
      else
         return Loc (7 .. 8);
      end if;
   end Get_Variant;

   --  ------------------------------
   --  Get the locale for the given language code
   --  ------------------------------
   function Get_Locale (Language : in String) return Locale is
      Length : constant Natural := Language'Length;
      Lower  : Natural := Locales'First;
      Upper  : Natural := Locales'Last;
      Pos    : Natural;
      Result : Locale;
   begin
      while Lower <= Upper loop
         Pos := (Lower + Upper) / 2;
         Result := Locales (Pos);
         if Result'Length < Length then
            if Result.all < Language (Language'First .. Language'First + Result'Length - 1) then
               Lower := Pos + 1;
            else
               Upper := Pos - 1;
            end if;
         elsif Result'Length > Length and then Result (Length + 1) = '.'
           and then Result (1 .. Length) = Language
         then
            return Result;
         elsif Result (1 .. Length) < Language then
            Lower := Pos + 1;
         else
            Upper := Pos - 1;
         end if;
      end loop;
      return NULL_LOCALE;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale for the given language and country code
   --  ------------------------------
   function Get_Locale (Language : in String;
                        Country  : in String) return Locale is
   begin
      if Language'Length /= 2 or else (Country'Length /= 0 and Country'Length /= 2) then
         return NULL_LOCALE;
      elsif Country'Length = 0 then
         return Get_Locale (Language);
      else
         return Get_Locale (Language & "_" & Country);
      end if;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale for the given language, country and variant code
   --  ------------------------------
   function Get_Locale (Language : in String;
                        Country  : in String;
                        Variant  : in String) return Locale is
   begin
      if Language'Length /= 2
        or else (Country'Length /= 0 and Country'Length /= 2)
        or else (Variant'Length /= 0 and Variant'Length /= 2)
      then
         return NULL_LOCALE;
      end if;
      if Country'Length = 0 and Variant'Length = 0 then
         return Get_Locale (Language);
      elsif Variant'Length = 0 then
         return Get_Locale (Language, Country);
      else
         return Get_Locale (Language & "_" & Country & "_" & Variant);
      end if;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale code in the form language_country_variant.
   --  ------------------------------
   function To_String (Loc : in Locale) return String is
   begin
      if Loc = null then
         return "";
      elsif Loc'Length > 3 and Loc (3) = '.' then
         return Loc (1 .. 2);
      elsif Loc'Length > 6 and Loc (6) = '.' then
         return Loc (1 .. 5);
      else
         return Loc (1 .. 8);
      end if;
   end To_String;

   --  ------------------------------
   --  Compute the hash value of the locale.
   --  ------------------------------
   function Hash (Loc : in Locale) return Ada.Containers.Hash_Type is
   begin
      return Ada.Strings.Hash (Loc.all);
   end Hash;

end Util.Locales;

-----------------------------------------------------------------------
--  util-locales -- Locale support
--  Copyright (C) 2001 - 2022 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.Strings.Hash;

package body Util.Locales is

   --  ------------------------------
   --  Get the lowercase two-letter ISO-639 code.
   --  ------------------------------
   function Get_Language (Loc : in Locale) return String is
   begin
      if Loc = null then
         return "";
      else
         return Loc (1 .. 2);
      end if;
   end Get_Language;

   --  ------------------------------
   --  Get the ISO 639-2 language code.
   --  ------------------------------
   function Get_ISO3_Language (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 3 then
         return "";
      end if;
      if Loc'Length <= 6 then
         return Loc (4 .. 6);
      end if;
      if Loc'Length <= 13 then
         return Loc (7 .. 9);
      end if;
      return Loc (10  .. 15);
   end Get_ISO3_Language;

   --  ------------------------------
   --  Get the uppercase two-letter ISO-3166 code.
   --  ------------------------------
   function Get_Country (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 2 or else Loc (3) /= '_' then
         return "";
      else
         return Loc (4 .. 5);
      end if;
   end Get_Country;

   --  ------------------------------
   --  Get the ISO-3166-2 country code.
   --  ------------------------------
   function Get_ISO3_Country (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 9 then
         return "";
      else
         return Loc (Loc'Last - 2 .. Loc'Last);
      end if;
   end Get_ISO3_Country;

   --  ------------------------------
   --  Get the variant code
   --  ------------------------------
   function Get_Variant (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 13 then
         return "";
      else
         return Loc (7 .. 8);
      end if;
   end Get_Variant;

   --  ------------------------------
   --  Get the locale for the given language code
   --  ------------------------------
   function Get_Locale (Language : in String) return Locale is
      Length : constant Natural := Language'Length;
      Lower  : Natural := Locales'First;
      Upper  : Natural := Locales'Last;
      Pos    : Natural;
      Result : Locale;
   begin
      while Lower <= Upper loop
         Pos := (Lower + Upper) / 2;
         Result := Locales (Pos);
         if Result'Length < Length then
            if Result.all < Language (Language'First .. Language'First + Result'Length - 1) then
               Lower := Pos + 1;
            else
               Upper := Pos - 1;
            end if;
         elsif Result'Length > Length and then Result (Length + 1) = '.'
           and then Result (1 .. Length) = Language
         then
            return Result;
         elsif Result (1 .. Length) < Language then
            Lower := Pos + 1;
         else
            Upper := Pos - 1;
         end if;
      end loop;
      return NULL_LOCALE;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale for the given language and country code
   --  ------------------------------
   function Get_Locale (Language : in String;
                        Country  : in String) return Locale is
   begin
      if Language'Length /= 2 or else (Country'Length /= 0 and Country'Length /= 2) then
         return NULL_LOCALE;
      elsif Country'Length = 0 then
         return Get_Locale (Language);
      else
         return Get_Locale (Language & "_" & Country);
      end if;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale for the given language, country and variant code
   --  ------------------------------
   function Get_Locale (Language : in String;
                        Country  : in String;
                        Variant  : in String) return Locale is
   begin
      if Language'Length /= 2
        or else (Country'Length /= 0 and Country'Length /= 2)
        or else (Variant'Length /= 0 and Variant'Length /= 2)
      then
         return NULL_LOCALE;
      end if;
      if Country'Length = 0 and Variant'Length = 0 then
         return Get_Locale (Language);
      elsif Variant'Length = 0 then
         return Get_Locale (Language, Country);
      else
         return Get_Locale (Language & "_" & Country & "_" & Variant);
      end if;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale code in the form language_country_variant.
   --  ------------------------------
   function To_String (Loc : in Locale) return String is
   begin
      if Loc = null then
         return "";
      elsif Loc'Length > 3 and Loc (3) = '.' then
         return Loc (1 .. 2);
      elsif Loc'Length > 6 and Loc (6) = '.' then
         return Loc (1 .. 5);
      else
         return Loc (1 .. 8);
      end if;
   end To_String;

   --  ------------------------------
   --  Compute the hash value of the locale.
   --  ------------------------------
   function Hash (Loc : in Locale) return Ada.Containers.Hash_Type is
   begin
      return Ada.Strings.Hash (Loc.all);
   end Hash;

end Util.Locales;

Fix Get_ISO3_Country and Get_ISO3_Language which were incorrect for some locales


-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 2010, 2011, 2016, 2017 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.Strings.Unbounded;
with Ada.Unchecked_Deallocation;
with Util.Encoders.Base16;
with Util.Encoders.Base64;
with Util.Encoders.SHA1;
package body Util.Encoders is

   use Ada;
   use Ada.Strings.Unbounded;

   use type Ada.Streams.Stream_Element_Offset;

   procedure Free is
     new Ada.Unchecked_Deallocation (Transformer'Class, Transformer_Access);

   --  ------------------------------
   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   --  ------------------------------
   function Encode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Encode = null then
         raise Not_Supported with "There is no encoder";
      end if;
      return E.Encode.Transform (Data);
   end Encode;

   --  ------------------------------
   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   --  ------------------------------
   function Decode (E    : in Decoder;
                    Data : in String) return String is
   begin
      if E.Decode = null then
         raise Not_Supported with "There is no decoder";
      end if;
      return E.Decode.Transform (Data);
   end Decode;

   MIN_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 64;
   MAX_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 2_048;

   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset;
   pragma Inline (Best_Size);

   --  ------------------------------
   --  Compute a good size for allocating a buffer on the stack
   --  ------------------------------
   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset is
   begin
      if Length < Natural (MIN_BUFFER_SIZE) then
         return MIN_BUFFER_SIZE;
      elsif Length > Natural (MAX_BUFFER_SIZE) then
         return MAX_BUFFER_SIZE;
      else
         return Streams.Stream_Element_Offset (((Length + 15) / 16) * 16);
      end if;
   end Best_Size;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in out Transformer'Class;
                       Data : in String) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Pos      : Natural := Data'First;
      Last          : Streams.Stream_Element_Offset;
   begin
      while Pos <= Data'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            First_Encoded : Streams.Stream_Element_Offset := 1;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in out result string.
            loop
               E.Transform (Data    => Buf (First_Encoded .. Size),
                            Into    => Res,
                            Encoded => Last_Encoded,
                            Last    => Last);

               --  If the encoder generated nothing, move the position backward
               --  to take into account the remaining bytes not taken into account.
               if Last < 1 then
                  Next_Pos := Next_Pos - Natural (Size - First_Encoded + 1);
                  exit;
               end if;
               for I in 1 .. Last loop
                  Tmp (Natural (I)) := Character'Val (Res (I));
               end loop;
               Append (Result, Tmp (1 .. Natural (Last)));
               exit when Last_Encoded = Size;
               First_Encoded := Last_Encoded + 1;
            end loop;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            Pos := Next_Pos;
         end;
      end loop;
      Last := 0;
      E.Finish (Into => Res,
                Last => Last);
      if Last > 0 then
         for I in 1 .. Last loop
            Tmp (Natural (I)) := Character'Val (Res (I));
         end loop;
         Append (Result, Tmp (1 .. Natural (Last)));
      end if;
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   procedure Transform (E    : in out Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset) is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Pos      : Natural := Data'First;
      First    : Streams.Stream_Element_Offset := Into'First;
   begin
      Last := Into'First - 1;
      while Pos <= Data'Last and Last < Into'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in the output data array.
            E.Transform (Data    => Buf (1 .. Size),
                         Into    => Into (First .. Into'Last),
                         Encoded => Last_Encoded,
                         Last    => Last);

            --  If the encoded has not used all the data, update the position for the next run.
            if Last_Encoded /= Size then
               Next_Pos := Next_Pos - Natural (Size - Last_Encoded + 1);
            end if;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            First := Last;
            Pos := Next_Pos;
         end;
      end loop;
      if Pos <= Data'Last then
         raise Encoding_Error with "Not enough space for encoding";
      end if;
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in out Transformer'Class;
                       Data : in Streams.Stream_Element_Array) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Last_Encoded  : Streams.Stream_Element_Offset;
      Last          : Streams.Stream_Element_Offset;
   begin

      --  Encode that buffer and put the result in out result string.
      E.Transform (Data    => Data,
                   Into    => Res,
                   Encoded => Last_Encoded,
                   Last    => Last);

      E.Finish (Res (Last + 1 .. Res'Last), Last);
      for I in 1 .. Last loop
         Tmp (Natural (I)) := Character'Val (Res (I));
      end loop;
      Append (Result, Tmp (1 .. Natural (Last)));
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   --  ------------------------------
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;

      P    : Ada.Streams.Stream_Element_Offset := Pos;
      V, U : Interfaces.Unsigned_64;
   begin
      V := Val;
      loop
         if V < 16#07F# then
            Into (P) := Ada.Streams.Stream_Element (V);
            Last := P;
            return;
         end if;
         U := V and 16#07F#;
         Into (P) := Ada.Streams.Stream_Element (U or 16#80#);
         P := P + 1;
         V := Interfaces.Shift_Right (V, 7);
      end loop;
   end Encode_LEB128;

   --  ------------------------------
   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   --  ------------------------------
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;
      use type Interfaces.Unsigned_8;

      P     : Ada.Streams.Stream_Element_Offset := Pos;
      Value : Interfaces.Unsigned_64 := 0;
      V     : Interfaces.Unsigned_8;
      Shift : Integer := 0;
   begin
      loop
         V := Interfaces.Unsigned_8 (From (P));
         if (V and 16#80#) = 0 then
            Val := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
            Last := P + 1;
            return;
         end if;
         V := V and 16#07F#;
         Value := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
         P := P + 1;
         Shift := Shift + 7;
      end loop;
   end Decode_LEB128;

   --  ------------------------------
   --  Create the encoder object for the specified algorithm.
   --  ------------------------------
   function Create (Name : String) return Encoder is
   begin
      if Name = BASE_16 or Name = HEX then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base16.Encoder;
         end return;

      elsif Name = BASE_64 then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base64.Encoder;
         end return;

      elsif Name = BASE_64_URL then
         return E : Encoder do
            E.Encode := Util.Encoders.Base64.Create_URL_Encoder;
         end return;

      elsif Name = HASH_SHA1 then
         return E : Encoder do
            E.Encode := new Util.Encoders.SHA1.Encoder;
         end return;
      end if;
      raise Not_Supported with "Invalid encoder: " & Name;
   end Create;

   --  ------------------------------
   --  Create the encoder object for the specified algorithm.
   --  ------------------------------
   function Create (Name : String) return Decoder is
   begin
      if Name = BASE_16 or Name = HEX then
         return E : Decoder do
            E.Decode := new Util.Encoders.Base16.Decoder;
         end return;

      elsif Name = BASE_64 then
         return E : Decoder do
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;

      elsif Name = BASE_64_URL then
         return E : Decoder do
            E.Decode := Util.Encoders.Base64.Create_URL_Decoder;
         end return;

      elsif Name = HASH_SHA1 then
         return E : Decoder do
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;
      end if;
      raise Not_Supported with "Invalid encoder: " & Name;
   end Create;

   --  ------------------------------
   --  Delete the transformers
   --  ------------------------------
   overriding
   procedure Finalize (E : in out Encoder) is

   begin
      Free (E.Encode);
   end Finalize;

   --  ------------------------------
   --  Delete the transformers
   --  ------------------------------
   overriding
   procedure Finalize (E : in out Decoder) is
   begin
      Free (E.Decode);
   end Finalize;

end Util.Encoders;

-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 2010, 2011, 2016, 2017 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.Strings.Unbounded;
with Ada.Unchecked_Deallocation;
with Util.Encoders.Base16;
with Util.Encoders.Base64;
with Util.Encoders.SHA1;
package body Util.Encoders is

   use Ada;
   use Ada.Strings.Unbounded;

   use type Ada.Streams.Stream_Element_Offset;

   procedure Free is
     new Ada.Unchecked_Deallocation (Transformer'Class, Transformer_Access);

   --  ------------------------------
   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   --  ------------------------------
   function Encode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Encode = null then
         raise Not_Supported with "There is no encoder";
      end if;
      return E.Encode.Transform (Data);
   end Encode;

   function Encode (E    : in Encoder;
                    Data : in Ada.Streams.Stream_Element_Array) return String is
   begin
      if E.Encode = null then
         raise Not_Supported with "There is no encoder";
      end if;
      return E.Encode.Transform (Data);
   end Encode;

   --  ------------------------------
   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   --  ------------------------------
   function Decode (E    : in Decoder;
                    Data : in String) return String is
   begin
      if E.Decode = null then
         raise Not_Supported with "There is no decoder";
      end if;
      return E.Decode.Transform (Data);
   end Decode;

   MIN_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 64;
   MAX_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 2_048;

   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset;
   pragma Inline (Best_Size);

   --  ------------------------------
   --  Compute a good size for allocating a buffer on the stack
   --  ------------------------------
   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset is
   begin
      if Length < Natural (MIN_BUFFER_SIZE) then
         return MIN_BUFFER_SIZE;
      elsif Length > Natural (MAX_BUFFER_SIZE) then
         return MAX_BUFFER_SIZE;
      else
         return Streams.Stream_Element_Offset (((Length + 15) / 16) * 16);
      end if;
   end Best_Size;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in out Transformer'Class;
                       Data : in String) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Pos      : Natural := Data'First;
      Last          : Streams.Stream_Element_Offset;
   begin
      while Pos <= Data'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            First_Encoded : Streams.Stream_Element_Offset := 1;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in out result string.
            loop
               E.Transform (Data    => Buf (First_Encoded .. Size),
                            Into    => Res,
                            Encoded => Last_Encoded,
                            Last    => Last);

               --  If the encoder generated nothing, move the position backward
               --  to take into account the remaining bytes not taken into account.
               if Last < 1 then
                  Next_Pos := Next_Pos - Natural (Size - First_Encoded + 1);
                  exit;
               end if;
               for I in 1 .. Last loop
                  Tmp (Natural (I)) := Character'Val (Res (I));
               end loop;
               Append (Result, Tmp (1 .. Natural (Last)));
               exit when Last_Encoded = Size;
               First_Encoded := Last_Encoded + 1;
            end loop;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            Pos := Next_Pos;
         end;
      end loop;
      Last := 0;
      E.Finish (Into => Res,
                Last => Last);
      if Last > 0 then
         for I in 1 .. Last loop
            Tmp (Natural (I)) := Character'Val (Res (I));
         end loop;
         Append (Result, Tmp (1 .. Natural (Last)));
      end if;
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   procedure Transform (E    : in out Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset) is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Pos      : Natural := Data'First;
      First    : Streams.Stream_Element_Offset := Into'First;
   begin
      Last := Into'First - 1;
      while Pos <= Data'Last and Last < Into'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in the output data array.
            E.Transform (Data    => Buf (1 .. Size),
                         Into    => Into (First .. Into'Last),
                         Encoded => Last_Encoded,
                         Last    => Last);

            --  If the encoded has not used all the data, update the position for the next run.
            if Last_Encoded /= Size then
               Next_Pos := Next_Pos - Natural (Size - Last_Encoded + 1);
            end if;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            First := Last;
            Pos := Next_Pos;
         end;
      end loop;
      if Pos <= Data'Last then
         raise Encoding_Error with "Not enough space for encoding";
      end if;
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in out Transformer'Class;
                       Data : in Streams.Stream_Element_Array) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Last_Encoded  : Streams.Stream_Element_Offset;
      Last          : Streams.Stream_Element_Offset;
   begin

      --  Encode that buffer and put the result in out result string.
      E.Transform (Data    => Data,
                   Into    => Res,
                   Encoded => Last_Encoded,
                   Last    => Last);

      E.Finish (Res (Last + 1 .. Res'Last), Last);
      for I in 1 .. Last loop
         Tmp (Natural (I)) := Character'Val (Res (I));
      end loop;
      Append (Result, Tmp (1 .. Natural (Last)));
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   --  ------------------------------
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;

      P    : Ada.Streams.Stream_Element_Offset := Pos;
      V, U : Interfaces.Unsigned_64;
   begin
      V := Val;
      loop
         if V < 16#07F# then
            Into (P) := Ada.Streams.Stream_Element (V);
            Last := P;
            return;
         end if;
         U := V and 16#07F#;
         Into (P) := Ada.Streams.Stream_Element (U or 16#80#);
         P := P + 1;
         V := Interfaces.Shift_Right (V, 7);
      end loop;
   end Encode_LEB128;

   --  ------------------------------
   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   --  ------------------------------
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;
      use type Interfaces.Unsigned_8;

      P     : Ada.Streams.Stream_Element_Offset := Pos;
      Value : Interfaces.Unsigned_64 := 0;
      V     : Interfaces.Unsigned_8;
      Shift : Integer := 0;
   begin
      loop
         V := Interfaces.Unsigned_8 (From (P));
         if (V and 16#80#) = 0 then
            Val := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
            Last := P + 1;
            return;
         end if;
         V := V and 16#07F#;
         Value := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
         P := P + 1;
         Shift := Shift + 7;
      end loop;
   end Decode_LEB128;

   --  ------------------------------
   --  Create the encoder object for the specified algorithm.
   --  ------------------------------
   function Create (Name : String) return Encoder is
   begin
      if Name = BASE_16 or Name = HEX then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base16.Encoder;
         end return;

      elsif Name = BASE_64 then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base64.Encoder;
         end return;

      elsif Name = BASE_64_URL then
         return E : Encoder do
            E.Encode := Util.Encoders.Base64.Create_URL_Encoder;
         end return;

      elsif Name = HASH_SHA1 then
         return E : Encoder do
            E.Encode := new Util.Encoders.SHA1.Encoder;
         end return;
      end if;
      raise Not_Supported with "Invalid encoder: " & Name;
   end Create;

   --  ------------------------------
   --  Create the encoder object for the specified algorithm.
   --  ------------------------------
   function Create (Name : String) return Decoder is
   begin
      if Name = BASE_16 or Name = HEX then
         return E : Decoder do
            E.Decode := new Util.Encoders.Base16.Decoder;
         end return;

      elsif Name = BASE_64 then
         return E : Decoder do
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;

      elsif Name = BASE_64_URL then
         return E : Decoder do
            E.Decode := Util.Encoders.Base64.Create_URL_Decoder;
         end return;

      elsif Name = HASH_SHA1 then
         return E : Decoder do
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;
      end if;
      raise Not_Supported with "Invalid encoder: " & Name;
   end Create;

   --  ------------------------------
   --  Delete the transformers
   --  ------------------------------
   overriding
   procedure Finalize (E : in out Encoder) is

   begin
      Free (E.Encode);
   end Finalize;

   --  ------------------------------
   --  Delete the transformers
   --  ------------------------------
   overriding
   procedure Finalize (E : in out Decoder) is
   begin
      Free (E.Decode);
   end Finalize;

end Util.Encoders;

Implement the Encode function that accepts a Stream_Element_Array as input


-----------------------------------------------------------------------
--  druss-commands-devices -- Print information about the devices
--  Copyright (C) 2017, 2018 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.
-----------------------------------------------------------------------

package Druss.Commands.Devices is

   type Command_Type is new Druss.Commands.Drivers.Command_Type with null record;

   procedure Do_List (Command   : in Command_Type;
                      Args      : in Argument_List'Class;
                      Selector  : in Device_Selector_Type;
                      Context   : in out Context_Type);

   --  Execute a status command to report information about the Bbox.
   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type);

end Druss.Commands.Devices;

-----------------------------------------------------------------------
--  druss-commands-devices -- Print information about the devices
--  Copyright (C) 2017, 2018, 2019 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.
-----------------------------------------------------------------------

package Druss.Commands.Devices is

   type Command_Type is new Druss.Commands.Drivers.Command_Type with null record;

   procedure Do_List (Command   : in Command_Type;
                      Args      : in Argument_List'Class;
                      Selector  : in Device_Selector_Type;
                      Context   : in out Context_Type);

   --  Execute a status command to report information about the Bbox.
   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in out Command_Type;
                   Context   : in out Context_Type);

end Druss.Commands.Devices;

Change Help command to accept in out command