-----------------------------------------------------------------------
--  awa-wikis-beans -- Beans for module wikis
--  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.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;
with AWA.Wikis.Modules;
with AWA.Wikis.Models;
with AWA.Tags.Beans;
package AWA.Wikis.Beans is

   type Wiki_Space_Bean is new AWA.Wikis.Models.Wiki_Space_Bean with record
      Service   : Modules.Wiki_Module_Access := null;

      --  List of tags associated with the question.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Space_Bean_Access is access all Wiki_Space_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Space_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Space_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the wiki space.
   procedure Save (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki space.
   procedure Delete (Bean    : in out Wiki_Space_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Space_Bean bean instance.
   function Create_Wiki_Space_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Wikis.Beans;

-----------------------------------------------------------------------
--  awa-wikis-beans -- Beans for module wikis
--  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.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;
with AWA.Wikis.Modules;
with AWA.Wikis.Models;
with AWA.Tags.Beans;
package AWA.Wikis.Beans is

   type Wiki_Space_Bean is new AWA.Wikis.Models.Wiki_Space_Bean with record
      Service   : Modules.Wiki_Module_Access := null;

      --  List of tags associated with the question.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Space_Bean_Access is access all Wiki_Space_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Space_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Space_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the wiki space.
   overriding
   procedure Save (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki space.
   procedure Delete (Bean    : in out Wiki_Space_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Space_Bean bean instance.
   function Create_Wiki_Space_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   type Wiki_Page_Bean is new AWA.Wikis.Models.Wiki_Page_Bean with record
      Service   : Modules.Wiki_Module_Access := null;

      Wiki_Space : Wiki_Space_Bean;

      --  List of tags associated with the question.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Page_Bean_Access is access all Wiki_Page_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Page_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Page_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the wiki page.
   overriding
   procedure Save (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki page.
   overriding
   procedure Delete (Bean    : in out Wiki_Page_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Page_Bean bean instance.
   function Create_Wiki_Page_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Wikis.Beans;

Declare the Wiki_Page_Bean type with the Get_Value, Set_Value, Save and Delete operations


-----------------------------------------------------------------------
--  security-policies-urls -- URL security policy
--  Copyright (C) 2010, 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 Ada.Unchecked_Deallocation;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.Mappers;
with Util.Serialize.Mappers.Record_Mapper;

with Security.Contexts;

package body Security.Policies.URLs is

   --  ------------------------------
   --  Get the policy name.
   --  ------------------------------
   overriding
   function Get_Name (From : in URL_Policy) return String is
      pragma Unreferenced (From);
   begin
      return NAME;
   end Get_Name;

   --  ------------------------------
   --  Returns True if the user has the permission to access the given URI permission.
   --  ------------------------------
   function Has_Permission (Manager    : in URL_Policy;
                            Context    : in Security_Context_Access;
                            Permission : in URL_Permission'Class) return Boolean is
      Name  : constant String_Ref := To_String_Ref (Permission.URL);
      Ref   : constant Rules_Ref.Ref := Manager.Cache.Get;
      Rules : constant Rules_Access := Ref.Value;
      Pos   : constant Rules_Maps.Cursor := Rules.Map.Find (Name);
      Rule  : Access_Rule_Ref;
   begin
      --  If the rule is not in the cache, search for the access rule that
      --  matches our URI.  Update the cache.  This cache update is thread-safe
      --  as the cache map is never modified: a new cache map is installed.
      if not Rules_Maps.Has_Element (Pos) then
         declare
            New_Ref : constant Rules_Ref.Ref := Rules_Ref.Create;
         begin
            Rule := Manager.Find_Access_Rule (Permission.URL);
            New_Ref.Value.all.Map := Rules.Map;
            New_Ref.Value.all.Map.Insert (Name, Rule);
            Manager.Cache.Set (New_Ref);
         end;
      else
         Rule := Rules_Maps.Element (Pos);
      end if;

      --  Check if the user has one of the required permission.
      declare
         P       : constant Access_Rule_Access := Rule.Value;
         Granted : Boolean;
      begin
         if P /= null then
            for I in P.Permissions'Range loop
               Context.Has_Permission (P.Permissions (I), Granted);
               if Granted then
                  return True;
               end if;
            end loop;
         end if;
      end;
      return False;
   end Has_Permission;

   --  Grant the permission to access to the given URI to users having the To
   --  permissions.
   procedure Grant_URI_Permission (Manager : in out URL_Policy;
                                   URI     : in String;
                                   To      : in String) is
   begin
      null;
   end Grant_URI_Permission;

   --  ------------------------------
   --  Policy Configuration
   --  ------------------------------

   --  ------------------------------
   --  Find the access rule of the policy that matches the given URI.
   --  Returns the No_Rule value (disable access) if no rule is found.
   --  ------------------------------
   function Find_Access_Rule (Manager : in URL_Policy;
                              URI     : in String) return Access_Rule_Ref is

      Matched : Boolean := False;
      Result  : Access_Rule_Ref;

      procedure Match (P : in Policy);

      procedure Match (P : in Policy) is
      begin
         if GNAT.Regexp.Match (URI, P.Pattern) then
            Matched := True;
            Result  := P.Rule;
         end if;
      end Match;

      Last : constant Natural := Manager.Policies.Last_Index;
   begin
      for I in 1 .. Last loop
         Manager.Policies.Query_Element (I, Match'Access);
         if Matched then
            return Result;
         end if;
      end loop;
      return Result;
   end Find_Access_Rule;

   --  ------------------------------
   --  Initialize the permission manager.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out URL_Policy) is
   begin
      Manager.Cache := new Rules_Ref.Atomic_Ref;
      Manager.Cache.Set (Rules_Ref.Create);
   end Initialize;

   --  ------------------------------
   --  Finalize the permission manager.
   --  ------------------------------
   overriding
   procedure Finalize (Manager : in out URL_Policy) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Rules_Ref.Atomic_Ref,
                                        Rules_Ref_Access);
   begin
      Free (Manager.Cache);
--        for I in Manager.Names'Range loop
--           exit when Manager.Names (I) = null;
--           Ada.Strings.Unbounded.Free (Manager.Names (I));
--        end loop;

   end Finalize;

   type Policy_Fields is (FIELD_ID, FIELD_PERMISSION, FIELD_URL_PATTERN, FIELD_POLICY);

   procedure Set_Member (P     : in out URL_Policy'Class;
                         Field : in Policy_Fields;
                         Value : in Util.Beans.Objects.Object);

   procedure Process (Policy : in out URL_Policy'Class);

   procedure Set_Member (P     : in out URL_Policy'Class;
                         Field : in Policy_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_ID =>
            P.Id := Util.Beans.Objects.To_Integer (Value);

         when FIELD_PERMISSION =>
            P.Permissions.Append (Value);

         when FIELD_URL_PATTERN =>
            P.Patterns.Append (Value);

         when FIELD_POLICY =>
            Process (P);
            P.Id := 0;
            P.Permissions.Clear;
            P.Patterns.Clear;

      end case;
   end Set_Member;

   procedure Process (Policy : in out URL_Policy'Class) is
      Pol    : Security.Policies.URLs.Policy;
      Count  : constant Natural := Natural (Policy.Permissions.Length);
      Rule   : constant Access_Rule_Ref := Access_Rule_Refs.Create (new Access_Rule (Count));
      Iter   : Util.Beans.Objects.Vectors.Cursor := Policy.Permissions.First;
      Pos    : Positive := 1;
   begin
      Pol.Rule := Rule;

      --  Step 1: Initialize the list of permission index in Access_Rule from the permission names.
      while Util.Beans.Objects.Vectors.Has_Element (Iter) loop
         declare
            Perm : constant Util.Beans.Objects.Object := Util.Beans.Objects.Vectors.Element (Iter);
            Name : constant String := Util.Beans.Objects.To_String (Perm);
         begin
            Rule.Value.all.Permissions (Pos) := Permissions.Get_Permission_Index (Name);
            Pos := Pos + 1;

         exception
            when Invalid_Name =>
               raise Util.Serialize.Mappers.Field_Error with "Invalid permission: " & Name;
         end;
         Util.Beans.Objects.Vectors.Next (Iter);
      end loop;

      --  Step 2: Create one policy for each URL pattern
      Iter := Policy.Patterns.First;
      while Util.Beans.Objects.Vectors.Has_Element (Iter) loop
         declare
            Pattern : constant Util.Beans.Objects.Object
              := Util.Beans.Objects.Vectors.Element (Iter);
         begin
            Pol.Id   := Policy.Id;
            Pol.Pattern := GNAT.Regexp.Compile (Util.Beans.Objects.To_String (Pattern));
            Policy.Policies.Append (Pol);
         end;
         Util.Beans.Objects.Vectors.Next (Iter);
      end loop;
   end Process;

   package Policy_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => URL_Policy'Class,
                                               Element_Type_Access => URL_Policy_Access,
                                               Fields              => Policy_Fields,
                                               Set_Member          => Set_Member);

   Policy_Mapping        : aliased Policy_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the policy description.
   --  ------------------------------
   overriding
   procedure Prepare_Config (Policy : in out URL_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser) is
   begin
      Reader.Add_Mapping ("policy-rules", Policy_Mapping'Access);
      Reader.Add_Mapping ("module", Policy_Mapping'Access);
      Policy_Mapper.Set_Context (Reader, Policy'Unchecked_Access);
   end Prepare_Config;

   --  ------------------------------
   --  Get the URL policy associated with the given policy manager.
   --  Returns the URL policy instance or null if it was not registered in the policy manager.
   --  ------------------------------
   function Get_URL_Policy (Manager : in Security.Policies.Policy_Manager'Class)
                            return URL_Policy_Access is
      Policy : constant Security.Policies.Policy_Access := Manager.Get_Policy (NAME);
   begin
      if Policy = null or else not (Policy.all in URL_Policy'Class) then
         return null;
      else
         return URL_Policy'Class (Policy.all)'Access;
      end if;
   end Get_URL_Policy;

begin
   Policy_Mapping.Add_Mapping ("url-policy", FIELD_POLICY);
   Policy_Mapping.Add_Mapping ("url-policy/@id", FIELD_ID);
   Policy_Mapping.Add_Mapping ("url-policy/permission", FIELD_PERMISSION);
   Policy_Mapping.Add_Mapping ("url-policy/url-pattern", FIELD_URL_PATTERN);
end Security.Policies.URLs;

-----------------------------------------------------------------------
--  security-policies-urls -- URL security policy
--  Copyright (C) 2010, 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 Ada.Unchecked_Deallocation;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.Mappers;
with Util.Serialize.Mappers.Record_Mapper;

with Security.Controllers.URLs;

package body Security.Policies.URLs is

   --  ------------------------------
   --  Get the policy name.
   --  ------------------------------
   overriding
   function Get_Name (From : in URL_Policy) return String is
      pragma Unreferenced (From);
   begin
      return NAME;
   end Get_Name;

   --  ------------------------------
   --  Returns True if the user has the permission to access the given URI permission.
   --  ------------------------------
   function Has_Permission (Manager    : in URL_Policy;
                            Context    : in Contexts.Security_Context'Class;
                            Permission : in URL_Permission'Class) return Boolean is
      Name  : constant String_Ref := To_String_Ref (Permission.URL);
      Ref   : constant Rules_Ref.Ref := Manager.Cache.Get;
      Rules : constant Rules_Access := Ref.Value;
      Pos   : constant Rules_Maps.Cursor := Rules.Map.Find (Name);
      Rule  : Access_Rule_Ref;
   begin
      --  If the rule is not in the cache, search for the access rule that
      --  matches our URI.  Update the cache.  This cache update is thread-safe
      --  as the cache map is never modified: a new cache map is installed.
      if not Rules_Maps.Has_Element (Pos) then
         declare
            New_Ref : constant Rules_Ref.Ref := Rules_Ref.Create;
         begin
            Rule := Manager.Find_Access_Rule (Permission.URL);
            New_Ref.Value.all.Map := Rules.Map;
            New_Ref.Value.all.Map.Insert (Name, Rule);
            Manager.Cache.Set (New_Ref);
         end;
      else
         Rule := Rules_Maps.Element (Pos);
      end if;

      --  Check if the user has one of the required permission.
      declare
         P       : constant Access_Rule_Access := Rule.Value;
         Granted : Boolean;
      begin
         if P /= null then
            for I in P.Permissions'Range loop
               Context.Has_Permission (P.Permissions (I), Granted);
               if Granted then
                  return True;
               end if;
            end loop;
         end if;
      end;
      return False;
   end Has_Permission;

   --  Grant the permission to access to the given URI to users having the To
   --  permissions.
   procedure Grant_URI_Permission (Manager : in out URL_Policy;
                                   URI     : in String;
                                   To      : in String) is
   begin
      null;
   end Grant_URI_Permission;

   --  ------------------------------
   --  Policy Configuration
   --  ------------------------------

   --  ------------------------------
   --  Find the access rule of the policy that matches the given URI.
   --  Returns the No_Rule value (disable access) if no rule is found.
   --  ------------------------------
   function Find_Access_Rule (Manager : in URL_Policy;
                              URI     : in String) return Access_Rule_Ref is

      Matched : Boolean := False;
      Result  : Access_Rule_Ref;

      procedure Match (P : in Policy);

      procedure Match (P : in Policy) is
      begin
         if GNAT.Regexp.Match (URI, P.Pattern) then
            Matched := True;
            Result  := P.Rule;
         end if;
      end Match;

      Last : constant Natural := Manager.Policies.Last_Index;
   begin
      for I in 1 .. Last loop
         Manager.Policies.Query_Element (I, Match'Access);
         if Matched then
            return Result;
         end if;
      end loop;
      return Result;
   end Find_Access_Rule;

   --  ------------------------------
   --  Initialize the permission manager.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out URL_Policy) is
   begin
      Manager.Cache := new Rules_Ref.Atomic_Ref;
      Manager.Cache.Set (Rules_Ref.Create);
   end Initialize;

   --  ------------------------------
   --  Finalize the permission manager.
   --  ------------------------------
   overriding
   procedure Finalize (Manager : in out URL_Policy) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Rules_Ref.Atomic_Ref,
                                        Rules_Ref_Access);
   begin
      Free (Manager.Cache);
--        for I in Manager.Names'Range loop
--           exit when Manager.Names (I) = null;
--           Ada.Strings.Unbounded.Free (Manager.Names (I));
--        end loop;

   end Finalize;

   type Policy_Fields is (FIELD_ID, FIELD_PERMISSION, FIELD_URL_PATTERN, FIELD_POLICY);

   procedure Set_Member (P     : in out URL_Policy'Class;
                         Field : in Policy_Fields;
                         Value : in Util.Beans.Objects.Object);

   procedure Process (Policy : in out URL_Policy'Class);

   procedure Set_Member (P     : in out URL_Policy'Class;
                         Field : in Policy_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_ID =>
            P.Id := Util.Beans.Objects.To_Integer (Value);

         when FIELD_PERMISSION =>
            P.Permissions.Append (Value);

         when FIELD_URL_PATTERN =>
            P.Patterns.Append (Value);

         when FIELD_POLICY =>
            Process (P);
            P.Id := 0;
            P.Permissions.Clear;
            P.Patterns.Clear;

      end case;
   end Set_Member;

   procedure Process (Policy : in out URL_Policy'Class) is
      Pol    : Security.Policies.URLs.Policy;
      Count  : constant Natural := Natural (Policy.Permissions.Length);
      Rule   : constant Access_Rule_Ref := Access_Rule_Refs.Create (new Access_Rule (Count));
      Iter   : Util.Beans.Objects.Vectors.Cursor := Policy.Permissions.First;
      Pos    : Positive := 1;
   begin
      Pol.Rule := Rule;

      --  Step 1: Initialize the list of permission index in Access_Rule from the permission names.
      while Util.Beans.Objects.Vectors.Has_Element (Iter) loop
         declare
            Perm : constant Util.Beans.Objects.Object := Util.Beans.Objects.Vectors.Element (Iter);
            Name : constant String := Util.Beans.Objects.To_String (Perm);
         begin
            Rule.Value.all.Permissions (Pos) := Permissions.Get_Permission_Index (Name);
            Pos := Pos + 1;

         exception
            when Invalid_Name =>
               raise Util.Serialize.Mappers.Field_Error with "Invalid permission: " & Name;
         end;
         Util.Beans.Objects.Vectors.Next (Iter);
      end loop;

      --  Step 2: Create one policy for each URL pattern
      Iter := Policy.Patterns.First;
      while Util.Beans.Objects.Vectors.Has_Element (Iter) loop
         declare
            Pattern : constant Util.Beans.Objects.Object
              := Util.Beans.Objects.Vectors.Element (Iter);
         begin
            Pol.Id   := Policy.Id;
            Pol.Pattern := GNAT.Regexp.Compile (Util.Beans.Objects.To_String (Pattern));
            Policy.Policies.Append (Pol);
         end;
         Util.Beans.Objects.Vectors.Next (Iter);
      end loop;
   end Process;

   package Policy_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => URL_Policy'Class,
                                               Element_Type_Access => URL_Policy_Access,
                                               Fields              => Policy_Fields,
                                               Set_Member          => Set_Member);

   Policy_Mapping        : aliased Policy_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the policy description.
   --  ------------------------------
   overriding
   procedure Prepare_Config (Policy : in out URL_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser) is
      Perm : constant Security.Controllers.URLs.URL_Controller_Access
        := new Security.Controllers.URLs.URL_Controller;
   begin
      Perm.Manager := Policy'Unchecked_Access;
      Reader.Add_Mapping ("policy-rules", Policy_Mapping'Access);
      Reader.Add_Mapping ("module", Policy_Mapping'Access);
      Policy_Mapper.Set_Context (Reader, Perm.Manager);
      Policy.Manager.Add_Permission (Name       => "url",
                                     Permission => Perm.all'Access);
   end Prepare_Config;

   --  ------------------------------
   --  Get the URL policy associated with the given policy manager.
   --  Returns the URL policy instance or null if it was not registered in the policy manager.
   --  ------------------------------
   function Get_URL_Policy (Manager : in Security.Policies.Policy_Manager'Class)
                            return URL_Policy_Access is
      Policy : constant Security.Policies.Policy_Access := Manager.Get_Policy (NAME);
   begin
      if Policy = null or else not (Policy.all in URL_Policy'Class) then
         return null;
      else
         return URL_Policy'Class (Policy.all)'Access;
      end if;
   end Get_URL_Policy;

begin
   Policy_Mapping.Add_Mapping ("url-policy", FIELD_POLICY);
   Policy_Mapping.Add_Mapping ("url-policy/@id", FIELD_ID);
   Policy_Mapping.Add_Mapping ("url-policy/permission", FIELD_PERMISSION);
   Policy_Mapping.Add_Mapping ("url-policy/url-pattern", FIELD_URL_PATTERN);
end Security.Policies.URLs;

Create the URL controller and register it when the URL policy configuration is read


-----------------------------------------------------------------------
--  wiki-filters-variables -- Expand variables in text and links
--  Copyright (C) 2020 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

package body Wiki.Filters.Variables is

   function Need_Expand (Text : in Wiki.Strings.WString) return Boolean;

   function Need_Expand (Text : in Wiki.Strings.WString) return Boolean is
   begin
      return Wiki.Strings.Index (Text, "$") > 0;
   end Need_Expand;

   procedure Add_Variable (Chain : in Wiki.Filters.Filter_Chain;
                           Name  : in Wiki.Strings.WString;
                           Value : in Wiki.Strings.WString) is
      Filter : Filter_Type_Access := Chain.Next;
   begin
      while Filter /= null loop
         if Filter.all in Variable_Filter'Class then
            Variable_Filter'Class (Filter.all).Add_Variable (Name, Value);
            return;
         end if;
         Filter := Filter.Next;
      end loop;
   end Add_Variable;

   --  ------------------------------
   --  Add a variable to replace the given name by its value.
   --  ------------------------------
   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in Wiki.Strings.WString;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Name, Value);
   end Add_Variable;

   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in String;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Wiki.Strings.To_WString (Name), Value);
   end Add_Variable;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Filter    : in out Variable_Filter;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      if Need_Expand (Header) then
         Filter_Type (Filter).Add_Header (Document, Filter.Expand (Header), Level);
      else
         Filter_Type (Filter).Add_Header (Document, Header, Level);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Add a text content with the given format to the document.  Replace variables
   --  that are contained in the text.
   --  ------------------------------
   overriding
   procedure Add_Text (Filter    : in out Variable_Filter;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map) is
   begin
      if Need_Expand (Text) then
         Filter_Type (Filter).Add_Text (Document, Filter.Expand (Text), Format);
      else
         Filter_Type (Filter).Add_Text (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Filter     : in out Variable_Filter;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Link (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Filter     : in out Variable_Filter;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Quote (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Quote (Document, Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Expand the variables contained in the text.
   --  ------------------------------
   function Expand (Filter : in Variable_Filter;
                    Text   : in Wiki.Strings.WString) return Wiki.Strings.WString is
      First      : Natural := Text'First;
      Pos        : Natural;
      Last       : Natural;
      Name_Start : Natural;
      Name_End   : Natural;
      Result     : Wiki.Strings.BString (256);
      Item       : Variable_Cursor;
      Match_End  : Wiki.Strings.WChar;
   begin
      while First <= Text'Last loop
         Pos := First;
         while Pos <= Text'Last and then Text (Pos) /= '$' loop
            Pos := Pos + 1;
         end loop;
         exit when Pos >= Text'Last;
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Pos - 1));
         First := Pos;
         Name_Start := Pos + 1;
         if Text (Name_Start) = '(' or Text (Name_Start) = '{' then
            Match_End := (if Text (Name_Start) = '(' then ')' else '}');
            Name_Start := Name_Start + 1;
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= Match_End loop
               Name_End := Name_End + 1;
            end loop;
            exit when Name_End > Text'Last;
            exit when Text (Name_End) /= Match_End;
            Last := Name_End + 1;
            Name_End := Name_End - 1;
         else
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= ' ' loop
               Name_End := Name_End + 1;
            end loop;
            Last := Name_End;
            Name_End := Name_End - 1;
         end if;
         Item := Filter.Variables.Find (Text (Name_Start .. Name_End));
         if Variable_Maps.Has_Element (Item) then
            Strings.Wide_Wide_Builders.Append (Result, Variable_Maps.Element (Item));
            First := Last;
         elsif Last > Text'Last then
            exit;
         else
            Strings.Wide_Wide_Builders.Append (Result, Text (First .. Last));
            First := Last + 1;
         end if;
      end loop;
      if First <= Text'Last then
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Text'Last));
      end if;
      return Strings.Wide_Wide_Builders.To_Array (Result);
   end Expand;

   --  ------------------------------
   --  Iterate over the filter variables.
   --  ------------------------------
   procedure Iterate (Filter  : in Variable_Filter;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString)) is
      Iter : Variable_Cursor := Filter.Variables.First;
   begin
      while Variable_Maps.Has_Element (Iter) loop
         Variable_Maps.Query_Element (Iter, Process);
         Variable_Maps.Next (Iter);
      end loop;
   end Iterate;

   procedure Iterate (Chain   : in Wiki.Filters.Filter_Chain;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString)) is
      Filter : Filter_Type_Access := Chain.Next;
   begin
      while Filter /= null loop
         if Filter.all in Variable_Filter'Class then
            Variable_Filter'Class (Filter.all).Iterate (Process);
            return;
         end if;
         Filter := Filter.Next;
      end loop;
   end Iterate;

end Wiki.Filters.Variables;

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

package body Wiki.Filters.Variables is

   function Need_Expand (Text : in Wiki.Strings.WString) return Boolean;

   function Need_Expand (Text : in Wiki.Strings.WString) return Boolean is
   begin
      return Wiki.Strings.Index (Text, "$") > 0;
   end Need_Expand;

   procedure Add_Variable (Chain : in Wiki.Filters.Filter_Chain;
                           Name  : in Wiki.Strings.WString;
                           Value : in Wiki.Strings.WString) is
      Filter : Filter_Type_Access := Chain.Next;
   begin
      while Filter /= null loop
         if Filter.all in Variable_Filter'Class then
            Variable_Filter'Class (Filter.all).Add_Variable (Name, Value);
            return;
         end if;
         Filter := Filter.Next;
      end loop;
   end Add_Variable;

   --  ------------------------------
   --  Add a variable to replace the given name by its value.
   --  ------------------------------
   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in Wiki.Strings.WString;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Name, Value);
   end Add_Variable;

   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in String;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Wiki.Strings.To_WString (Name), Value);
   end Add_Variable;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Filter    : in out Variable_Filter;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      if Need_Expand (Header) then
         Filter_Type (Filter).Add_Header (Document, Filter.Expand (Header), Level);
      else
         Filter_Type (Filter).Add_Header (Document, Header, Level);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Add a text content with the given format to the document.  Replace variables
   --  that are contained in the text.
   --  ------------------------------
   overriding
   procedure Add_Text (Filter    : in out Variable_Filter;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map) is
   begin
      if Need_Expand (Text) then
         Filter_Type (Filter).Add_Text (Document, Filter.Expand (Text), Format);
      else
         Filter_Type (Filter).Add_Text (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Filter     : in out Variable_Filter;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Link (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Filter     : in out Variable_Filter;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Quote (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Quote (Document, Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Expand the variables contained in the text.
   --  ------------------------------
   function Expand (Filter : in Variable_Filter;
                    Text   : in Wiki.Strings.WString) return Wiki.Strings.WString is
      First      : Natural := Text'First;
      Pos        : Natural;
      Last       : Natural;
      Name_Start : Natural;
      Name_End   : Natural;
      Result     : Wiki.Strings.BString (256);
      Item       : Variable_Cursor;
      Match_End  : Wiki.Strings.WChar;
   begin
      while First <= Text'Last loop
         Pos := First;
         while Pos <= Text'Last and then Text (Pos) /= '$' loop
            Pos := Pos + 1;
         end loop;
         exit when Pos >= Text'Last;
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Pos - 1));
         First := Pos;
         Name_Start := Pos + 1;
         if Text (Name_Start) = '(' or Text (Name_Start) = '{' then
            Match_End := (if Text (Name_Start) = '(' then ')' else '}');
            Name_Start := Name_Start + 1;
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= Match_End loop
               Name_End := Name_End + 1;
            end loop;
            exit when Name_End > Text'Last;
            exit when Text (Name_End) /= Match_End;
            Last := Name_End + 1;
            Name_End := Name_End - 1;
         else
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= ' ' loop
               Name_End := Name_End + 1;
            end loop;
            Last := Name_End;
            Name_End := Name_End - 1;
         end if;
         Item := Filter.Variables.Find (Text (Name_Start .. Name_End));
         if Strings.Maps.Has_Element (Item) then
            Strings.Wide_Wide_Builders.Append (Result, Strings.Maps.Element (Item));
            First := Last;
         elsif Last > Text'Last then
            exit;
         else
            Strings.Wide_Wide_Builders.Append (Result, Text (First .. Last));
            First := Last + 1;
         end if;
      end loop;
      if First <= Text'Last then
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Text'Last));
      end if;
      return Strings.Wide_Wide_Builders.To_Array (Result);
   end Expand;

   --  ------------------------------
   --  Iterate over the filter variables.
   --  ------------------------------
   procedure Iterate (Filter  : in Variable_Filter;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString)) is
      Iter : Variable_Cursor := Filter.Variables.First;
   begin
      while Strings.Maps.Has_Element (Iter) loop
         Strings.Maps.Query_Element (Iter, Process);
         Strings.Maps.Next (Iter);
      end loop;
   end Iterate;

   procedure Iterate (Chain   : in Wiki.Filters.Filter_Chain;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString)) is
      Filter : Filter_Type_Access := Chain.Next;
   begin
      while Filter /= null loop
         if Filter.all in Variable_Filter'Class then
            Variable_Filter'Class (Filter.all).Iterate (Process);
            return;
         end if;
         Filter := Filter.Next;
      end loop;
   end Iterate;

end Wiki.Filters.Variables;

Update to use the Wiki.Strings.Maps package


-----------------------------------------------------------------------
--  util-serialize-io-csv -- CSV Serialization Driver
--  Copyright (C) 2011, 2015, 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Characters.Latin_1;
with Ada.IO_Exceptions;

with Util.Strings;
with Util.Dates.ISO8601;

package body Util.Serialize.IO.CSV is

   --  ------------------------------
   --  Set the field separator.  The default field separator is the comma (',').
   --  ------------------------------
   procedure Set_Field_Separator (Stream    : in out Output_Stream;
                                  Separator : in Character) is
   begin
      Stream.Separator := Separator;
   end Set_Field_Separator;

   --  ------------------------------
   --  Enable or disable the double quotes by default for strings.
   --  ------------------------------
   procedure Set_Quotes (Stream : in out Output_Stream;
                         Enable : in Boolean) is
   begin
      Stream.Quote := Enable;
   end Set_Quotes;

   --  ------------------------------
   --  Write the value as a CSV cell.  Special characters are escaped using the CSV
   --  escape rules.
   --  ------------------------------
   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in String) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      if Stream.Quote then
         Stream.Write ('"');
      end if;
      for I in Value'Range loop
         if Value (I) = '"' then
            Stream.Write ("""""");
         else
            Stream.Write (Value (I));
         end if;
      end loop;
      if Stream.Quote then
         Stream.Write ('"');
      end if;
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Integer) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      Stream.Write (Util.Strings.Image (Value));
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Boolean) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      if Value then
         Stream.Write ("true");
      else
         Stream.Write ("false");
      end if;
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      case Util.Beans.Objects.Get_Type (Value) is
         when TYPE_NULL =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            if Stream.Quote then
               Stream.Write ("""null""");
            else
               Stream.Write ("null");
            end if;

         when TYPE_BOOLEAN =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            if Util.Beans.Objects.To_Boolean (Value) then
               Stream.Write ("true");
            else
               Stream.Write ("false");
            end if;

         when TYPE_INTEGER =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            --  Stream.Write ('"');
            Stream.Write (Util.Beans.Objects.To_Long_Long_Integer (Value));
            --  Stream.Write ('"');

         when others =>
            Stream.Write_Cell (Util.Beans.Objects.To_String (Value));

      end case;
   end Write_Cell;

   --  ------------------------------
   --  Start a new row.
   --  ------------------------------
   procedure New_Row (Stream : in out Output_Stream) is
   begin
      while Stream.Column < Stream.Max_Columns loop
         Stream.Write (Stream.Separator);
         Stream.Column := Stream.Column + 1;
      end loop;
      Stream.Write (ASCII.CR);
      Stream.Write (ASCII.LF);
      Stream.Column := 1;
      Stream.Row := Stream.Row + 1;
   end New_Row;

   --  -----------------------
   --  Write the attribute name/value pair.
   --  -----------------------
   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Nullables.Nullable_String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Ada.Strings.Unbounded.To_String (Value.Value));
   end Write_Attribute;

   overriding
   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   --  -----------------------
   --  Write the entity value.
   --  -----------------------
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Nullables.Nullable_String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Ada.Strings.Unbounded.To_String (Value.Value));
   end Write_Entity;

   overriding
   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time) is
   begin
      Stream.Write_Entity (Name, Util.Dates.ISO8601.Image (Value, Util.Dates.ISO8601.SUBSECOND));
   end Write_Entity;

   overriding
   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer) is
   begin
      null;
   end Write_Long_Entity;

   overriding
   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String) is
   begin
      Stream.Write_Entity (Name, Value);
   end Write_Enum_Entity;

   --  ------------------------------
   --  Get the header name for the given column.
   --  If there was no header line, build a default header for the column.
   --  ------------------------------
   function Get_Header_Name (Handler : in Parser;
                             Column  : in Column_Type) return String is
      use type Ada.Containers.Count_Type;

      Default_Header : constant String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
      Result : String (1 .. 10);
      N, R   : Natural;
      Pos    : Positive := Result'Last;
   begin
      if Handler.Headers.Length >= Ada.Containers.Count_Type (Column) then
         return Handler.Headers.Element (Positive (Column));
      end if;
      N := Natural (Column - 1);
      loop
         R := N mod 26;
         N := N / 26;
         Result (Pos) := Default_Header (R + 1);
         exit when N = 0;
         Pos := Pos - 1;
      end loop;
      return Result (Pos .. Result'Last);
   end Get_Header_Name;

   --  ------------------------------
   --  Set the cell value at the given row and column.
   --  The default implementation finds the column header name and
   --  invokes Write_Entity with the header name and the value.
   --  ------------------------------
   procedure Set_Cell (Handler : in out Parser;
                       Value   : in String;
                       Row     : in Row_Type;
                       Column  : in Column_Type) is
      use Ada.Containers;
   begin
      if Row = 0 then
         --  Build the headers table.
         declare
            Missing : constant Integer := Integer (Column) - Integer (Handler.Headers.Length);
         begin
            if Missing > 0 then
               Handler.Headers.Set_Length (Handler.Headers.Length + Count_Type (Missing));
            end if;
            Handler.Headers.Replace_Element (Positive (Column), Value);
         end;
      else
         declare
            Name : constant String := Handler.Get_Header_Name (Column);
         begin
            --  Detect a new row.  Close the current object and start a new one.
            if Handler.Row /= Row then
               if Row > 1 then
                  Handler.Sink.Finish_Object ("", Handler);
               else
                  Handler.Sink.Start_Array ("", Handler);
               end if;
               Handler.Sink.Start_Object ("", Handler);
            end if;
            Handler.Row := Row;
            Handler.Sink.Set_Member (Name, Util.Beans.Objects.To_Object (Value), Handler);
         end;
      end if;
   end Set_Cell;

   --  ------------------------------
   --  Set the field separator.  The default field separator is the comma (',').
   --  ------------------------------
   procedure Set_Field_Separator (Handler   : in out Parser;
                                  Separator : in Character) is
   begin
      Handler.Separator := Separator;
   end Set_Field_Separator;

   --  ------------------------------
   --  Get the field separator.
   --  ------------------------------
   function Get_Field_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Separator;
   end Get_Field_Separator;

   --  ------------------------------
   --  Set the comment separator.  When a comment separator is defined, a line which starts
   --  with the comment separator will be ignored.  The row number will not be incremented.
   --  ------------------------------
   procedure Set_Comment_Separator (Handler   : in out Parser;
                                    Separator : in Character) is
   begin
      Handler.Comment := Separator;
   end Set_Comment_Separator;

   --  ------------------------------
   --  Get the comment separator.  Returns ASCII.NUL if comments are not supported.
   --  ------------------------------
   function Get_Comment_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Comment;
   end Get_Comment_Separator;

   --  ------------------------------
   --  Setup the CSV parser and mapper to use the default column header names.
   --  When activated, the first row is assumed to contain the first item to de-serialize.
   --  ------------------------------
   procedure Set_Default_Headers (Handler : in out Parser;
                                  Mode    : in Boolean := True) is
   begin
      Handler.Use_Default_Headers := Mode;
   end Set_Default_Headers;

   --  ------------------------------
   --  Parse the stream using the CSV parser.
   --  Call Set_Cell for each cell that has been parsed indicating the row and
   --  column numbers as well as the cell value.
   --  ------------------------------
   overriding
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class;
                    Sink    : in out Reader'Class) is
      use Ada.Strings.Unbounded;

      C              : Character;
      Token          : Unbounded_String;
      Column         : Column_Type := 1;
      Row            : Row_Type  := 0;
      In_Quote_Token : Boolean := False;
      In_Escape      : Boolean := False;
      Ignore_Row     : Boolean := False;
   begin
      if Handler.Use_Default_Headers then
         Row := 1;
      end if;
      Handler.Headers.Clear;
      Handler.Sink := Sink'Unchecked_Access;
      loop
         Stream.Read (Char => C);

         if C = Ada.Characters.Latin_1.CR  or C = Ada.Characters.Latin_1.LF then
            if C = Ada.Characters.Latin_1.LF then
               Handler.Line_Number := Handler.Line_Number + 1;
            end if;
            if not Ignore_Row then
               if In_Quote_Token and not In_Escape then
                  Append (Token, C);

               elsif Column > 1 or else Length (Token) > 0 then
                  Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
                  Set_Unbounded_String (Token, "");
                  Row            := Row + 1;
                  Column         := 1;
                  In_Quote_Token := False;
                  In_Escape      := False;
               end if;
            else
               Ignore_Row := False;
            end if;

         elsif C = Handler.Separator and not Ignore_Row then
            if In_Quote_Token and not In_Escape then
               Append (Token, C);

            else
               Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
               Set_Unbounded_String (Token, "");
               Column         := Column + 1;
               In_Quote_Token := False;
               In_Escape      := False;
            end if;

         elsif C = '"' and not Ignore_Row then
            if In_Quote_Token then
               In_Escape := True;

            elsif In_Escape then
               Append (Token, C);
               In_Escape := False;

            elsif Ada.Strings.Unbounded.Length (Token) = 0 then
               In_Quote_Token := True;

            else
               Append (Token, C);
            end if;

         elsif C = Handler.Comment and Handler.Comment /= ASCII.NUL
           and Column = 1 and Length (Token) = 0
         then
            Ignore_Row := True;

         elsif not Ignore_Row then
            Append (Token, C);
            In_Escape := False;

         end if;

      end loop;

   exception
      when Ada.IO_Exceptions.Data_Error =>
         Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
         Handler.Sink := null;
         return;
   end Parse;

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   overriding
   function Get_Location (Handler : in Parser) return String is
   begin
      return Util.Strings.Image (Handler.Line_Number);
   end Get_Location;

end Util.Serialize.IO.CSV;

-----------------------------------------------------------------------
--  util-serialize-io-csv -- CSV Serialization Driver
--  Copyright (C) 2011, 2015, 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Characters.Latin_1;
with Ada.IO_Exceptions;

with Util.Strings;
with Util.Dates.ISO8601;

package body Util.Serialize.IO.CSV is

   --  ------------------------------
   --  Set the field separator.  The default field separator is the comma (',').
   --  ------------------------------
   procedure Set_Field_Separator (Stream    : in out Output_Stream;
                                  Separator : in Character) is
   begin
      Stream.Separator := Separator;
   end Set_Field_Separator;

   --  ------------------------------
   --  Enable or disable the double quotes by default for strings.
   --  ------------------------------
   procedure Set_Quotes (Stream : in out Output_Stream;
                         Enable : in Boolean) is
   begin
      Stream.Quote := Enable;
   end Set_Quotes;

   --  ------------------------------
   --  Write the value as a CSV cell.  Special characters are escaped using the CSV
   --  escape rules.
   --  ------------------------------
   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in String) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      if Stream.Quote then
         Stream.Write ('"');
      end if;
      for I in Value'Range loop
         if Value (I) = '"' then
            Stream.Write ("""""");
         else
            Stream.Write (Value (I));
         end if;
      end loop;
      if Stream.Quote then
         Stream.Write ('"');
      end if;
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Integer) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      Stream.Write (Util.Strings.Image (Value));
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Boolean) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      if Value then
         Stream.Write ("true");
      else
         Stream.Write ("false");
      end if;
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      case Util.Beans.Objects.Get_Type (Value) is
         when TYPE_NULL =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            if Stream.Quote then
               Stream.Write ("""null""");
            else
               Stream.Write ("null");
            end if;

         when TYPE_BOOLEAN =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            if Util.Beans.Objects.To_Boolean (Value) then
               Stream.Write ("true");
            else
               Stream.Write ("false");
            end if;

         when TYPE_INTEGER =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            --  Stream.Write ('"');
            Stream.Write (Util.Beans.Objects.To_Long_Long_Integer (Value));
            --  Stream.Write ('"');

         when others =>
            Stream.Write_Cell (Util.Beans.Objects.To_String (Value));

      end case;
   end Write_Cell;

   --  ------------------------------
   --  Start a new row.
   --  ------------------------------
   procedure New_Row (Stream : in out Output_Stream) is
   begin
      while Stream.Column < Stream.Max_Columns loop
         Stream.Write (Stream.Separator);
         Stream.Column := Stream.Column + 1;
      end loop;
      Stream.Write (ASCII.CR);
      Stream.Write (ASCII.LF);
      Stream.Column := 1;
      Stream.Row := Stream.Row + 1;
   end New_Row;

   --  -----------------------
   --  Write the attribute name/value pair.
   --  -----------------------
   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Nullables.Nullable_String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Ada.Strings.Unbounded.To_String (Value.Value));
   end Write_Attribute;

   overriding
   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   --  -----------------------
   --  Write the entity value.
   --  -----------------------
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Nullables.Nullable_String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Ada.Strings.Unbounded.To_String (Value.Value));
   end Write_Entity;

   overriding
   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time) is
   begin
      Stream.Write_Entity (Name, Util.Dates.ISO8601.Image (Value, Util.Dates.ISO8601.SUBSECOND));
   end Write_Entity;

   overriding
   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer) is
   begin
      null;
   end Write_Long_Entity;

   overriding
   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String) is
   begin
      Stream.Write_Entity (Name, Value);
   end Write_Enum_Entity;

   --  ------------------------------
   --  Write the attribute with a null value.
   --  ------------------------------
   overriding
   procedure Write_Null_Attribute (Stream : in out Output_Stream;
                                   Name   : in String) is
   begin
      Stream.Write_Entity (Name, "");
   end Write_Null_Attribute;

   --  ------------------------------
   --  Write an entity with a null value.
   --  ------------------------------
   procedure Write_Null_Entity (Stream : in out Output_Stream;
                                Name   : in String) is
   begin
      Stream.Write_Null_Attribute (Name);
   end Write_Null_Entity;

   --  ------------------------------
   --  Get the header name for the given column.
   --  If there was no header line, build a default header for the column.
   --  ------------------------------
   function Get_Header_Name (Handler : in Parser;
                             Column  : in Column_Type) return String is
      use type Ada.Containers.Count_Type;

      Default_Header : constant String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
      Result : String (1 .. 10);
      N, R   : Natural;
      Pos    : Positive := Result'Last;
   begin
      if Handler.Headers.Length >= Ada.Containers.Count_Type (Column) then
         return Handler.Headers.Element (Positive (Column));
      end if;
      N := Natural (Column - 1);
      loop
         R := N mod 26;
         N := N / 26;
         Result (Pos) := Default_Header (R + 1);
         exit when N = 0;
         Pos := Pos - 1;
      end loop;
      return Result (Pos .. Result'Last);
   end Get_Header_Name;

   --  ------------------------------
   --  Set the cell value at the given row and column.
   --  The default implementation finds the column header name and
   --  invokes Write_Entity with the header name and the value.
   --  ------------------------------
   procedure Set_Cell (Handler : in out Parser;
                       Value   : in String;
                       Row     : in Row_Type;
                       Column  : in Column_Type) is
      use Ada.Containers;
   begin
      if Row = 0 then
         --  Build the headers table.
         declare
            Missing : constant Integer := Integer (Column) - Integer (Handler.Headers.Length);
         begin
            if Missing > 0 then
               Handler.Headers.Set_Length (Handler.Headers.Length + Count_Type (Missing));
            end if;
            Handler.Headers.Replace_Element (Positive (Column), Value);
         end;
      else
         declare
            Name : constant String := Handler.Get_Header_Name (Column);
         begin
            --  Detect a new row.  Close the current object and start a new one.
            if Handler.Row /= Row then
               if Row > 1 then
                  Handler.Sink.Finish_Object ("", Handler);
               else
                  Handler.Sink.Start_Array ("", Handler);
               end if;
               Handler.Sink.Start_Object ("", Handler);
            end if;
            Handler.Row := Row;
            Handler.Sink.Set_Member (Name, Util.Beans.Objects.To_Object (Value), Handler);
         end;
      end if;
   end Set_Cell;

   --  ------------------------------
   --  Set the field separator.  The default field separator is the comma (',').
   --  ------------------------------
   procedure Set_Field_Separator (Handler   : in out Parser;
                                  Separator : in Character) is
   begin
      Handler.Separator := Separator;
   end Set_Field_Separator;

   --  ------------------------------
   --  Get the field separator.
   --  ------------------------------
   function Get_Field_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Separator;
   end Get_Field_Separator;

   --  ------------------------------
   --  Set the comment separator.  When a comment separator is defined, a line which starts
   --  with the comment separator will be ignored.  The row number will not be incremented.
   --  ------------------------------
   procedure Set_Comment_Separator (Handler   : in out Parser;
                                    Separator : in Character) is
   begin
      Handler.Comment := Separator;
   end Set_Comment_Separator;

   --  ------------------------------
   --  Get the comment separator.  Returns ASCII.NUL if comments are not supported.
   --  ------------------------------
   function Get_Comment_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Comment;
   end Get_Comment_Separator;

   --  ------------------------------
   --  Setup the CSV parser and mapper to use the default column header names.
   --  When activated, the first row is assumed to contain the first item to de-serialize.
   --  ------------------------------
   procedure Set_Default_Headers (Handler : in out Parser;
                                  Mode    : in Boolean := True) is
   begin
      Handler.Use_Default_Headers := Mode;
   end Set_Default_Headers;

   --  ------------------------------
   --  Parse the stream using the CSV parser.
   --  Call Set_Cell for each cell that has been parsed indicating the row and
   --  column numbers as well as the cell value.
   --  ------------------------------
   overriding
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class;
                    Sink    : in out Reader'Class) is
      use Ada.Strings.Unbounded;

      C              : Character;
      Token          : Unbounded_String;
      Column         : Column_Type := 1;
      Row            : Row_Type  := 0;
      In_Quote_Token : Boolean := False;
      In_Escape      : Boolean := False;
      Ignore_Row     : Boolean := False;
   begin
      if Handler.Use_Default_Headers then
         Row := 1;
      end if;
      Handler.Headers.Clear;
      Handler.Sink := Sink'Unchecked_Access;
      loop
         Stream.Read (Char => C);

         if C = Ada.Characters.Latin_1.CR  or C = Ada.Characters.Latin_1.LF then
            if C = Ada.Characters.Latin_1.LF then
               Handler.Line_Number := Handler.Line_Number + 1;
            end if;
            if not Ignore_Row then
               if In_Quote_Token and not In_Escape then
                  Append (Token, C);

               elsif Column > 1 or else Length (Token) > 0 then
                  Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
                  Set_Unbounded_String (Token, "");
                  Row            := Row + 1;
                  Column         := 1;
                  In_Quote_Token := False;
                  In_Escape      := False;
               end if;
            else
               Ignore_Row := False;
            end if;

         elsif C = Handler.Separator and not Ignore_Row then
            if In_Quote_Token and not In_Escape then
               Append (Token, C);

            else
               Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
               Set_Unbounded_String (Token, "");
               Column         := Column + 1;
               In_Quote_Token := False;
               In_Escape      := False;
            end if;

         elsif C = '"' and not Ignore_Row then
            if In_Quote_Token then
               In_Escape := True;

            elsif In_Escape then
               Append (Token, C);
               In_Escape := False;

            elsif Ada.Strings.Unbounded.Length (Token) = 0 then
               In_Quote_Token := True;

            else
               Append (Token, C);
            end if;

         elsif C = Handler.Comment and Handler.Comment /= ASCII.NUL
           and Column = 1 and Length (Token) = 0
         then
            Ignore_Row := True;

         elsif not Ignore_Row then
            Append (Token, C);
            In_Escape := False;

         end if;

      end loop;

   exception
      when Ada.IO_Exceptions.Data_Error =>
         Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
         Handler.Sink := null;
         return;
   end Parse;

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   overriding
   function Get_Location (Handler : in Parser) return String is
   begin
      return Util.Strings.Image (Handler.Line_Number);
   end Get_Location;

end Util.Serialize.IO.CSV;

Implement the Write_Null_Attribute and Write_Null_Entity operations


-----------------------------------------------------------------------
--  util-commands -- Support to make command line tools
--  Copyright (C) 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
private with Util.Strings.Vectors;
private with Ada.Strings.Unbounded;
package Util.Commands is

   --  The argument list interface that gives access to command arguments.
   type Argument_List is limited interface;

   --  Get the number of arguments available.
   function Get_Count (List : in Argument_List) return Natural is abstract;

   --  Get the argument at the given position.
   function Get_Argument (List : in Argument_List;
                          Pos  : in Positive) return String is abstract;

   --  Get the command name.
   function Get_Command_Name (List : in Argument_List) return String is abstract;

   type Default_Argument_List (Offset : Natural) is new Argument_List with null record;

   --  Get the number of arguments available.
   overriding
   function Get_Count (List : in Default_Argument_List) return Natural;

   --  Get the argument at the given position.
   overriding
   function Get_Argument (List : in Default_Argument_List;
                          Pos  : in Positive) return String;

   --  Get the command name.
   function Get_Command_Name (List : in Default_Argument_List) return String;

   type String_Argument_List (Max_Length : Positive;
                              Max_Args   : Positive) is new Argument_List with private;

   --  Set the argument list to the given string and split the arguments.
   procedure Initialize (List : in out String_Argument_List;
                         Line : in String);

   --  Get the number of arguments available.
   overriding
   function Get_Count (List : in String_Argument_List) return Natural;

   --  Get the argument at the given position.
   overriding
   function Get_Argument (List : in String_Argument_List;
                          Pos  : in Positive) return String;

   --  Get the command name.
   overriding
   function Get_Command_Name (List : in String_Argument_List) return String;

   --  The argument list interface that gives access to command arguments.
   type Dynamic_Argument_List is limited new Argument_List with private;

   --  Get the number of arguments available.
   function Get_Count (List : in Dynamic_Argument_List) return Natural;

   --  Get the argument at the given position.
   function Get_Argument (List : in Dynamic_Argument_List;
                          Pos  : in Positive) return String;

   --  Get the command name.
   function Get_Command_Name (List : in Dynamic_Argument_List) return String;

private

   type Argument_Pos is array (Natural range <>) of Natural;

   type String_Argument_List (Max_Length : Positive;
                              Max_Args   : Positive) is new Argument_List
     with record
      Count     : Natural := 0;
      Length    : Natural := 0;
      Line      : String (1 .. Max_Length);
      Start_Pos : Argument_Pos (0 .. Max_Args);
      End_Pos   : Argument_Pos (0 .. Max_Args);
   end record;

   type Dynamic_Argument_List is limited new Argument_List with record
      List : Util.Strings.Vectors.Vector;
      Name : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Util.Commands;

-----------------------------------------------------------------------
--  util-commands -- Support to make command line tools
--  Copyright (C) 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
private with Util.Strings.Vectors;
private with Ada.Strings.Unbounded;
package Util.Commands is

   --  The argument list interface that gives access to command arguments.
   type Argument_List is limited interface;

   --  Get the number of arguments available.
   function Get_Count (List : in Argument_List) return Natural is abstract;

   --  Get the argument at the given position.
   function Get_Argument (List : in Argument_List;
                          Pos  : in Positive) return String is abstract;

   --  Get the command name.
   function Get_Command_Name (List : in Argument_List) return String is abstract;

   type Default_Argument_List (Offset : Natural) is new Argument_List with null record;

   --  Get the number of arguments available.
   overriding
   function Get_Count (List : in Default_Argument_List) return Natural;

   --  Get the argument at the given position.
   overriding
   function Get_Argument (List : in Default_Argument_List;
                          Pos  : in Positive) return String;

   --  Get the command name.
   function Get_Command_Name (List : in Default_Argument_List) return String;

   type String_Argument_List (Max_Length : Positive;
                              Max_Args   : Positive) is new Argument_List with private;

   --  Set the argument list to the given string and split the arguments.
   procedure Initialize (List : in out String_Argument_List;
                         Line : in String);

   --  Get the number of arguments available.
   overriding
   function Get_Count (List : in String_Argument_List) return Natural;

   --  Get the argument at the given position.
   overriding
   function Get_Argument (List : in String_Argument_List;
                          Pos  : in Positive) return String;

   --  Get the command name.
   overriding
   function Get_Command_Name (List : in String_Argument_List) return String;

   --  The argument list interface that gives access to command arguments.
   type Dynamic_Argument_List is limited new Argument_List with private;

   --  Get the number of arguments available.
   function Get_Count (List : in Dynamic_Argument_List) return Natural;

   --  Get the argument at the given position.
   function Get_Argument (List : in Dynamic_Argument_List;
                          Pos  : in Positive) return String;

   --  Get the command name.
   function Get_Command_Name (List : in Dynamic_Argument_List) return String;

private

   type Argument_Pos is array (Natural range <>) of Natural;

   type String_Argument_List (Max_Length : Positive;
                              Max_Args   : Positive) is new Argument_List
     with record
      Count     : Natural := 0;
      Length    : Natural := 0;
      Line      : String (1 .. Max_Length);
      Start_Pos : Argument_Pos (0 .. Max_Args) := (others => 0);
      End_Pos   : Argument_Pos (0 .. Max_Args) := (others => 0);
   end record;

   type Dynamic_Argument_List is limited new Argument_List with record
      List : Util.Strings.Vectors.Vector;
      Name : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Util.Commands;

Initialize the Start_Pos and End_Pos arrays by default in the String_Argument_List record


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

with Definitions; use Definitions;
private with Ada.Characters.Latin_1;
private with Parameters;

package Configure is

   menu_error : exception;

   --  Interactive configuration menu
   procedure launch_configure_menu;

   --  Print out configuration value
   --  If input not 'A' - 'Q', return "Error: Input must be character 'A'...'Q'"
   procedure print_configuration_value (option : Character);

private

   package LAT renames Ada.Characters.Latin_1;
   package PM  renames Parameters;

   indent : constant String (1 ..  3) := (others => LAT.Space);

   type option is range 1 .. 17;
   type default is range 1 .. 10;
   subtype ofield is String (1 .. 30);
   type desc_type is array (option) of ofield;
   type default_type is array (default) of ofield;

   descriptions : constant desc_type :=
     (
      "[A] System root directory     ",
      "[B] Toolchain directory       ",
      "[C] Localbase directory       ",
      "[D] Conspiracy directory      ",
      "[E] Custom ports directory    ",
      "[F] Distfiles directory       ",
      "[G] Profile directory (logs+) ",
      "[H] Packages directory        ",
      "[I] Compiler cache directory  ",
      "[J] Build base directory      ",
      "[K] Num. concurrent builders  ",
      "[L] Max. jobs per builder     ",
      "[M] Avoid use of tmpfs        ",
      "[N] Fetch prebuilt packages   ",
      "[O] Display using ncurses     ",
      "[P] Always record options     ",
      "[Q] Assume default options    "
     );

   version_desc : constant default_type :=
     (
      "[A] Firebird SQL server       ",
      "[B] Lua (language)            ",
      "[C] MySQL-workalike server    ",
      "[D] Perl (language)           ",
      "[E] PHP (language)            ",
      "[F] PostgreSQL server         ",
      "[G] Python 3 (language)       ",
      "[H] Ruby (language)           ",
      "[I] SSL/TLS library           ",
      "[J] TCL/TK toolkit            "
     );

   optX5A : constant String := "[V]   Set version defaults (e.g. perl, ruby, mysql ...)";
   optX1A : constant String := "[>]   Switch/create profiles (changes discarded)";
   optX1B : constant String := "[>]   Switch/create profiles";
   optX4B : constant String := "[<]   Delete alternative profile";
   optX2A : constant String := "[ESC] Exit without saving changes";
   optX3A : constant String := "[RET] Save changes (starred)  ";
   optX3B : constant String := "[RET] Exit  ";

   dupe   : PM.configuration_record;

   version_A : constant String := default_firebird & ":3.0";
   version_B : constant String := "5.2:" & default_lua & ":5.4";
   version_C : constant String := "oracle-5.7:" & default_mysql &
                                  "mariadb-10.3:mariadb-10.4:mariadb-10.5:mariadb-10.6:" &
                                  "mariadb-10.7:mariadb-10.8:mariadb-10.9:" &
                                  "percona-5.6:percona-5.7:percona-8.0";
   version_D : constant String := default_perl & ":5.36";
   version_E : constant String := "7.4:" & default_php & ":8.1";
   version_F : constant String := "10:11:" & default_pgsql & ":13:14";
   version_G : constant String := default_python3 & ":3.10";
   version_H : constant String := "2.7:" & default_ruby & ":3.1";
   version_I : constant String := "openssl10:openssl11:openssl30:" &
                                   default_ssl & ":libressl-devel";
   version_J : constant String := "8.5:" & default_tcltk;

   procedure clear_screen;
   procedure print_header;
   procedure print_opt (opt : option; pristine : in out Boolean);
   procedure change_directory_option (opt : option; pristine : in out Boolean);
   procedure change_boolean_option   (opt : option; pristine : in out Boolean);
   procedure change_positive_option  (opt : option; pristine : in out Boolean);
   procedure delete_profile;
   procedure switch_profile;
   procedure move_to_defaults_menu (pristine_def : in out Boolean);
   procedure print_default (def : default; pristine_def : in out Boolean);
   procedure update_version
     (def     : default;
      choices : String;
      label   : String);
   procedure print_menu
     (pristine       : in out Boolean;
      extra_profiles : Boolean;
      pristine_def   : Boolean);

end Configure;

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

with Definitions; use Definitions;
private with Ada.Characters.Latin_1;
private with Parameters;

package Configure is

   menu_error : exception;

   --  Interactive configuration menu
   procedure launch_configure_menu;

   --  Print out configuration value
   --  If input not 'A' - 'Q', return "Error: Input must be character 'A'...'Q'"
   procedure print_configuration_value (option : Character);

private

   package LAT renames Ada.Characters.Latin_1;
   package PM  renames Parameters;

   indent : constant String (1 ..  3) := (others => LAT.Space);

   type option is range 1 .. 17;
   type default is range 1 .. 10;
   subtype ofield is String (1 .. 30);
   type desc_type is array (option) of ofield;
   type default_type is array (default) of ofield;

   descriptions : constant desc_type :=
     (
      "[A] System root directory     ",
      "[B] Toolchain directory       ",
      "[C] Localbase directory       ",
      "[D] Conspiracy directory      ",
      "[E] Custom ports directory    ",
      "[F] Distfiles directory       ",
      "[G] Profile directory (logs+) ",
      "[H] Packages directory        ",
      "[I] Compiler cache directory  ",
      "[J] Build base directory      ",
      "[K] Num. concurrent builders  ",
      "[L] Max. jobs per builder     ",
      "[M] Avoid use of tmpfs        ",
      "[N] Fetch prebuilt packages   ",
      "[O] Display using ncurses     ",
      "[P] Always record options     ",
      "[Q] Assume default options    "
     );

   version_desc : constant default_type :=
     (
      "[A] Firebird SQL server       ",
      "[B] Lua (language)            ",
      "[C] MySQL-workalike server    ",
      "[D] Perl (language)           ",
      "[E] PHP (language)            ",
      "[F] PostgreSQL server         ",
      "[G] Python 3 (language)       ",
      "[H] Ruby (language)           ",
      "[I] SSL/TLS library           ",
      "[J] TCL/TK toolkit            "
     );

   optX5A : constant String := "[V]   Set version defaults (e.g. perl, ruby, mysql ...)";
   optX1A : constant String := "[>]   Switch/create profiles (changes discarded)";
   optX1B : constant String := "[>]   Switch/create profiles";
   optX4B : constant String := "[<]   Delete alternative profile";
   optX2A : constant String := "[ESC] Exit without saving changes";
   optX3A : constant String := "[RET] Save changes (starred)  ";
   optX3B : constant String := "[RET] Exit  ";

   dupe   : PM.configuration_record;

   version_A : constant String := default_firebird & ":3.0";
   version_B : constant String := "5.2:" & default_lua & ":5.4";
   version_C : constant String := "oracle-5.7:" & default_mysql & ":" &
                                  "mariadb-10.3:mariadb-10.4:mariadb-10.5:mariadb-10.6:" &
                                  "mariadb-10.7:mariadb-10.8:mariadb-10.9:" &
                                  "percona-5.6:percona-5.7:percona-8.0";
   version_D : constant String := default_perl & ":5.36";
   version_E : constant String := "7.4:" & default_php & ":8.1";
   version_F : constant String := "10:11:" & default_pgsql & ":13:14";
   version_G : constant String := default_python3 & ":3.10";
   version_H : constant String := "2.7:" & default_ruby & ":3.1";
   version_I : constant String := "openssl10:openssl11:openssl30:" &
                                   default_ssl & ":libressl-devel";
   version_J : constant String := "8.5:" & default_tcltk;

   procedure clear_screen;
   procedure print_header;
   procedure print_opt (opt : option; pristine : in out Boolean);
   procedure change_directory_option (opt : option; pristine : in out Boolean);
   procedure change_boolean_option   (opt : option; pristine : in out Boolean);
   procedure change_positive_option  (opt : option; pristine : in out Boolean);
   procedure delete_profile;
   procedure switch_profile;
   procedure move_to_defaults_menu (pristine_def : in out Boolean);
   procedure print_default (def : default; pristine_def : in out Boolean);
   procedure update_version
     (def     : default;
      choices : String;
      label   : String);
   procedure print_menu
     (pristine       : in out Boolean;
      extra_profiles : Boolean;
      pristine_def   : Boolean);

end Configure;

Fix mysql options

Fix mysql options