-----------------------------------------------------------------------
--  asf-components-widgets-inputs -- Input widget components
--  Copyright (C) 2013 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.Characters.Conversions;

with ASF.Models.Selects;
with ASF.Components.Base;
with ASF.Components.Utils;
with ASF.Components.Html.Messages;
with ASF.Events.Faces.Actions;
with ASF.Applications.Messages.Vectors;

with Util.Strings.Transforms;
with Util.Beans.Objects;
package body ASF.Components.Widgets.Inputs is

   --  ------------------------------
   --  Render the input field title.
   --  ------------------------------
   procedure Render_Title (UI      : in UIInput;
                           Name    : in String;
                           Writer  : in Response_Writer_Access;
                           Context : in out Faces_Context'Class) is
      Title : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, "title");
   begin
      Writer.Start_Element ("dt");
      Writer.Start_Element ("label");
      Writer.Write_Attribute ("for", Name);
      Writer.Write_Text (Title);
      Writer.End_Element ("label");
      Writer.End_Element ("dt");
   end Render_Title;

   --  ------------------------------
   --  Render the input component.  Starts the DL/DD list and write the input
   --  component with the possible associated error message.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIInput;
                           Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Messages : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
         Style    : constant String := UI.Get_Attribute ("styleClass", Context);
      begin
         Writer.Start_Element ("dl");
         Writer.Write_Attribute ("id", Id);
         if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
            Writer.Write_Attribute ("class", Style & " asf-error");
         elsif Style'Length > 0 then
            Writer.Write_Attribute ("class", Style);
         end if;
         UI.Render_Title (Id, Writer, Context);
         Writer.Start_Element ("dd");
         UI.Render_Input (Context, Write_Id => False);
      end;
   end Encode_Begin;

   --  ------------------------------
   --  Render the end of the input component.  Closes the DL/DD list.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIInput;
                         Context : in out Faces_Context'Class) is
      use ASF.Components.Html.Messages;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      --  Render the error message associated with the input field.
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Messages : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
      begin
         if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
            Write_Message (UI, ASF.Applications.Messages.Vectors.Element (Messages),
                           SPAN_NO_STYLE, False, True, Context);
         end if;
         Writer.End_Element ("dd");
         Writer.End_Element ("dl");
      end;
   end Encode_End;

   --  ------------------------------
   --  Render the end of the input component.  Closes the DL/DD list.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIComplete;
                         Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      --  Render the autocomplete script and finish the input component.
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
      begin
         Writer.Queue_Script ("$('#");
         Writer.Queue_Script (Id);
         Writer.Queue_Script (" input').complete({");
         Writer.Queue_Script ("});");
         UIInput (UI).Encode_End (Context);
      end;
   end Encode_End;

   overriding
   procedure Process_Decodes (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Id  : constant String := To_String (UI.Get_Client_Id);
         Val : constant String := Context.Get_Parameter (Id & ".match");
      begin
         if Val'Length > 0 then
            UI.Match_Value := Util.Beans.Objects.To_Object (Val);
         else
            ASF.Components.Html.Forms.UIInput (UI).Process_Decodes (Context);
         end if;
      end;
   end Process_Decodes;

   procedure Render_List (UI      : in UIComplete;
                          Match   : in String;
                          Context : in out Faces_Context'Class) is
      use type Util.Beans.Basic.List_Bean_Access;

      List       : constant Util.Beans.Basic.List_Bean_Access
        := ASF.Components.Utils.Get_List_Bean (UI, "autocompleteList", Context);
      Writer     : constant Response_Writer_Access := Context.Get_Response_Writer;
      Need_Comma : Boolean := False;
      Count      : Natural;

      procedure Render_Item (Label : in String) is
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         if Match'Length = 0 or else
           (Match'Length <= Label'Length
            and then Match = Label (Label'First .. Label'First + Match'Length - 1)) then
            if Need_Comma then
               Writer.Write (",");
            end if;
            Writer.Write ('"');
            Util.Strings.Transforms.Escape_Java (Content => Label,
                                                 Into    => Result);
            Writer.Write (Result);
            Writer.Write ('"');
            Need_Comma := True;
         end if;
      end Render_Item;

   begin
      Writer.Write ('[');
      if List /= null then
         Count := List.Get_Count;
         if List.all in ASF.Models.Selects.Select_Item_List'Class then
            declare
               S : constant access ASF.Models.Selects.Select_Item_List'Class
                 := ASF.Models.Selects.Select_Item_List'Class (List.all)'Access;
            begin
               for I in 1 .. Count loop
                  Render_Item (Ada.Characters.Conversions.To_String (S.Get_Select_Item (I).Get_Label));
               end loop;
            end;
         else
            for I in 1 .. Count loop
               List.Set_Row_Index (I);
               declare
                  Value : constant Util.Beans.Objects.Object := List.Get_Row;
                  Label : constant String := Util.Beans.Objects.To_String (Value);
               begin
                  Render_Item (Label);
               end;
            end loop;
         end if;
      end if;
      Writer.Write (']');
   end Render_List;

   overriding
   procedure Process_Updates (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class) is
   begin
      if not Util.Beans.Objects.Is_Empty (UI.Match_Value) then
         declare
            Value : constant access ASF.Views.Nodes.Tag_Attribute := UI.Get_Attribute ("match");
            ME    : EL.Expressions.Method_Expression;
         begin
            if Value /= null then
               declare
                  VE    : constant EL.Expressions.Value_Expression
                    := ASF.Views.Nodes.Get_Value_Expression (Value.all);
               begin
                  VE.Set_Value (Value => UI.Match_Value, Context => Context.Get_ELContext.all);
               end;
            end if;

            --  Post an event on this component to trigger the rendering of the completion
            --  list as part of an application/json output.  The rendering is made by Broadcast.
            ASF.Events.Faces.Actions.Post_Event (UI     => UI,
                                                 Method => ME);
         end;
      else
         ASF.Components.Html.Forms.UIInput (UI).Process_Updates (Context);
      end if;

--     exception
--        when E : others =>
--           UI.Is_Valid := False;
--           UI.Add_Message (CONVERTER_MESSAGE_NAME, "convert", Context);
--           Log.Info (Utils.Get_Line_Info (UI)
--                     & ": Exception raised when updating value {0} for component {1}: {2}",
--                     EL.Objects.To_String (UI.Submitted_Value),
--                     To_String (UI.Get_Client_Id), Ada.Exceptions.Exception_Name (E));
   end Process_Updates;

   --  ------------------------------
   --  Broadcast the event to the event listeners installed on this component.
   --  Listeners are called in the order in which they were added.
   --  ------------------------------
   overriding
   procedure Broadcast (UI      : in out UIComplete;
                        Event   : not null access ASF.Events.Faces.Faces_Event'Class;
                        Context : in out Faces_Context'Class) is
      pragma Unreferenced (Event);

      Match  : constant String := Util.Beans.Objects.To_String (UI.Match_Value);
   begin
      Context.Get_Response.Set_Content_Type ("application/json; charset=UTF-8");
      UI.Render_List (Match, Context);
      Context.Response_Completed;
   end Broadcast;

end ASF.Components.Widgets.Inputs;

-----------------------------------------------------------------------
--  asf-components-widgets-inputs -- Input widget components
--  Copyright (C) 2013 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.Characters.Conversions;

with ASF.Models.Selects;
with ASF.Components.Utils;
with ASF.Components.Html.Messages;
with ASF.Events.Faces.Actions;
with ASF.Applications.Messages.Vectors;

with Util.Beans.Basic;
with Util.Strings.Transforms;
package body ASF.Components.Widgets.Inputs is

   --  ------------------------------
   --  Render the input field title.
   --  ------------------------------
   procedure Render_Title (UI      : in UIInput;
                           Name    : in String;
                           Writer  : in Response_Writer_Access;
                           Context : in out Faces_Context'Class) is
      Title : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, "title");
   begin
      Writer.Start_Element ("dt");
      Writer.Start_Element ("label");
      Writer.Write_Attribute ("for", Name);
      Writer.Write_Text (Title);
      Writer.End_Element ("label");
      Writer.End_Element ("dt");
   end Render_Title;

   --  ------------------------------
   --  Render the input component.  Starts the DL/DD list and write the input
   --  component with the possible associated error message.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIInput;
                           Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Messages : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
         Style    : constant String := UI.Get_Attribute ("styleClass", Context);
      begin
         Writer.Start_Element ("dl");
         Writer.Write_Attribute ("id", Id);
         if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
            Writer.Write_Attribute ("class", Style & " asf-error");
         elsif Style'Length > 0 then
            Writer.Write_Attribute ("class", Style);
         end if;
         UI.Render_Title (Id, Writer, Context);
         Writer.Start_Element ("dd");
         UI.Render_Input (Context, Write_Id => False);
      end;
   end Encode_Begin;

   --  ------------------------------
   --  Render the end of the input component.  Closes the DL/DD list.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIInput;
                         Context : in out Faces_Context'Class) is
      use ASF.Components.Html.Messages;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      --  Render the error message associated with the input field.
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Messages : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
      begin
         if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
            Write_Message (UI, ASF.Applications.Messages.Vectors.Element (Messages),
                           SPAN_NO_STYLE, False, True, Context);
         end if;
         Writer.End_Element ("dd");
         Writer.End_Element ("dl");
      end;
   end Encode_End;

   --  ------------------------------
   --  Render the end of the input component.  Closes the DL/DD list.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIComplete;
                         Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      --  Render the autocomplete script and finish the input component.
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
      begin
         Writer.Queue_Script ("$('#");
         Writer.Queue_Script (Id);
         Writer.Queue_Script (" input').complete({");
         Writer.Queue_Script ("});");
         UIInput (UI).Encode_End (Context);
      end;
   end Encode_End;

   overriding
   procedure Process_Decodes (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Id  : constant String := To_String (UI.Get_Client_Id);
         Val : constant String := Context.Get_Parameter (Id & ".match");
      begin
         if Val'Length > 0 then
            UI.Match_Value := Util.Beans.Objects.To_Object (Val);
         else
            ASF.Components.Html.Forms.UIInput (UI).Process_Decodes (Context);
         end if;
      end;
   end Process_Decodes;

   procedure Render_List (UI      : in UIComplete;
                          Match   : in String;
                          Context : in out Faces_Context'Class) is
      use type Util.Beans.Basic.List_Bean_Access;

      procedure Render_Item (Label : in String);

      List       : constant Util.Beans.Basic.List_Bean_Access
        := ASF.Components.Utils.Get_List_Bean (UI, "autocompleteList", Context);
      Writer     : constant Response_Writer_Access := Context.Get_Response_Writer;
      Need_Comma : Boolean := False;
      Count      : Natural;

      procedure Render_Item (Label : in String) is
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         if Match'Length = 0 or else
           (Match'Length <= Label'Length
            and then Match = Label (Label'First .. Label'First + Match'Length - 1)) then
            if Need_Comma then
               Writer.Write (",");
            end if;
            Writer.Write ('"');
            Util.Strings.Transforms.Escape_Java (Content => Label,
                                                 Into    => Result);
            Writer.Write (Result);
            Writer.Write ('"');
            Need_Comma := True;
         end if;
      end Render_Item;

   begin
      Writer.Write ('[');
      if List /= null then
         Count := List.Get_Count;
         if List.all in ASF.Models.Selects.Select_Item_List'Class then
            declare
               S : constant access ASF.Models.Selects.Select_Item_List'Class
                 := ASF.Models.Selects.Select_Item_List'Class (List.all)'Access;
            begin
               for I in 1 .. Count loop
                  Render_Item (Ada.Characters.Conversions.To_String (S.Get_Select_Item (I).Get_Label));
               end loop;
            end;
         else
            for I in 1 .. Count loop
               List.Set_Row_Index (I);
               declare
                  Value : constant Util.Beans.Objects.Object := List.Get_Row;
                  Label : constant String := Util.Beans.Objects.To_String (Value);
               begin
                  Render_Item (Label);
               end;
            end loop;
         end if;
      end if;
      Writer.Write (']');
   end Render_List;

   overriding
   procedure Process_Updates (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class) is
   begin
      if not Util.Beans.Objects.Is_Empty (UI.Match_Value) then
         declare
            Value : constant access ASF.Views.Nodes.Tag_Attribute := UI.Get_Attribute ("match");
            ME    : EL.Expressions.Method_Expression;
         begin
            if Value /= null then
               declare
                  VE    : constant EL.Expressions.Value_Expression
                    := ASF.Views.Nodes.Get_Value_Expression (Value.all);
               begin
                  VE.Set_Value (Value => UI.Match_Value, Context => Context.Get_ELContext.all);
               end;
            end if;

            --  Post an event on this component to trigger the rendering of the completion
            --  list as part of an application/json output.  The rendering is made by Broadcast.
            ASF.Events.Faces.Actions.Post_Event (UI     => UI,
                                                 Method => ME);
         end;
      else
         ASF.Components.Html.Forms.UIInput (UI).Process_Updates (Context);
      end if;

--     exception
--        when E : others =>
--           UI.Is_Valid := False;
--           UI.Add_Message (CONVERTER_MESSAGE_NAME, "convert", Context);
--           Log.Info (Utils.Get_Line_Info (UI)
--                     & ": Exception raised when updating value {0} for component {1}: {2}",
--                     EL.Objects.To_String (UI.Submitted_Value),
--                     To_String (UI.Get_Client_Id), Ada.Exceptions.Exception_Name (E));
   end Process_Updates;

   --  ------------------------------
   --  Broadcast the event to the event listeners installed on this component.
   --  Listeners are called in the order in which they were added.
   --  ------------------------------
   overriding
   procedure Broadcast (UI      : in out UIComplete;
                        Event   : not null access ASF.Events.Faces.Faces_Event'Class;
                        Context : in out Faces_Context'Class) is
      pragma Unreferenced (Event);

      Match  : constant String := Util.Beans.Objects.To_String (UI.Match_Value);
   begin
      Context.Get_Response.Set_Content_Type ("application/json; charset=UTF-8");
      UI.Render_List (Match, Context);
      Context.Response_Completed;
   end Broadcast;

   --  ------------------------------
   --  Render the end of the input date component.
   --  Generate the javascript code to activate the input date selector
   --  and closes the DL/DD list.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIInputDate;
                         Context : in out Faces_Context'Class) is
      use ASF.Components.Html.Messages;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      --  Render the input date script and finish the input component.
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Format   : constant String := UI.Get_Attribute ("dateFormat", Context);
      begin
         Writer.Queue_Script ("$('#");
         Writer.Queue_Script (Id);
         Writer.Queue_Script (" input').datepicker({");
         if Format'Length > 0 then
            Writer.Queue_Script ("dateFormat: """);
            Writer.Queue_Script (Format);
            Writer.Queue_Script ("""");
         end if;
         Writer.Queue_Script ("});");
         UIInput (UI).Encode_End (Context);
      end;
   end Encode_End;

end ASF.Components.Widgets.Inputs;

Implement the inputDate component. Render the input field and write the javascript code to activate the jQuery date picker.


-----------------------------------------------------------------------
--  security-controllers -- Controllers to verify a security permission
--  Copyright (C) 2011, 2012 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 Security.Contexts;
with Security.Permissions;

--  == Security Controller ==
--  The Security.Controllers package defines the security controller used to
--  verify that a given permission is granted.  A security controller uses the security
--  context and other controller specific and internal data to verify that the permission
--  is granted.
--
--  To implement a new security controller, one must:
--
--    * Define a type that implements the Controller interface with the
--      Has_Permission operation
--    * Write a function to allocate instances of the given Controller type
--    * Register the function under a unique name by using Register_Controller
--
--  Security controller instances are created when the security policy rules are parsed.
--  These instances are shared across possibly several concurrent requests.
package Security.Controllers is

   Invalid_Controller : exception;

   --  ------------------------------
   --  Security Controller interface
   --  ------------------------------
   type Controller is limited interface;
   type Controller_Access is access all Controller'Class;

   --  Checks whether the permission defined by the Handler controller data is granted
   --  by the security context passed in Context.
   --  Returns true if such permission is granted.
   function Has_Permission (Handler : in Controller;
                            Context : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is abstract;

   type Controller_Factory is not null access function return Controller_Access;

   --  To keep this implementation simple, a maximum of 32 security controller factory
   --  can be registered.  ASF provides one based on roles.  AWA provides another one
   --  based on entity ACLs.
   MAX_CONTROLLER_FACTORY : constant Positive := 32;

   --  Register in a global table the controller factory under the name Name.
   --  When this factory is used, the Factory operation will be called to
   --  create new instances of the controller.
   procedure Register_Controller (Name    : in String;
                                  Factory : in Controller_Factory);

   --  Create a security controller by using the controller factory registered under
   --  the name Name.
   --  Raises Invalid_Controller if the name is not recognized.
   function Create_Controller (Name : in String) return Controller_Access;

end Security.Controllers;

-----------------------------------------------------------------------
--  security-controllers -- Controllers to verify a security permission
--  Copyright (C) 2011, 2012 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 Security.Contexts;
with Security.Permissions;

--  == Security Controller ==
--  The Security.Controllers package defines the security controller used to
--  verify that a given permission is granted.  A security controller uses the security
--  context and other controller specific and internal data to verify that the permission
--  is granted.
--
--  To implement a new security controller, one must:
--
--    * Define a type that implements the Controller interface with the
--      Has_Permission operation
--    * Write a function to allocate instances of the given Controller type
--    * Register the function under a unique name by using Register_Controller
--
--  Security controller instances are created when the security policy rules are parsed.
--  These instances are shared across possibly several concurrent requests.
package Security.Controllers is

   Invalid_Controller : exception;

   --  ------------------------------
   --  Security Controller interface
   --  ------------------------------
   type Controller is limited interface;
   type Controller_Access is access all Controller'Class;

   --  Checks whether the permission defined by the Handler controller data is granted
   --  by the security context passed in Context.
   --  Returns true if such permission is granted.
   function Has_Permission (Handler : in Controller;
                            Context : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is abstract;

end Security.Controllers;

Remove the Controller_Factory which is not used


-----------------------------------------------------------------------
--  ado-configs -- Database connection configuration
--  Copyright (C) 2010, 2011, 2012, 2016, 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 Ada.Finalization;

with Util.Properties;

package ADO.Configs is

   --  Configuration property to control the search paths to load XML queries.
   QUERY_PATHS_CONFIG : constant String := "ado.queries.paths";

   --  Configuration property to control whether all the program XML queries must be
   --  loaded when the database configuration is setup.
   QUERY_LOAD_CONFIG  : constant String := "ado.queries.load";

   --  Configuration property to enable or disable the dynamic load of database driver.
   DYNAMIC_DRIVER_LOAD : constant String := "ado.drivers.load";

   --  Configuration property to skip reading the database table entities.
   NO_ENTITY_LOAD : constant String := "ado.entities.ignore";

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  ------------------------------
   --  The database configuration properties
   --  ------------------------------
   type Configuration is new Ada.Finalization.Controlled with private;
   type Configuration_Access is access all Configuration'Class;

   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   procedure Set_Connection (Config : in out Configuration;
                             URI    : in String);

   --  Get the connection URI that describes the database connection string.
   --  The returned string may contain connection authentication information.
   function Get_URI (Config : in Configuration) return String;

   --  Get the connection URI that describes the database connection string
   --  but the connection authentication is replaced by XXXX.
   function Get_Log_URI (Config : in Configuration) return String;

   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   procedure Set_Property (Config : in out Configuration;
                           Name   : in String;
                           Value  : in String);

   --  Get a property from the data source configuration.
   --  If the property does not exist, an empty string is returned.
   function Get_Property (Config : in Configuration;
                          Name   : in String) return String;

   --  Returns true if the configuration property is set to true/on.
   function Is_On (Config : in Configuration;
                   Name   : in String) return Boolean;

   --  Set the server hostname.
   procedure Set_Server (Config : in out Configuration;
                         Server : in String);

   --  Get the server hostname.
   function Get_Server (Config : in Configuration) return String;

   --  Set the server port.
   procedure Set_Port (Config : in out Configuration;
                       Port   : in Natural);

   --  Get the server port.
   function Get_Port (Config : in Configuration) return Natural;

   --  Set the database name.
   procedure Set_Database (Config   : in out Configuration;
                           Database : in String);

   --  Get the database name.
   function Get_Database (Config : in Configuration) return String;

   --  Get the database driver name.
   function Get_Driver (Config : in Configuration) return String;

   --  Iterate over the configuration properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Config  : in Configuration;
                      Process : access procedure (Name : in String;
                                                  Item : in Util.Properties.Value));

private

   use Ada.Strings.Unbounded;

   type Configuration is new Ada.Finalization.Controlled with record
      URI        : Unbounded_String;
      Log_URI    : Unbounded_String;
      Driver     : Unbounded_String;
      Server     : Unbounded_String;
      Port       : Natural := 0;
      Database   : Unbounded_String;
      Properties : Util.Properties.Manager;
   end record;

end ADO.Configs;

-----------------------------------------------------------------------
--  ado-configs -- Database connection configuration
--  Copyright (C) 2010, 2011, 2012, 2016, 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 Ada.Finalization;

with Util.Properties;

package ADO.Configs is

   --  Configuration property to control the search paths to load XML queries.
   QUERY_PATHS_CONFIG : constant String := "ado.queries.paths";

   --  Configuration property to control whether all the program XML queries must be
   --  loaded when the database configuration is setup.
   QUERY_LOAD_CONFIG  : constant String := "ado.queries.load";

   --  Configuration property to enable or disable the dynamic load of database driver.
   DYNAMIC_DRIVER_LOAD : constant String := "ado.drivers.load";

   --  Configuration property to skip reading the database table entities.
   NO_ENTITY_LOAD : constant String := "ado.entities.ignore";

   --  Maximum number of columns allowed for a table (SQLite limit is 2000).
   MAX_COLUMNS : constant := 2000;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  ------------------------------
   --  The database configuration properties
   --  ------------------------------
   type Configuration is new Ada.Finalization.Controlled with private;
   type Configuration_Access is access all Configuration'Class;

   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   procedure Set_Connection (Config : in out Configuration;
                             URI    : in String);

   --  Get the connection URI that describes the database connection string.
   --  The returned string may contain connection authentication information.
   function Get_URI (Config : in Configuration) return String;

   --  Get the connection URI that describes the database connection string
   --  but the connection authentication is replaced by XXXX.
   function Get_Log_URI (Config : in Configuration) return String;

   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   procedure Set_Property (Config : in out Configuration;
                           Name   : in String;
                           Value  : in String);

   --  Get a property from the data source configuration.
   --  If the property does not exist, an empty string is returned.
   function Get_Property (Config : in Configuration;
                          Name   : in String) return String;

   --  Returns true if the configuration property is set to true/on.
   function Is_On (Config : in Configuration;
                   Name   : in String) return Boolean;

   --  Set the server hostname.
   procedure Set_Server (Config : in out Configuration;
                         Server : in String);

   --  Get the server hostname.
   function Get_Server (Config : in Configuration) return String;

   --  Set the server port.
   procedure Set_Port (Config : in out Configuration;
                       Port   : in Natural);

   --  Get the server port.
   function Get_Port (Config : in Configuration) return Natural;

   --  Set the database name.
   procedure Set_Database (Config   : in out Configuration;
                           Database : in String);

   --  Get the database name.
   function Get_Database (Config : in Configuration) return String;

   --  Get the database driver name.
   function Get_Driver (Config : in Configuration) return String;

   --  Iterate over the configuration properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Config  : in Configuration;
                      Process : access procedure (Name : in String;
                                                  Item : in Util.Properties.Value));

private

   use Ada.Strings.Unbounded;

   type Configuration is new Ada.Finalization.Controlled with record
      URI        : Unbounded_String;
      Log_URI    : Unbounded_String;
      Driver     : Unbounded_String;
      Server     : Unbounded_String;
      Port       : Natural := 0;
      Database   : Unbounded_String;
      Properties : Util.Properties.Manager;
   end record;

end ADO.Configs;

Declare MAX_COLUMNS constant, use SQLite limit, 2000


-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 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 Util.Strings;
with Util.Refs;
with ADO.SQL;
with ADO.Drivers;

with Interfaces;
with Ada.Strings.Unbounded;
package ADO.Queries is

   type Query_File;
   type Query_File_Access is access all Query_File;

   type Query_Definition;
   type Query_Definition_Access is access all Query_Definition;

   type Query_Info is limited private;
   type Query_Info_Access is access all Query_Info;

   type Query_Info_Ref_Access is private;

   Null_Query_Info_Ref : constant Query_Info_Ref_Access;

   --  ------------------------------
   --  Query Context
   --  ------------------------------
   --  The Context type holds the necessary information to build and execute
   --  a query whose SQL pattern is defined in an XML query file.
   type Context is new ADO.SQL.Query with private;

   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access);

   --  Set the query count definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access);

   --  Set the query to execute as SQL statement.
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String);

   procedure Set_Query (Into  : in out Context;
                        Name  : in String);

   --  Set the limit for the SQL query.
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural);

   --  Get the first row index.
   function Get_First_Row_Index (From : in Context) return Natural;

   --  Get the last row index.
   function Get_Last_Row_Index (From : in Context) return Natural;

   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the sql-count query.
   function Get_Max_Row_Count (From : in Context) return Natural;

   --  Get the SQL query that correspond to the query context.
   function Get_SQL (From   : in Context;
                     Driver : in ADO.Drivers.Driver_Index) return String;

   --  ------------------------------
   --  Query Definition
   --  ------------------------------
   --  The Query_Definition holds the SQL query pattern which is defined
   --  in an XML query file.  The query is identified by a name and a given XML
   --  query file can contain several queries.  The Dynamo generator generates
   --  one instance of Query_Definition for each query defined in the XML
   --  file.  The XML file is loaded during application initialization (or later)
   --  to get the SQL query pattern.  Multi-thread concurrency is achieved by
   --  the Query_Info_Ref atomic reference.
   type Query_Definition is limited record
      --  The query name.
      Name   : Util.Strings.Name_Access;

      --  The query file in which the query is defined.
      File   : Query_File_Access;

      --  The next query defined in the query file.
      Next   : Query_Definition_Access;

      --  The SQL query pattern (initialized when reading the XML query file).
      Query  : Query_Info_Ref_Access;
   end record;

   function Get_SQL (From      : in Query_Definition_Access;
                     Driver    : in ADO.Drivers.Driver_Index;
                     Use_Count : in Boolean) return String;

   --  ------------------------------
   --  Query File
   --  ------------------------------
   --  The Query_File describes the SQL queries associated and loaded from
   --  a given XML query file.  The Dynamo generator generates one instance of
   --  Query_File for each XML query file that it has read.  The Path,
   --  Sha1_Map, Queries and Next are initialized statically by the generator (during
   --  package elaboration).
   type Query_File is limited record
      --  Query relative path name
      Name          : Util.Strings.Name_Access;

      --  Query absolute path name (after path resolution).
      Path          : Ada.Strings.Unbounded.String_Access;

      --  The SHA1 hash of the query map section.
      Sha1_Map      : Util.Strings.Name_Access;

      --  Stamp when the query file will be checked.
      Next_Check    : Interfaces.Unsigned_32;

      --  Stamp identifying the modification date of the query file.
      Last_Modified : Interfaces.Unsigned_32;

      --  The first query defined for that file.
      Queries       : Query_Definition_Access;

      --  The next XML query file registered in the application.
      Next          : Query_File_Access;
   end record;

private

   type Context is new ADO.SQL.Query with record
      First      : Natural := 0;
      Last       : Natural := 0;
      Last_Index : Natural := 0;
      Max_Row_Count : Natural := 0;
      Query_Def  : Query_Definition_Access := null;
      Is_Count   : Boolean := False;
   end record;

   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   function Find_Query (File : in Query_File;
                        Name : in String) return Query_Definition_Access;

   use Ada.Strings.Unbounded;

   --  SQL query pattern
   type Query_Pattern is limited record
      SQL : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Query_Pattern_Array is array (ADO.Drivers.Driver_Index) of Query_Pattern;

   type Query_Info is new Util.Refs.Ref_Entity with record
      Main_Query  : Query_Pattern_Array;
      Count_Query : Query_Pattern_Array;
   end record;

   package Query_Info_Ref is
      new Util.Refs.References (Query_Info, Query_Info_Access);

   type Query_Info_Ref_Access is access all Query_Info_Ref.Atomic_Ref;

   Null_Query_Info_Ref : constant Query_Info_Ref_Access := null;

end ADO.Queries;

-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 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 Util.Strings;
with Util.Refs;
with ADO.SQL;
with ADO.Drivers;

with Interfaces;
with Ada.Strings.Unbounded;

--  == Introduction ==
--  Ada Database Objects provides a small framework which helps in
--  using complex SQL queries in an application.
--  The benefit of the framework are the following:
--
--    * The SQL query result are directly mapped in Ada records,
--    * It is easy to change or tune an SQL query without re-building the application,
--    * The SQL query can be easily tuned for a given database
--
--  The database query framework uses an XML query file:
--
--    * The XML query file defines a mapping that represents the result of SQL queries,
--    * The XML mapping is used by [http://code.google.com/p/ada-gen Dynamo] to generate an Ada record,
--    * The XML query file also defines a set of SQL queries, each query being identified by a unique name,
--    * The XML query file is read by the application to obtain the SQL query associated with a query name,
--    * The application uses the `List` procedure generated by [http://code.google.com/p/ada-gen Dynamo].
--
--  == XML Query File and Mapping ==
--  === XML Query File ===
--  The XML query file uses the `query-mapping` root element.  It should
--  define at most one `class` mapping and several `query` definitions.
--  The `class` definition should come first before any `query` definition.
--
--    <query-mapping>
--       <class>...</class>
--       <query>...</query>
--    </query-mapping>
--
--  == SQL Result Mapping ==
--  The XML query mapping is very close to the database table mapping.
--  The difference is that there is no need to specify and table name
--  nor any SQL type.  The XML query mapping is used to build an Ada
--  record that correspond to query results.  Unlike the database table mapping,
--  the Ada record will not be tagged and its definition will expose all the record
--  members directly.
--
--  The following XML query mapping:
--
--    <query-mapping>
--      <class name='Samples.Model.User_Info'>
--        <property name="name" type="String">
--           <comment>the user name</comment>
--        </property>
--        <property name="email" type="String">
--           <comment>the email address</comment>
--        </property>
--      </class>
--    </query-mapping>
--
--  will generate the following Ada record:
--
--    package Samples.Model is
--       type User_Info is record
--         Name  : Unbounded_String;
--         Email : Unbounded_String;
--       end record;
--    end Samples.Model;
--
--  The same query mapping can be used by different queries.
--
--  === SQL Queries ===
--  The XML query file defines a list of SQL queries that the application
--  can use.  Each query is associated with a unique name.  The application
--  will use that name to identify the SQL query to execute.  For each query,
--  the file also describes the SQL query pattern that must be used for
--  the query execution.
--
--    <query name='xxx' class='Samples.Model.User_Info'>
--       <sql driver='mysql'>
--         select u.name, u.email from user
--       </sql>
--       <sql driver='sqlite'>
--          ...
--       </sql>
--       <sql-count driver='mysql'>
--          select count(*) from user u
--       </sql-count>
--    </query>
--
--  The query contains basically two SQL patterns.  The `sql` element represents
--  the main SQL pattern.  This is the SQL that is used by the `List` operation.
--  In some cases, the result set returned by the query is limited to return only
--  a maximum number of rows.  This is often use in paginated lists.
--
--  The `sql-count` element represents an SQL query to indicate the total number
--  of elements if the SQL query was not limited.
package ADO.Queries is

   type Query_File;
   type Query_File_Access is access all Query_File;

   type Query_Definition;
   type Query_Definition_Access is access all Query_Definition;

   type Query_Info is limited private;
   type Query_Info_Access is access all Query_Info;

   type Query_Info_Ref_Access is private;

   Null_Query_Info_Ref : constant Query_Info_Ref_Access;

   --  ------------------------------
   --  Query Context
   --  ------------------------------
   --  The Context type holds the necessary information to build and execute
   --  a query whose SQL pattern is defined in an XML query file.
   type Context is new ADO.SQL.Query with private;

   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access);

   --  Set the query count definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access);

   --  Set the query to execute as SQL statement.
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String);

   procedure Set_Query (Into  : in out Context;
                        Name  : in String);

   --  Set the limit for the SQL query.
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural);

   --  Get the first row index.
   function Get_First_Row_Index (From : in Context) return Natural;

   --  Get the last row index.
   function Get_Last_Row_Index (From : in Context) return Natural;

   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the sql-count query.
   function Get_Max_Row_Count (From : in Context) return Natural;

   --  Get the SQL query that correspond to the query context.
   function Get_SQL (From   : in Context;
                     Driver : in ADO.Drivers.Driver_Index) return String;

   --  ------------------------------
   --  Query Definition
   --  ------------------------------
   --  The Query_Definition holds the SQL query pattern which is defined
   --  in an XML query file.  The query is identified by a name and a given XML
   --  query file can contain several queries.  The Dynamo generator generates
   --  one instance of Query_Definition for each query defined in the XML
   --  file.  The XML file is loaded during application initialization (or later)
   --  to get the SQL query pattern.  Multi-thread concurrency is achieved by
   --  the Query_Info_Ref atomic reference.
   type Query_Definition is limited record
      --  The query name.
      Name   : Util.Strings.Name_Access;

      --  The query file in which the query is defined.
      File   : Query_File_Access;

      --  The next query defined in the query file.
      Next   : Query_Definition_Access;

      --  The SQL query pattern (initialized when reading the XML query file).
      Query  : Query_Info_Ref_Access;
   end record;

   function Get_SQL (From      : in Query_Definition_Access;
                     Driver    : in ADO.Drivers.Driver_Index;
                     Use_Count : in Boolean) return String;

   --  ------------------------------
   --  Query File
   --  ------------------------------
   --  The Query_File describes the SQL queries associated and loaded from
   --  a given XML query file.  The Dynamo generator generates one instance of
   --  Query_File for each XML query file that it has read.  The Path,
   --  Sha1_Map, Queries and Next are initialized statically by the generator (during
   --  package elaboration).
   type Query_File is limited record
      --  Query relative path name
      Name          : Util.Strings.Name_Access;

      --  Query absolute path name (after path resolution).
      Path          : Ada.Strings.Unbounded.String_Access;

      --  The SHA1 hash of the query map section.
      Sha1_Map      : Util.Strings.Name_Access;

      --  Stamp when the query file will be checked.
      Next_Check    : Interfaces.Unsigned_32;

      --  Stamp identifying the modification date of the query file.
      Last_Modified : Interfaces.Unsigned_32;

      --  The first query defined for that file.
      Queries       : Query_Definition_Access;

      --  The next XML query file registered in the application.
      Next          : Query_File_Access;
   end record;

private

   type Context is new ADO.SQL.Query with record
      First      : Natural := 0;
      Last       : Natural := 0;
      Last_Index : Natural := 0;
      Max_Row_Count : Natural := 0;
      Query_Def  : Query_Definition_Access := null;
      Is_Count   : Boolean := False;
   end record;

   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   function Find_Query (File : in Query_File;
                        Name : in String) return Query_Definition_Access;

   use Ada.Strings.Unbounded;

   --  SQL query pattern
   type Query_Pattern is limited record
      SQL : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Query_Pattern_Array is array (ADO.Drivers.Driver_Index) of Query_Pattern;

   type Query_Info is new Util.Refs.Ref_Entity with record
      Main_Query  : Query_Pattern_Array;
      Count_Query : Query_Pattern_Array;
   end record;

   package Query_Info_Ref is
      new Util.Refs.References (Query_Info, Query_Info_Access);

   type Query_Info_Ref_Access is access all Query_Info_Ref.Atomic_Ref;

   Null_Query_Info_Ref : constant Query_Info_Ref_Access := null;

end ADO.Queries;

Add some documentation

Add some documentation


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: License.txt

with Ada.Command_Line;
with Ada.Text_IO;
with Parameters;
with Pilot;
with Unix;

procedure Ravenadm is

   package CLI renames Ada.Command_Line;
   package TIO renames Ada.Text_IO;

   type mandate_type is (unset, help, dev, build, force, test, status, configure, locate);
   type dev_mandate  is (unset, dump, makefile, distinfo, buildsheet, template);

   procedure scan_first_command_word;
   function scan_dev_command_word return dev_mandate;
   function get_arg (arg_number : Positive) return String;

   mandate : mandate_type := unset;

   procedure scan_first_command_word
   is
      first  : constant String := CLI.Argument (1);
   begin
      if first = "help" then
         mandate := help;
      elsif first = "dev" then
         mandate := dev;
      elsif first = "build" then
         mandate := build;
      elsif first = "force" then
         mandate := force;
      elsif first = "test" then
         mandate := test;
      elsif first = "status" then
         mandate := status;
      elsif first = "configure" then
         mandate := configure;
      elsif first = "locate" then
         mandate := locate;
      end if;
   end scan_first_command_word;

   function scan_dev_command_word return dev_mandate
   is
      --  Check argument count before calling
      second : constant String := CLI.Argument (2);
   begin
      if second = "dump" then
         return dump;
      elsif second = "makefile" then
         return makefile;
      elsif second = "distinfo" then
         return distinfo;
      elsif second = "buildsheet" then
         return buildsheet;
      elsif second = "template" then
         return template;
      else
         return unset;
      end if;
   end scan_dev_command_word;

   function get_arg (arg_number : Positive) return String is
   begin
      if CLI.Argument_Count >= arg_number then
         return CLI.Argument (arg_number);
      else
         return "";
      end if;
   end get_arg;

begin

   if CLI.Argument_Count = 0 then
      Pilot.display_usage;
      return;
   end if;

   scan_first_command_word;

   if mandate = unset then
      Pilot.react_to_unknown_first_level_command (CLI.Argument (1));
      return;
   end if;

   --------------------------------------------------------------------------------------------
   --  Validation block start
   --------------------------------------------------------------------------------------------

   if Pilot.already_running then
      return;
   end if;

   if not Parameters.load_configuration then
      return;
   end if;

   case mandate is
      when build | test | status =>
         --  All commands involving replicant slaves
         if Pilot.launch_clash_detected then
            return;
         end if;
      when others => null;
   end case;

   case mandate is
      when build | test =>
         if Parameters.configuration.avec_ncurses and then
           not Pilot.TERM_defined_in_environment
         then
            return;
         end if;
      when others => null;
   end case;

   case mandate is
      when configure | help => null;
      when others =>
         if not Parameters.all_paths_valid then
            return;
         end if;
   end case;

   case mandate is
      when help => null;
      when others =>
         if Pilot.insufficient_privileges then
            return;
         end if;
   end case;

   if Pilot.previous_run_mounts_detected and then
     not Pilot.old_mounts_successfully_removed
   then
      return;
   end if;

   if Pilot.previous_realfs_work_detected and then
     not Pilot.old_realfs_work_successfully_removed
   then
      return;
   end if;

   if Pilot.ravenexec_missing then
      return;
   end if;

   case mandate is
      when build | force | test =>
         if not Pilot.store_origins (start_from => 2) then
            return;
         end if;
      when status =>
         if CLI.Argument_Count > 1 then
            if not Pilot.store_origins (start_from => 2) then
               return;
            end if;
         end if;
      when others => null;
   end case;

   case mandate is
      when build | force | test | status =>
         if not Pilot.slave_platform_determined then
            return;
         end if;
      when others => null;
   end case;

   Pilot.create_pidfile;
   Unix.ignore_background_tty;

   if mandate /= configure then
      Unix.cone_of_silence (deploy => True);
   end if;

   --------------------------------------------------------------------------------------------
   --  Validation block end
   --------------------------------------------------------------------------------------------

   case mandate is

      when status =>
         --------------------------------
         --  status command
         --------------------------------
         if CLI.Argument_Count > 1 then
            if Pilot.scan_stack_of_single_ports (always_build => False) and then
              Pilot.sanity_check_then_prefail (delete_first => False, dry_run => True)
            then
               Pilot.perform_bulk_run (testmode => False);
            end if;
         else
            null;  -- reserved for upgrade_system_everything maybe
         end if;

      when build =>
         --------------------------------
         --  build command
         --------------------------------
         if Pilot.scan_stack_of_single_ports (always_build => False) and then
           Pilot.sanity_check_then_prefail (delete_first => False, dry_run => False)
         then
            Pilot.perform_bulk_run (testmode => False);
         end if;

      when force =>
         --------------------------------
         --  force command
         --------------------------------
         if Pilot.scan_stack_of_single_ports (always_build => False) and then
           Pilot.sanity_check_then_prefail (delete_first => True, dry_run => False)
         then
            Pilot.perform_bulk_run (testmode => False);
         end if;

      when dev =>
         --------------------------------
         --  dev command
         --------------------------------
         if CLI.Argument_Count > 1 then
            declare
               dev_subcmd : dev_mandate := scan_dev_command_word;
            begin
               case dev_subcmd is
                  when unset =>
                     Pilot.react_to_unknown_second_level_command (CLI.Argument (1),
                                                                  CLI.Argument (2));
                  when dump =>
                     Pilot.dump_ravensource (get_arg (3));
                  when distinfo =>
                     Pilot.generate_distinfo;
                  when buildsheet =>
                     Pilot.generate_buildsheet (get_arg (3), get_arg (4));
                  when makefile =>
                     Pilot.generate_makefile (get_arg (3), get_arg (4));
                  when template =>
                     Pilot.print_spec_template (get_arg (3));
               end case;
            end;
         else
            Pilot.react_to_unknown_second_level_command (CLI.Argument (1), "");
         end if;

      when help =>
         --------------------------------
         --  help command
         --------------------------------
         null;  --  tbw

      when test =>
         --------------------------------
         --  test command
         --------------------------------
         if Pilot.scan_stack_of_single_ports (always_build => True) and then
           Pilot.sanity_check_then_prefail (delete_first => True, dry_run => False)
         then
            if Pilot.interact_with_single_builder then
               Pilot.bulk_run_then_interact_with_final_port;
            else
               Pilot.perform_bulk_run (testmode => True);
            end if;
         end if;

      when configure =>
         --------------------------------
         --  configure
         --------------------------------
         Pilot.launch_configure_menu;

      when locate =>
         --------------------------------
         --  locate
         --------------------------------
         Pilot.locate (get_arg (2));

      when unset => null;

   end case;

   Unix.cone_of_silence (deploy => False);
   Pilot.destroy_pidfile;

end Ravenadm;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: License.txt

with Ada.Command_Line;
with Ada.Text_IO;
with Parameters;
with Pilot;
with Unix;

procedure Ravenadm is

   package CLI renames Ada.Command_Line;
   package TIO renames Ada.Text_IO;

   type mandate_type is (unset, help, dev, build, force, test, status, configure, locate);
   type dev_mandate  is (unset, dump, makefile, distinfo, buildsheet, template);

   procedure scan_first_command_word;
   function scan_dev_command_word return dev_mandate;
   function get_arg (arg_number : Positive) return String;

   mandate    : mandate_type := unset;
   low_rights : Boolean := False;

   procedure scan_first_command_word
   is
      first  : constant String := CLI.Argument (1);
   begin
      if first = "help" then
         mandate := help;
      elsif first = "dev" then
         mandate := dev;
      elsif first = "build" then
         mandate := build;
      elsif first = "force" then
         mandate := force;
      elsif first = "test" then
         mandate := test;
      elsif first = "status" then
         mandate := status;
      elsif first = "configure" then
         mandate := configure;
      elsif first = "locate" then
         mandate := locate;
      end if;
   end scan_first_command_word;

   function scan_dev_command_word return dev_mandate
   is
      --  Check argument count before calling
      second : constant String := CLI.Argument (2);
   begin
      if second = "dump" then
         return dump;
      elsif second = "makefile" then
         return makefile;
      elsif second = "distinfo" then
         return distinfo;
      elsif second = "buildsheet" then
         return buildsheet;
      elsif second = "template" then
         return template;
      else
         return unset;
      end if;
   end scan_dev_command_word;

   function get_arg (arg_number : Positive) return String is
   begin
      if CLI.Argument_Count >= arg_number then
         return CLI.Argument (arg_number);
      else
         return "";
      end if;
   end get_arg;

begin

   if CLI.Argument_Count = 0 then
      Pilot.display_usage;
      return;
   end if;

   scan_first_command_word;

   if mandate = unset then
      Pilot.react_to_unknown_first_level_command (CLI.Argument (1));
      return;
   end if;

   --------------------------------------------------------------------------------------------
   --  Validation block start
   --------------------------------------------------------------------------------------------

   if Pilot.already_running then
      return;
   end if;

   if not Parameters.load_configuration then
      return;
   end if;

   case mandate is
      when build | test | status =>
         --  All commands involving replicant slaves
         if Pilot.launch_clash_detected then
            return;
         end if;
      when others => null;
   end case;

   case mandate is
      when build | test =>

         if Parameters.configuration.avec_ncurses and then
           not Pilot.TERM_defined_in_environment
         then
            return;
         end if;
      when others => null;
   end case;

   case mandate is
      when configure | help => null;
      when others =>
         if not Parameters.all_paths_valid then
            return;
         end if;
   end case;

   case mandate is
      when help | locate => null;
         low_rights := True;
      when others =>
         if Pilot.insufficient_privileges then
            return;
         end if;
   end case;

   if Pilot.previous_run_mounts_detected and then
     not Pilot.old_mounts_successfully_removed
   then
      return;
   end if;

   if Pilot.previous_realfs_work_detected and then
     not Pilot.old_realfs_work_successfully_removed
   then
      return;
   end if;

   if Pilot.ravenexec_missing then
      return;
   end if;

   case mandate is
      when build | force | test =>
         if not Pilot.store_origins (start_from => 2) then
            return;
         end if;
      when status =>
         if CLI.Argument_Count > 1 then
            if not Pilot.store_origins (start_from => 2) then
               return;
            end if;
         end if;
      when others => null;
   end case;

   case mandate is
      when build | force | test | status =>
         if not Pilot.slave_platform_determined then
            return;
         end if;
      when others => null;
   end case;

   if not low_rights then
      Pilot.create_pidfile;
      Unix.ignore_background_tty;
   end if;

   if mandate /= configure then
      Unix.cone_of_silence (deploy => True);
   end if;

   --------------------------------------------------------------------------------------------
   --  Validation block end
   --------------------------------------------------------------------------------------------

   case mandate is

      when status =>
         --------------------------------
         --  status command
         --------------------------------
         if CLI.Argument_Count > 1 then
            if Pilot.scan_stack_of_single_ports (always_build => False) and then
              Pilot.sanity_check_then_prefail (delete_first => False, dry_run => True)
            then
               Pilot.perform_bulk_run (testmode => False);
            end if;
         else
            null;  -- reserved for upgrade_system_everything maybe
         end if;

      when build =>
         --------------------------------
         --  build command
         --------------------------------
         if Pilot.scan_stack_of_single_ports (always_build => False) and then
           Pilot.sanity_check_then_prefail (delete_first => False, dry_run => False)
         then
            Pilot.perform_bulk_run (testmode => False);
         end if;

      when force =>
         --------------------------------
         --  force command
         --------------------------------
         if Pilot.scan_stack_of_single_ports (always_build => False) and then
           Pilot.sanity_check_then_prefail (delete_first => True, dry_run => False)
         then
            Pilot.perform_bulk_run (testmode => False);
         end if;

      when dev =>
         --------------------------------
         --  dev command
         --------------------------------
         if CLI.Argument_Count > 1 then
            declare
               dev_subcmd : dev_mandate := scan_dev_command_word;
            begin
               case dev_subcmd is
                  when unset =>
                     Pilot.react_to_unknown_second_level_command (CLI.Argument (1),
                                                                  CLI.Argument (2));
                  when dump =>
                     Pilot.dump_ravensource (get_arg (3));
                  when distinfo =>
                     Pilot.generate_distinfo;
                  when buildsheet =>
                     Pilot.generate_buildsheet (get_arg (3), get_arg (4));
                  when makefile =>
                     Pilot.generate_makefile (get_arg (3), get_arg (4));
                  when template =>
                     Pilot.print_spec_template (get_arg (3));
               end case;
            end;
         else
            Pilot.react_to_unknown_second_level_command (CLI.Argument (1), "");
         end if;

      when help =>
         --------------------------------
         --  help command
         --------------------------------
         null;  --  tbw

      when test =>
         --------------------------------
         --  test command
         --------------------------------
         if Pilot.scan_stack_of_single_ports (always_build => True) and then
           Pilot.sanity_check_then_prefail (delete_first => True, dry_run => False)
         then
            if Pilot.interact_with_single_builder then
               Pilot.bulk_run_then_interact_with_final_port;
            else
               Pilot.perform_bulk_run (testmode => True);
            end if;
         end if;

      when configure =>
         --------------------------------
         --  configure
         --------------------------------
         Pilot.launch_configure_menu;

      when locate =>
         --------------------------------
         --  locate
         --------------------------------
         Pilot.locate (get_arg (2));

      when unset => null;

   end case;

   Unix.cone_of_silence (deploy => False);

   if not low_rights then
      Pilot.destroy_pidfile;
   end if;

end Ravenadm;

Allow "locate" command to be run by user.


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "30";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "31";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

Set to version 1.31

Set to version 1.31


-----------------------------------------------------------------------
--  wiki-render -- Wiki renderer
--  Copyright (C) 2015, 2016 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.Wide_Wide_Unbounded;
with Wiki.Nodes;
with Wiki.Documents;

--  == Wiki Renderer ==
--  The <tt>Wiki.Render</tt> package represents the renderer that takes a wiki document
--  and render the result either in text, HTML or another format.
--
--  @include wiki-render-html.ads
--  @include wiki-render-text.ads
--  @include wiki-render-wiki.ads
package Wiki.Render is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   type Link_Renderer is limited interface;
   type Link_Renderer_Access is access all Link_Renderer'Class;

   --  Get the image link that must be rendered from the wiki image link.
   procedure Make_Image_Link (Renderer : in Link_Renderer;
                              Link     : in Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural) is abstract;

   --  Get the page link that must be rendered from the wiki page link.
   procedure Make_Page_Link (Renderer : in Link_Renderer;
                             Link     : in Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean) is abstract;

   type Default_Link_Renderer is new Link_Renderer with null record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Default_Link_Renderer;
                              Link     : in Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Default_Link_Renderer;
                             Link     : in Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   --  ------------------------------
   --  Document renderer
   --  ------------------------------
   type Renderer is limited interface;
   type Renderer_Access is access all Renderer'Class;

   --  Render the node instance from the document.
   procedure Render (Engine : in out Renderer;
                     Doc    : in Wiki.Documents.Document;
                     Node   : in Wiki.Nodes.Node_Type) is abstract;

   --  Finish the rendering pass after all the wiki document nodes are rendered.
   procedure Finish (Engine : in out Renderer;
                     Doc    : in Wiki.Documents.Document) is null;

   --  Render the list of nodes from the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document;
                     List   : in Wiki.Nodes.Node_List_Access);

   --  Render the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document);

end Wiki.Render;

-----------------------------------------------------------------------
--  wiki-render -- Wiki renderer
--  Copyright (C) 2015, 2016 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 Wiki.Nodes;
with Wiki.Strings;
with Wiki.Documents;

--  == Wiki Renderer ==
--  The <tt>Wiki.Render</tt> package represents the renderer that takes a wiki document
--  and render the result either in text, HTML or another format.
--
--  @include wiki-render-html.ads
--  @include wiki-render-text.ads
--  @include wiki-render-wiki.ads
package Wiki.Render is

   pragma Preelaborate;

   type Link_Renderer is limited interface;
   type Link_Renderer_Access is access all Link_Renderer'Class;

   --  Get the image link that must be rendered from the wiki image link.
   procedure Make_Image_Link (Renderer : in Link_Renderer;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Wiki.Strings.UString;
                              Width    : out Natural;
                              Height   : out Natural) is abstract;

   --  Get the page link that must be rendered from the wiki page link.
   procedure Make_Page_Link (Renderer : in Link_Renderer;
                             Link     : in Wiki.Strings.WString;
                             URI      : out Wiki.Strings.UString;
                             Exists   : out Boolean) is abstract;

   type Default_Link_Renderer is new Link_Renderer with null record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Default_Link_Renderer;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Wiki.Strings.UString;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Default_Link_Renderer;
                             Link     : in Wiki.Strings.WString;
                             URI      : out Wiki.Strings.UString;
                             Exists   : out Boolean);

   --  ------------------------------
   --  Document renderer
   --  ------------------------------
   type Renderer is limited interface;
   type Renderer_Access is access all Renderer'Class;

   --  Render the node instance from the document.
   procedure Render (Engine : in out Renderer;
                     Doc    : in Wiki.Documents.Document;
                     Node   : in Wiki.Nodes.Node_Type) is abstract;

   --  Finish the rendering pass after all the wiki document nodes are rendered.
   procedure Finish (Engine : in out Renderer;
                     Doc    : in Wiki.Documents.Document) is null;

   --  Render the list of nodes from the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document;
                     List   : in Wiki.Nodes.Node_List_Access);

   --  Render the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document);

end Wiki.Render;

Use the Wiki.Strings.WString and UString types


-----------------------------------------------------------------------
--  mat-frames-targets - Representation of stack frames
--  Copyright (C) 2015 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.Finalization;

package MAT.Frames.Targets is

   type Target_Frames is tagged limited private;

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Insert (Frame  : in out Target_Frames;
                     Pc     : in Frame_Table;
                     Result : out Frame_Type);

private

   protected type Frames_Type is

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Insert (Pc     : in Frame_Table;
                        Result : out Frame_Type);

      --  Clear and destroy all the frame instances.
      procedure Clear;

   private
      Root : Frame_Type := Create_Root;
   end Frames_Type;

   type Target_Frames is new Ada.Finalization.Limited_Controlled with record
      Frames : Frames_Type;
   end record;

   --  Release all the stack frames.
   overriding
   procedure Finalize (Frames : in out Target_Frames);

end MAT.Frames.Targets;

-----------------------------------------------------------------------
--  mat-frames-targets - Representation of stack frames
--  Copyright (C) 2015 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.Finalization;

package MAT.Frames.Targets is

   type Target_Frames is tagged limited private;
   type Target_Frames_Access is access all Target_Frames'Class;

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Insert (Frame  : in out Target_Frames;
                     Pc     : in Frame_Table;
                     Result : out Frame_Type);

   --  Get the number of different stack frames which have been registered.
   function Get_Frame_Count (Frame : in Target_Frames) return Natural;

private

   protected type Frames_Type is

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Insert (Pc     : in Frame_Table;
                        Result : out Frame_Type);

      --  Clear and destroy all the frame instances.
      procedure Clear;

   private
      Root : Frame_Type := Create_Root;
   end Frames_Type;

   type Target_Frames is new Ada.Finalization.Limited_Controlled with record
      Frames : Frames_Type;
   end record;

   --  Release all the stack frames.
   overriding
   procedure Finalize (Frames : in out Target_Frames);

end MAT.Frames.Targets;

Declare the Target_Frames_Access type and Get_Frame_Count function


-----------------------------------------------------------------------
--  ado-configs -- Database connection configuration
--  Copyright (C) 2010, 2011, 2012, 2016, 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.
-----------------------------------------------------------------------

with Ada.Finalization;

with Util.Properties;

package ADO.Configs is

   --  Configuration property to control the search paths to load XML queries.
   QUERY_PATHS_CONFIG : constant String := "ado.queries.paths";

   --  Configuration property to control whether all the program XML queries must be
   --  loaded when the database configuration is setup.
   QUERY_LOAD_CONFIG  : constant String := "ado.queries.load";

   --  Configuration property to enable or disable the dynamic load of database driver.
   DYNAMIC_DRIVER_LOAD : constant String := "ado.drivers.load";

   --  Configuration property to skip reading the database table entities.
   NO_ENTITY_LOAD : constant String := "ado.entities.ignore";

   --  Maximum number of columns allowed for a table (SQLite limit is 2000).
   MAX_COLUMNS : constant := 2000;

   --  Maximum number of database drivers (MySQL, PostgreSQL, SQLite, X).
   MAX_DRIVERS : constant := 4;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

   --  Get the global configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Name    : in String;
                        Default : in String := "") return String;

   --  Returns true if the global configuration property is set to true/on.
   function Is_On (Name   : in String) return Boolean;

   --  ------------------------------
   --  The database configuration properties
   --  ------------------------------
   type Configuration is new Ada.Finalization.Controlled with private;
   type Configuration_Access is access all Configuration'Class;

   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   procedure Set_Connection (Config : in out Configuration;
                             URI    : in String);

   --  Get the connection URI that describes the database connection string.
   --  The returned string may contain connection authentication information.
   function Get_URI (Config : in Configuration) return String;

   --  Get the connection URI that describes the database connection string
   --  but the connection authentication is replaced by XXXX.
   function Get_Log_URI (Config : in Configuration) return String;

   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   procedure Set_Property (Config : in out Configuration;
                           Name   : in String;
                           Value  : in String);

   --  Get a property from the data source configuration.
   --  If the property does not exist, an empty string is returned.
   function Get_Property (Config : in Configuration;
                          Name   : in String) return String;

   --  Returns true if the configuration property is set to true/on.
   function Is_On (Config : in Configuration;
                   Name   : in String) return Boolean;

   --  Set the server hostname.
   procedure Set_Server (Config : in out Configuration;
                         Server : in String);

   --  Get the server hostname.
   function Get_Server (Config : in Configuration) return String;

   --  Set the server port.
   procedure Set_Port (Config : in out Configuration;
                       Port   : in Natural);

   --  Get the server port.
   function Get_Port (Config : in Configuration) return Natural;

   --  Set the database name.
   procedure Set_Database (Config   : in out Configuration;
                           Database : in String);

   --  Get the database name.
   function Get_Database (Config : in Configuration) return String;

   --  Get the database driver name.
   function Get_Driver (Config : in Configuration) return String;

   --  Iterate over the configuration properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Config  : in Configuration;
                      Process : access procedure (Name : in String;
                                                  Item : in Util.Properties.Value));

   type Driver_Index is new Natural range 0 .. 4;

private

   use Ada.Strings.Unbounded;

   type Configuration is new Ada.Finalization.Controlled with record
      URI        : Unbounded_String;
      Log_URI    : Unbounded_String;
      Driver     : Unbounded_String;
      Server     : Unbounded_String;
      Port       : Natural := 0;
      Database   : Unbounded_String;
      Properties : Util.Properties.Manager;
   end record;

end ADO.Configs;

-----------------------------------------------------------------------
--  ado-configs -- Database connection configuration
--  Copyright (C) 2010, 2011, 2012, 2016, 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.
-----------------------------------------------------------------------

with Ada.Finalization;

with Util.Properties;

package ADO.Configs is

   --  Configuration property to control the search paths to load XML queries.
   QUERY_PATHS_CONFIG : constant String := "ado.queries.paths";

   --  Configuration property to control whether all the program XML queries must be
   --  loaded when the database configuration is setup.
   QUERY_LOAD_CONFIG  : constant String := "ado.queries.load";

   --  Configuration property to enable or disable the dynamic load of database driver.
   DYNAMIC_DRIVER_LOAD : constant String := "ado.drivers.load";

   --  Configuration property to skip reading the database table entities.
   NO_ENTITY_LOAD : constant String := "ado.entities.ignore";

   --  Maximum number of columns allowed for a table (SQLite limit is 2000).
   MAX_COLUMNS : constant := 2000;

   --  Maximum number of database drivers (MySQL, PostgreSQL, SQLite, X).
   MAX_DRIVERS : constant := 4;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

   --  Get the global configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Name    : in String;
                        Default : in String := "") return String;

   --  Returns true if the global configuration property is set to true/on.
   function Is_On (Name   : in String) return Boolean;

   --  ------------------------------
   --  The database configuration properties
   --  ------------------------------
   type Configuration is new Ada.Finalization.Controlled with private;
   type Configuration_Access is access all Configuration'Class;

   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   procedure Set_Connection (Config : in out Configuration;
                             URI    : in String);

   --  Get the connection URI that describes the database connection string.
   --  The returned string may contain connection authentication information.
   function Get_URI (Config : in Configuration) return String;

   --  Get the connection URI that describes the database connection string
   --  but the connection authentication is replaced by XXXX.
   function Get_Log_URI (Config : in Configuration) return String;

   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   procedure Set_Property (Config : in out Configuration;
                           Name   : in String;
                           Value  : in String);

   --  Get a property from the data source configuration.
   --  If the property does not exist, an empty string is returned.
   function Get_Property (Config : in Configuration;
                          Name   : in String) return String;

   --  Returns true if the configuration property is set to true/on.
   function Is_On (Config : in Configuration;
                   Name   : in String) return Boolean;

   --  Set the server hostname.
   procedure Set_Server (Config : in out Configuration;
                         Server : in String);

   --  Get the server hostname.
   function Get_Server (Config : in Configuration) return String;

   --  Set the server port.
   procedure Set_Port (Config : in out Configuration;
                       Port   : in Natural);

   --  Get the server port.
   function Get_Port (Config : in Configuration) return Natural;

   --  Set the database name.
   procedure Set_Database (Config   : in out Configuration;
                           Database : in String);

   --  Get the database name.
   function Get_Database (Config : in Configuration) return String;

   --  Get the database driver name.
   function Get_Driver (Config : in Configuration) return String;

   --  Iterate over the configuration properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Config  : in Configuration;
                      Process : access procedure (Name : in String;
                                                  Item : in Util.Properties.Value));

   type Driver_Index is new Natural range 0 .. MAX_DRIVERS;

private

   use Ada.Strings.Unbounded;

   type Configuration is new Ada.Finalization.Controlled with record
      URI        : Unbounded_String;
      Log_URI    : Unbounded_String;
      Driver     : Unbounded_String;
      Server     : Unbounded_String;
      Port       : Natural := 0;
      Database   : Unbounded_String;
      Properties : Util.Properties.Manager;
   end record;

end ADO.Configs;

Update Driver_Index type to use the MAX_DRIVERS constant