-----------------------------------------------------------------------
--  gen-model-tables -- Database table model representation
--  Copyright (C) 2009, 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.Strings;
with Util.Strings;
with Util.Log.Loggers;
package body Gen.Model.Tables is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Model.Tables");

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Column_Definition;
                       Name : String) return Util.Beans.Objects.Object is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
   begin

      if Name = "type" then
         declare
            T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
         begin
            if T = null then
               return Util.Beans.Objects.Null_Object;
            end if;
            return Util.Beans.Objects.To_Object (T.all'Access, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "index" then
         return Util.Beans.Objects.To_Object (From.Number);

      elsif Name = "isUnique" then
         return Util.Beans.Objects.To_Object (From.Unique);

      elsif Name = "isNull" then
         return Util.Beans.Objects.To_Object (not From.Not_Null);

      elsif Name = "isInserted" then
         return Util.Beans.Objects.To_Object (From.Is_Inserted);

      elsif Name = "isUpdated" then
         return Util.Beans.Objects.To_Object (From.Is_Updated);

      elsif Name = "sqlType" then
         if Length (From.Sql_Type) > 0 then
            return Util.Beans.Objects.To_Object (From.Sql_Type);
         end if;
         declare
            T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
         begin
            if T = null then
               return Util.Beans.Objects.Null_Object;
            end if;
            return T.Get_Value ("name");
         end;

      elsif Name = "sqlName" then
         return Util.Beans.Objects.To_Object (From.Sql_Name);

      elsif Name = "isVersion" then
         return Util.Beans.Objects.To_Object (From.Is_Version);

      elsif Name = "isReadable" then
         return Util.Beans.Objects.To_Object (From.Is_Readable);

      elsif Name = "isPrimaryKey" then
         return Util.Beans.Objects.To_Object (From.Is_Key);

      elsif Name = "isPrimitiveType" then
         return Util.Beans.Objects.To_Object (From.Is_Basic_Type);

      elsif Name = "generator" then
         return From.Generator;

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Returns true if the column type is a basic type.
   --  ------------------------------
   function Is_Basic_Type (From : in Column_Definition) return Boolean is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
      use type Gen.Model.Mappings.Basic_Type;

      T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
      Name : constant String := To_String (From.Type_Name);
   begin
      if T /= null then
         return T.Kind /= Gen.Model.Mappings.T_BLOB;
      end if;
      return Name = "int" or Name = "String"
        or Name = "ADO.Identifier" or Name = "Timestamp"
        or Name = "Integer"
        or Name = "long" or Name = "Long" or Name = "Date" or Name = "Time";
   end Is_Basic_Type;

   --  ------------------------------
   --  Returns the column type.
   --  ------------------------------
   function Get_Type (From : in Column_Definition) return String is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
      T : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
   begin
      if T /= null then
         return To_String (T.Target);
      else
         return To_String (From.Type_Name);
      end if;
   end Get_Type;

   --  ------------------------------
   --  Returns the column type mapping.
   --  ------------------------------
   function Get_Type_Mapping (From : in Column_Definition)
                              return Gen.Model.Mappings.Mapping_Definition_Access is
      use type Mappings.Mapping_Definition_Access;

      Result : Gen.Model.Mappings.Mapping_Definition_Access := null;
      Pos    : constant Natural := Ada.Strings.Unbounded.Index (From.Type_Name, ".");
   begin
      if Pos = 0 then
         Result := Gen.Model.Mappings.Find_Type (From.Type_Name);
      end if;
      if From.Type_Name = "Gen.Tests.Tables.Test_Enum" then
         Log.Debug ("Found enum");
      end if;
      if Result = null then
         Result := From.Table.Package_Def.Find_Type (From.Type_Name);
      end if;
      return Result;
   end Get_Type_Mapping;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Column_Definition) is
      use type Mappings.Mapping_Definition_Access;
   begin
--        O.Type_Mapping := Gen.Model.Mappings.Find_Type (O.Type_Name);
--        if O.Type_Mapping = null then
--           O.Type_Mapping := O.Table.Package_Def.Find_Type (O.Type_Name);
--        end if;
      null;
   end Prepare;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Association_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      return Column_Definition (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Table_Definition) is
   begin
      O.Members_Bean := Util.Beans.Objects.To_Object (O.Members'Unchecked_Access,
                                                      Util.Beans.Objects.STATIC);
      O.Operations_Bean := Util.Beans.Objects.To_Object (O.Operations'Unchecked_Access,
                                                         Util.Beans.Objects.STATIC);
   end Initialize;

   --  ------------------------------
   --  Create a table with the given name.
   --  ------------------------------
   function Create_Table (Name : in Unbounded_String) return Table_Definition_Access is
      Table : constant Table_Definition_Access := new Table_Definition;
   begin
      Table.Name := Name;
      declare
         Pos : constant Natural := Index (Table.Name, ".", Ada.Strings.Backward);
      begin
         if Pos > 0 then
            Table.Pkg_Name := Unbounded_Slice (Table.Name, 1, Pos - 1);
            Table.Type_Name := Unbounded_Slice (Table.Name, Pos + 1, Length (Table.Name));
         else
            Table.Pkg_Name := To_Unbounded_String ("ADO");
            Table.Type_Name := Table.Name;
         end if;
         Table.Table_Name := Table.Type_Name;
      end;
      return Table;
   end Create_Table;

   --  ------------------------------
   --  Create a table column with the given name and add it to the table.
   --  ------------------------------
   procedure Add_Column (Table  : in out Table_Definition;
                         Name   : in Unbounded_String;
                         Column : out Column_Definition_Access) is
   begin
      Column := new Column_Definition;
      Column.Name     := Name;
      Column.Sql_Name := Name;
      Column.Number   := Table.Members.Get_Count;
      Column.Table    := Table'Unchecked_Access;
      Table.Members.Append (Column);
      if Name = "version" then
         Table.Version_Column := Column;
         Column.Is_Version  := True;
         Column.Is_Updated  := False;
         Column.Is_Inserted := False;

      elsif Name = "id" then
         Table.Id_Column := Column;
         Column.Is_Key := True;

      end if;
   end Add_Column;

   --  ------------------------------
   --  Create a table association with the given name and add it to the table.
   --  ------------------------------
   procedure Add_Association (Table  : in out Table_Definition;
                              Name   : in Unbounded_String;
                              Assoc  : out Association_Definition_Access) is
   begin
      Assoc := new Association_Definition;
      Assoc.Name   := Name;
      Assoc.Number := Table.Members.Get_Count;
      Assoc.Table  := Table'Unchecked_Access;
      Table.Members.Append (Assoc.all'Access);
      Table.Has_Associations := True;
   end Add_Association;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Table_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "members" or Name = "columns" then
         return From.Members_Bean;

      elsif Name = "operations" then
         return From.Operations_Bean;

      elsif Name = "id" and From.Id_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access := From.Id_Column.all'Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "version" and From.Version_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access
              := From.Version_Column.all'Unchecked_Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "hasAssociations" then
         return Util.Beans.Objects.To_Object (From.Has_Associations);

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "table" then
         return Util.Beans.Objects.To_Object (From.Table_Name);

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Table_Definition) is
      Iter : Column_List.Cursor := O.Members.First;
   begin
      while Column_List.Has_Element (Iter) loop
         Column_List.Element (Iter).Prepare;
         Column_List.Next (Iter);
      end loop;
   end Prepare;

   --  ------------------------------
   --  Set the table name and determines the package name.
   --  ------------------------------
   procedure Set_Table_Name (Table : in out Table_Definition;
                             Name  : in String) is
      Pos : constant Natural := Util.Strings.Rindex (Name, '.');
   begin
      Table.Name := To_Unbounded_String (Name);
      if Pos > 0 then
         Table.Pkg_Name := To_Unbounded_String (Name (Name'First .. Pos - 1));
         Table.Type_Name := To_Unbounded_String (Name (Pos + 1 .. Name'Last));
      else
         Table.Pkg_Name := To_Unbounded_String ("ADO");
         Table.Type_Name := Table.Name;
      end if;
   end Set_Table_Name;

end Gen.Model.Tables;

-----------------------------------------------------------------------
--  gen-model-tables -- Database table model representation
--  Copyright (C) 2009, 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.Strings;
with Util.Strings;
with Util.Log.Loggers;
package body Gen.Model.Tables is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Model.Tables");

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Column_Definition;
                       Name : String) return Util.Beans.Objects.Object is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
   begin

      if Name = "type" then
         declare
            T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
         begin
            if T = null then
               return Util.Beans.Objects.Null_Object;
            end if;
            return Util.Beans.Objects.To_Object (T.all'Access, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "index" then
         return Util.Beans.Objects.To_Object (From.Number);

      elsif Name = "isUnique" then
         return Util.Beans.Objects.To_Object (From.Unique);

      elsif Name = "isNull" then
         return Util.Beans.Objects.To_Object (not From.Not_Null);

      elsif Name = "isInserted" then
         return Util.Beans.Objects.To_Object (From.Is_Inserted);

      elsif Name = "isUpdated" then
         return Util.Beans.Objects.To_Object (From.Is_Updated);

      elsif Name = "sqlType" then
         if Length (From.Sql_Type) > 0 then
            return Util.Beans.Objects.To_Object (From.Sql_Type);
         end if;
         declare
            T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
         begin
            if T = null then
               return Util.Beans.Objects.Null_Object;
            end if;
            return T.Get_Value ("name");
         end;

      elsif Name = "sqlName" then
         return Util.Beans.Objects.To_Object (From.Sql_Name);

      elsif Name = "isVersion" then
         return Util.Beans.Objects.To_Object (From.Is_Version);

      elsif Name = "isReadable" then
         return Util.Beans.Objects.To_Object (From.Is_Readable);

      elsif Name = "isPrimaryKey" then
         return Util.Beans.Objects.To_Object (From.Is_Key);

      elsif Name = "isPrimitiveType" then
         return Util.Beans.Objects.To_Object (From.Is_Basic_Type);

      elsif Name = "generator" then
         return From.Generator;

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Returns true if the column type is a basic type.
   --  ------------------------------
   function Is_Basic_Type (From : in Column_Definition) return Boolean is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
      use type Gen.Model.Mappings.Basic_Type;

      T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
      Name : constant String := To_String (From.Type_Name);
   begin
      if T /= null then
         return T.Kind /= Gen.Model.Mappings.T_BLOB;
      end if;
      return Name = "int" or Name = "String"
        or Name = "ADO.Identifier" or Name = "Timestamp"
        or Name = "Integer"
        or Name = "long" or Name = "Long" or Name = "Date" or Name = "Time";
   end Is_Basic_Type;

   --  ------------------------------
   --  Returns the column type.
   --  ------------------------------
   function Get_Type (From : in Column_Definition) return String is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
      T : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
   begin
      if T /= null then
         return To_String (T.Target);
      else
         return To_String (From.Type_Name);
      end if;
   end Get_Type;

   --  ------------------------------
   --  Returns the column type mapping.
   --  ------------------------------
   function Get_Type_Mapping (From : in Column_Definition)
                              return Gen.Model.Mappings.Mapping_Definition_Access is
      use type Mappings.Mapping_Definition_Access;

      Result : Gen.Model.Mappings.Mapping_Definition_Access := null;
      Pos    : constant Natural := Ada.Strings.Unbounded.Index (From.Type_Name, ".");
   begin
      if Pos = 0 then
         Result := Gen.Model.Mappings.Find_Type (From.Type_Name);
      end if;
      if From.Type_Name = "Gen.Tests.Tables.Test_Enum" then
         Log.Debug ("Found enum");
      end if;
      if Result = null then
         Result := From.Table.Package_Def.Find_Type (From.Type_Name);
      end if;
      return Result;
   end Get_Type_Mapping;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Column_Definition) is
      use type Mappings.Mapping_Definition_Access;
   begin
--        O.Type_Mapping := Gen.Model.Mappings.Find_Type (O.Type_Name);
--        if O.Type_Mapping = null then
--           O.Type_Mapping := O.Table.Package_Def.Find_Type (O.Type_Name);
--        end if;
      null;
   end Prepare;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Association_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      return Column_Definition (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Table_Definition) is
   begin
      O.Members_Bean := Util.Beans.Objects.To_Object (O.Members'Unchecked_Access,
                                                      Util.Beans.Objects.STATIC);
      O.Operations_Bean := Util.Beans.Objects.To_Object (O.Operations'Unchecked_Access,
                                                         Util.Beans.Objects.STATIC);
   end Initialize;

   --  ------------------------------
   --  Create a table with the given name.
   --  ------------------------------
   function Create_Table (Name : in Unbounded_String) return Table_Definition_Access is
      Table : constant Table_Definition_Access := new Table_Definition;
   begin
      Table.Name := Name;
      declare
         Pos : constant Natural := Index (Table.Name, ".", Ada.Strings.Backward);
      begin
         if Pos > 0 then
            Table.Pkg_Name := Unbounded_Slice (Table.Name, 1, Pos - 1);
            Table.Type_Name := Unbounded_Slice (Table.Name, Pos + 1, Length (Table.Name));
         else
            Table.Pkg_Name := To_Unbounded_String ("ADO");
            Table.Type_Name := Table.Name;
         end if;
         Table.Table_Name := Table.Type_Name;
      end;
      return Table;
   end Create_Table;

   --  ------------------------------
   --  Create a table column with the given name and add it to the table.
   --  ------------------------------
   procedure Add_Column (Table  : in out Table_Definition;
                         Name   : in Unbounded_String;
                         Column : out Column_Definition_Access) is
   begin
      Column := new Column_Definition;
      Column.Name     := Name;
      Column.Sql_Name := Name;
      Column.Number   := Table.Members.Get_Count;
      Column.Table    := Table'Unchecked_Access;
      Table.Members.Append (Column);
      if Name = "version" then
         Table.Version_Column := Column;
         Column.Is_Version  := True;
         Column.Is_Updated  := False;
         Column.Is_Inserted := False;

      elsif Name = "id" then
         Table.Id_Column := Column;
         Column.Is_Key := True;

      end if;
   end Add_Column;

   --  ------------------------------
   --  Create a table association with the given name and add it to the table.
   --  ------------------------------
   procedure Add_Association (Table  : in out Table_Definition;
                              Name   : in Unbounded_String;
                              Assoc  : out Association_Definition_Access) is
   begin
      Assoc := new Association_Definition;
      Assoc.Name   := Name;
      Assoc.Number := Table.Members.Get_Count;
      Assoc.Table  := Table'Unchecked_Access;
      Assoc.Sql_Name := Name;
      Table.Members.Append (Assoc.all'Access);
      Table.Has_Associations := True;
   end Add_Association;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Table_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "members" or Name = "columns" then
         return From.Members_Bean;

      elsif Name = "operations" then
         return From.Operations_Bean;

      elsif Name = "id" and From.Id_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access := From.Id_Column.all'Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "version" and From.Version_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access
              := From.Version_Column.all'Unchecked_Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "hasAssociations" then
         return Util.Beans.Objects.To_Object (From.Has_Associations);

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "table" then
         return Util.Beans.Objects.To_Object (From.Table_Name);

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Table_Definition) is
      Iter : Column_List.Cursor := O.Members.First;
   begin
      while Column_List.Has_Element (Iter) loop
         Column_List.Element (Iter).Prepare;
         Column_List.Next (Iter);
      end loop;
   end Prepare;

   --  ------------------------------
   --  Set the table name and determines the package name.
   --  ------------------------------
   procedure Set_Table_Name (Table : in out Table_Definition;
                             Name  : in String) is
      Pos : constant Natural := Util.Strings.Rindex (Name, '.');
   begin
      Table.Name := To_Unbounded_String (Name);
      if Pos > 0 then
         Table.Pkg_Name := To_Unbounded_String (Name (Name'First .. Pos - 1));
         Table.Type_Name := To_Unbounded_String (Name (Pos + 1 .. Name'Last));
      else
         Table.Pkg_Name := To_Unbounded_String ("ADO");
         Table.Type_Name := Table.Name;
      end if;
   end Set_Table_Name;

end Gen.Model.Tables;

Set the association sql name from the association name


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

package body Wiki.Attributes is

   --  ------------------------------
   --  Get the attribute name.
   --  ------------------------------
   function Get_Name (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Name;
   end Get_Name;

   --  ------------------------------
   --  Get the attribute value.
   --  ------------------------------
   function Get_Value (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Wiki.Strings.To_String (Attr.Value.Value);
   end Get_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Wide_Value (Position : in Cursor) return Wiki.Strings.WString is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Value;
   end Get_Wide_Value;

   --  ------------------------------
   --  Returns True if the cursor has a valid attribute.
   --  ------------------------------
   function Has_Element (Position : in Cursor) return Boolean is
   begin
      return Attribute_Vectors.Has_Element (Position.Pos);
   end Has_Element;

   --  ------------------------------
   --  Move the cursor to the next attribute.
   --  ------------------------------
   procedure Next (Position : in out Cursor) is
   begin
      Attribute_Vectors.Next (Position.Pos);
   end Next;

   --  ------------------------------
   --  Find the attribute with the given name.
   --  ------------------------------
   function Find (List : in Attribute_List;
                  Name : in String) return Cursor is
      Iter : Attribute_Vectors.Cursor := List.List.First;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         declare
            Attr : constant Attribute_Ref := Attribute_Vectors.Element (Iter);
         begin
            if Attr.Value.Name = Name then
               return Cursor '(Pos => Iter);
            end if;
         end;
         Attribute_Vectors.Next (Iter);
      end loop;
      return Cursor '(Pos => Iter);
   end Find;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Wiki.Strings.WString is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Wide_Value (Attr);
      else
         return "";
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in Wiki.Strings.WString;
                     Value : in Wiki.Strings.WString) is
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Value'Length,
                           Name         => Wiki.Strings.To_String (Name),
                           Value        => Value);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Wiki.Strings.WString) is
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Value'Length,
                           Name         => Name,
                           Value        => Value);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Wiki.Strings.UString) is
      Val  : constant Wiki.Strings.WString := Wiki.Strings.To_WString (Value);
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Val'Length,
                           Name         => Name,
                           Value        => Val);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Get the cursor to get access to the first attribute.
   --  ------------------------------
   function First (List : in Attribute_List) return Cursor is
   begin
      return Cursor '(Pos => List.List.First);
   end First;

   --  ------------------------------
   --  Get the number of attributes in the list.
   --  ------------------------------
   function Length (List : in Attribute_List) return Natural is
   begin
      return Natural (List.List.Length);
   end Length;

   --  ------------------------------
   --  Clear the list and remove all existing attributes.
   --  ------------------------------
   procedure Clear (List : in out Attribute_List) is
   begin
      List.List.Clear;
   end Clear;

   --  ------------------------------
   --  Iterate over the list attributes and call the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterate (List    : in Attribute_List;
                      Process : not null access procedure (Name  : in String;
                                                           Value : in Wiki.Strings.WString)) is
      Iter : Attribute_Vectors.Cursor := List.List.First;
      Item : Attribute_Ref;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         Item := Attribute_Vectors.Element (Iter);
         Process (Item.Value.Name, Item.Value.Value);
         Attribute_Vectors.Next (Iter);
      end loop;
   end Iterate;

   --  ------------------------------
   --  Finalize the attribute list releasing any storage.
   --  ------------------------------
   overriding
   procedure Finalize (List : in out Attribute_List) is
   begin
      List.Clear;
   end Finalize;

end Wiki.Attributes;

-----------------------------------------------------------------------
--  wiki-attributes -- Wiki document attributes
--  Copyright (C) 2015, 2016, 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.Attributes is

   --  ------------------------------
   --  Get the attribute name.
   --  ------------------------------
   function Get_Name (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Name;
   end Get_Name;

   --  ------------------------------
   --  Get the attribute value.
   --  ------------------------------
   function Get_Value (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Wiki.Strings.To_String (Attr.Value.Value);
   end Get_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Wide_Value (Position : in Cursor) return Wiki.Strings.WString is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Value;
   end Get_Wide_Value;

   --  ------------------------------
   --  Returns True if the cursor has a valid attribute.
   --  ------------------------------
   function Has_Element (Position : in Cursor) return Boolean is
   begin
      return Attribute_Vectors.Has_Element (Position.Pos);
   end Has_Element;

   --  ------------------------------
   --  Move the cursor to the next attribute.
   --  ------------------------------
   procedure Next (Position : in out Cursor) is
   begin
      Attribute_Vectors.Next (Position.Pos);
   end Next;

   --  ------------------------------
   --  Find the attribute with the given name.
   --  ------------------------------
   function Find (List : in Attribute_List;
                  Name : in String) return Cursor is
      Iter : Attribute_Vectors.Cursor := List.List.First;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         declare
            Attr : constant Attribute_Ref := Attribute_Vectors.Element (Iter);
         begin
            if Attr.Value.Name = Name then
               return Cursor '(Pos => Iter);
            end if;
         end;
         Attribute_Vectors.Next (Iter);
      end loop;
      return Cursor '(Pos => Iter);
   end Find;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Wiki.Strings.WString is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Wide_Value (Attr);
      else
         return "";
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in Wiki.Strings.WString;
                     Value : in Wiki.Strings.WString) is
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Value'Length,
                           Name         => Wiki.Strings.To_String (Name),
                           Value        => Value);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Wiki.Strings.WString) is
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Value'Length,
                           Name         => Name,
                           Value        => Value);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Wiki.Strings.UString) is
      Val  : constant Wiki.Strings.WString := Wiki.Strings.To_WString (Value);
   begin
      Append (List, Name, Val);
   end Append;

   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Wiki.Strings.BString) is

      procedure Append (Content : in Wiki.Strings.WString) is
      begin
         Append (List, Name, Content);
      end Append;

      procedure Append_Attribute is
         new Wiki.Strings.Wide_Wide_Builders.Get (Append);
   begin
      Append_Attribute (Value);
   end Append;

   --  ------------------------------
   --  Get the cursor to get access to the first attribute.
   --  ------------------------------
   function First (List : in Attribute_List) return Cursor is
   begin
      return Cursor '(Pos => List.List.First);
   end First;

   --  ------------------------------
   --  Get the number of attributes in the list.
   --  ------------------------------
   function Length (List : in Attribute_List) return Natural is
   begin
      return Natural (List.List.Length);
   end Length;

   --  ------------------------------
   --  Clear the list and remove all existing attributes.
   --  ------------------------------
   procedure Clear (List : in out Attribute_List) is
   begin
      List.List.Clear;
   end Clear;

   --  ------------------------------
   --  Iterate over the list attributes and call the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterate (List    : in Attribute_List;
                      Process : not null access procedure (Name  : in String;
                                                           Value : in Wiki.Strings.WString)) is
      Iter : Attribute_Vectors.Cursor := List.List.First;
      Item : Attribute_Ref;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         Item := Attribute_Vectors.Element (Iter);
         Process (Item.Value.Name, Item.Value.Value);
         Attribute_Vectors.Next (Iter);
      end loop;
   end Iterate;

   --  ------------------------------
   --  Finalize the attribute list releasing any storage.
   --  ------------------------------
   overriding
   procedure Finalize (List : in out Attribute_List) is
   begin
      List.Clear;
   end Finalize;

end Wiki.Attributes;

Add the Append procedure with a Builder string (optimized to avoid string copies!)


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

with Util.Strings;
with Util.Events;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Beans.Objects.Maps;

with ADO;

with AWA.Index_Arrays;

--  == Introduction ==
--  The AWA.Events package defines an event framework for modules to post events
--  and have Ada bean methods be invoked when these events are dispatched.  Subscription to
--  events is done through configuration files.  This allows to configure the modules and
--  integrate them together easily at configuration time.
--
--  === Declaration ===
--  Modules define the events that they can generate by instantiating the Definition
--  package. This is a static definition of the event.  Each event is given a unique name.
--
--    with AWA.Events.Definition;
--    ...
--    package Event_New_User is new AWA.Events.Definition ("new-user");
--
--  === Posting an event ===
--  The module can post an event to inform other modules or the system that a particular
--  action occurred.  The module creates the event instance of type Module_Event and
--  populates that event with useful properties for event receivers.
--
--    with AWA.Events;
--    ...
--    Event : AWA.Events.Module_Event;
--
--    Event.Set_Event_Kind (Event_New_User.Kind);
--    Event.Set_Parameter ("email", "harry.potter@hogwarts.org");
--
--  The module will post the event by using the Send_Event operation.
--
--    Manager.Send_Event (Event);
--
--  === Receiving an event ===
--  Modules or applications interested by a particular event will configure the event manager
--  to dispatch the event to an Ada bean event action.  The Ada bean is an object that must
--  implement a procedure that matches the prototype:
--
--    type Action_Bean is new Util.Beans.Basic.Readonly_Bean ...;
--    procedure Action (Bean : in out Action_Bean; Event : in AWA.Events.Module_Event'Class);
--
--  The Ada bean method and object are registered as other Ada beans.
--
--  The configuration file indicates how to bind the Ada bean action and the event together.
--  The action is specified using an EL Method Expression (See Ada EL or JSR 245).
--
--    <on-event name="new_user">
--        <action>#{ada_bean.action}</action>
--    </on-event>
--
--  === Event queues and dispatchers ===
--  The *AWA.Events* framework posts events on queues and it uses a dispatcher to process them.
--  There are two kinds of dispatchers:
--
--    * Synchronous dispatcher process the event when it is posted.  The task which posts
--      the event invokes the Ada bean action.  In this dispatching mode, there is no event queue.
--      If the action method raises an exception, it will however be blocked.
--
--    * Asynchronous dispatcher are executed by dedicated tasks.  The event is put in an event
--      queue.  A dispatcher task processes the event and invokes the action method at a later
--      time.
--
--  When the event is queued, there are two types of event queues:
--
--    * A Fifo memory queue manages the event and dispatches them in FIFO order.
--      If the application is stopped, the events present in the Fifo queue are lost.
--
--    * A persistent event queue manages the event in a similar way as the FIFO queue but
--      saves them in the database.  If the application is stopped, events that have not yet
--      been processed will be dispatched when the application is started again.
--
--  == Data Model ==
--  [images/awa_events_model.png]
--
package AWA.Events is

   type Queue_Index is new Natural;
   type Event_Index is new Natural;

   package Event_Arrays is new AWA.Index_Arrays (Event_Index, String);

   use type Event_Arrays.Element_Type_Access;
   subtype Name_Access is Event_Arrays.Element_Type_Access;

   generic
   package Definition renames Event_Arrays.Definition;

   --  Exception raised if an event name is not found.
   Not_Found : exception renames Event_Arrays.Not_Found;

   --  Identifies an invalid event.
   -- Invalid_Event : constant Event_Index := 0;

   --  Find the event runtime index given the event name.
   --  Raises Not_Found exception if the event name is not recognized.
   function Find_Event_Index (Name : in String) return Event_Index renames Event_Arrays.Find;

   --  ------------------------------
   --  Module event
   --  ------------------------------
   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with private;
   type Module_Event_Access is access all Module_Event'Class;

   --  Set the event type which identifies the event.
   procedure Set_Event_Kind (Event : in out Module_Event;
                             Kind  : in Event_Index);

   --  Get the event type which identifies the event.
   function Get_Event_Kind (Event : in Module_Event) return Event_Index;

   --  Set a parameter on the message.
   procedure Set_Parameter (Event  : in out Module_Event;
                            Name   : in String;
                            Value  : in String);

   --  Get the parameter with the given name.
   function Get_Parameter (Event : in Module_Event;
                           Name  : in String) return String;

   --  Get the value that corresponds to the parameter with the given name.
   overriding
   function Get_Value (Event : in Module_Event;
                       Name  : in String) return Util.Beans.Objects.Object;

   --  Get the entity identifier associated with the event.
   function Get_Entity_Identifier (Event : in Module_Event) return ADO.Identifier;

   --  Set the entity identifier associated with the event.
   procedure Set_Entity_Identifier (Event : in out Module_Event;
                                    Id    : in ADO.Identifier);

   --  Copy the event properties to the map passed in <tt>Into</tt>.
   procedure Copy (Event : in Module_Event;
                   Into  : in out Util.Beans.Objects.Maps.Map);

private

   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with record
      Kind        : Event_Index := Event_Arrays.Invalid_Index;
      Props       : Util.Beans.Objects.Maps.Map;
      Entity      : ADO.Identifier  := ADO.NO_IDENTIFIER;
      Entity_Type : ADO.Entity_Type := ADO.NO_ENTITY_TYPE;
   end record;

   --  The index of the last event definition.
   --  Last_Event : Event_Index := 0;

   --  Get the event type name.
   function Get_Event_Type_Name (Index : in Event_Index) return Name_Access
                                 renames Event_Arrays.Get_Element;

   --  Make and return a copy of the event.
   function Copy (Event : in Module_Event) return Module_Event_Access;

end AWA.Events;

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

with Util.Events;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Beans.Objects.Maps;

with ADO;

with AWA.Index_Arrays;

--  == Introduction ==
--  The AWA.Events package defines an event framework for modules to post events
--  and have Ada bean methods be invoked when these events are dispatched.  Subscription to
--  events is done through configuration files.  This allows to configure the modules and
--  integrate them together easily at configuration time.
--
--  === Declaration ===
--  Modules define the events that they can generate by instantiating the Definition
--  package. This is a static definition of the event.  Each event is given a unique name.
--
--    with AWA.Events.Definition;
--    ...
--    package Event_New_User is new AWA.Events.Definition ("new-user");
--
--  === Posting an event ===
--  The module can post an event to inform other modules or the system that a particular
--  action occurred.  The module creates the event instance of type Module_Event and
--  populates that event with useful properties for event receivers.
--
--    with AWA.Events;
--    ...
--    Event : AWA.Events.Module_Event;
--
--    Event.Set_Event_Kind (Event_New_User.Kind);
--    Event.Set_Parameter ("email", "harry.potter@hogwarts.org");
--
--  The module will post the event by using the Send_Event operation.
--
--    Manager.Send_Event (Event);
--
--  === Receiving an event ===
--  Modules or applications interested by a particular event will configure the event manager
--  to dispatch the event to an Ada bean event action.  The Ada bean is an object that must
--  implement a procedure that matches the prototype:
--
--    type Action_Bean is new Util.Beans.Basic.Readonly_Bean ...;
--    procedure Action (Bean : in out Action_Bean; Event : in AWA.Events.Module_Event'Class);
--
--  The Ada bean method and object are registered as other Ada beans.
--
--  The configuration file indicates how to bind the Ada bean action and the event together.
--  The action is specified using an EL Method Expression (See Ada EL or JSR 245).
--
--    <on-event name="new_user">
--        <action>#{ada_bean.action}</action>
--    </on-event>
--
--  === Event queues and dispatchers ===
--  The *AWA.Events* framework posts events on queues and it uses a dispatcher to process them.
--  There are two kinds of dispatchers:
--
--    * Synchronous dispatcher process the event when it is posted.  The task which posts
--      the event invokes the Ada bean action.  In this dispatching mode, there is no event queue.
--      If the action method raises an exception, it will however be blocked.
--
--    * Asynchronous dispatcher are executed by dedicated tasks.  The event is put in an event
--      queue.  A dispatcher task processes the event and invokes the action method at a later
--      time.
--
--  When the event is queued, there are two types of event queues:
--
--    * A Fifo memory queue manages the event and dispatches them in FIFO order.
--      If the application is stopped, the events present in the Fifo queue are lost.
--
--    * A persistent event queue manages the event in a similar way as the FIFO queue but
--      saves them in the database.  If the application is stopped, events that have not yet
--      been processed will be dispatched when the application is started again.
--
--  == Data Model ==
--  [images/awa_events_model.png]
--
package AWA.Events is

   type Queue_Index is new Natural;
   type Event_Index is new Natural;

   package Event_Arrays is new AWA.Index_Arrays (Event_Index, String);

   use type Event_Arrays.Element_Type_Access;
   subtype Name_Access is Event_Arrays.Element_Type_Access;

   generic
   package Definition renames Event_Arrays.Definition;

   --  Exception raised if an event name is not found.
   Not_Found : exception renames Event_Arrays.Not_Found;

   --  Find the event runtime index given the event name.
   --  Raises Not_Found exception if the event name is not recognized.
   function Find_Event_Index (Name : in String) return Event_Index renames Event_Arrays.Find;

   --  ------------------------------
   --  Module event
   --  ------------------------------
   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with private;
   type Module_Event_Access is access all Module_Event'Class;

   --  Set the event type which identifies the event.
   procedure Set_Event_Kind (Event : in out Module_Event;
                             Kind  : in Event_Index);

   --  Get the event type which identifies the event.
   function Get_Event_Kind (Event : in Module_Event) return Event_Index;

   --  Set a parameter on the message.
   procedure Set_Parameter (Event  : in out Module_Event;
                            Name   : in String;
                            Value  : in String);

   --  Get the parameter with the given name.
   function Get_Parameter (Event : in Module_Event;
                           Name  : in String) return String;

   --  Get the value that corresponds to the parameter with the given name.
   overriding
   function Get_Value (Event : in Module_Event;
                       Name  : in String) return Util.Beans.Objects.Object;

   --  Get the entity identifier associated with the event.
   function Get_Entity_Identifier (Event : in Module_Event) return ADO.Identifier;

   --  Set the entity identifier associated with the event.
   procedure Set_Entity_Identifier (Event : in out Module_Event;
                                    Id    : in ADO.Identifier);

   --  Copy the event properties to the map passed in <tt>Into</tt>.
   procedure Copy (Event : in Module_Event;
                   Into  : in out Util.Beans.Objects.Maps.Map);

private

   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with record
      Kind        : Event_Index := Event_Arrays.Invalid_Index;
      Props       : Util.Beans.Objects.Maps.Map;
      Entity      : ADO.Identifier  := ADO.NO_IDENTIFIER;
      Entity_Type : ADO.Entity_Type := ADO.NO_ENTITY_TYPE;
   end record;

   --  The index of the last event definition.
   --  Last_Event : Event_Index := 0;

   --  Get the event type name.
   function Get_Event_Type_Name (Index : in Event_Index) return Name_Access
                                 renames Event_Arrays.Get_Element;

   --  Make and return a copy of the event.
   function Copy (Event : in Module_Event) return Module_Event_Access;

end AWA.Events;

Fix compilation warnings

Fix compilation warnings


-----------------------------------------------------------------------
--  bbox -- Bbox API
--  Copyright (C) 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 Util.Properties.JSON;
with Util.Log.Loggers;
with Util.Strings;
package body Bbox.API is

   use Ada.Strings.Unbounded;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bbox.API");

   function Strip_Unecessary_Array (Content : in String) return String;

   --  ------------------------------
   --  Set the server IP address.
   --  ------------------------------
   procedure Set_Server (Client : in out Client_Type;
                         Server : in String) is
   begin
      Log.Debug ("Using bbox server {0}", Server);
      Client.Server := Ada.Strings.Unbounded.To_Unbounded_String (Server);
   end Set_Server;

   --  ------------------------------
   --  Internal operation to get the URI based on the operation being called.
   --  ------------------------------
   function Get_URI (Client    : in Client_Type;
                     Operation : in String) return String is
   begin
      return "http://" & To_String (Client.Server) & "/api/v1/" & Operation;
   end Get_URI;

   --  ------------------------------
   --  Login to the server Bbox API with the password.
   --  ------------------------------
   procedure Login (Client   : in out Client_Type;
                    Password : in String) is
      procedure Process (Name, Value : in String);

      URI      : constant String := Client.Get_URI ("login");
      Response : Util.Http.Clients.Response;

      procedure Process (Name, Value : in String) is
         Pos, Last : Natural;
      begin
         if Name = "Set-Cookie" then
            Pos := Util.Strings.Index (Value, '=');
            if Pos = 0 then
               return;
            end if;
            Last := Util.Strings.Index (Value, ';');
            if Last = 0 or else Last < Pos then
               return;
            end if;
            Client.Http.Set_Header ("Cookie", Value (Value'First .. Last - 1));
         end if;
      end Process;

   begin
      Log.Debug ("Login to {0}", URI);
      Client.Http.Add_Header ("X-Requested-By", "Bbox Ada Api");
      Client.Http.Post (URI, "password=" & Password, Response);
      if Response.Get_Status = Util.Http.SC_OK then
         Response.Iterate_Headers (Process'Access);
      else
         Log.Error ("Connection and login to {0} failed", URI);
      end if;
   end Login;

   --  ------------------------------
   --  Strip [] for some Json content.
   --  We did a mistake when we designed the Bbox API and used '[' ... ']' arrays
   --  for most of the JSON result.  Strip that unecessary array.
   --  ------------------------------
   function Strip_Unecessary_Array (Content : in String) return String is
      Last      : Natural := Content'Last;
   begin
      while Last > Content'First and Content (Last) = ASCII.LF loop
         Last := Last - 1;
      end loop;
      if Content (Content'First) = '[' and Content (Last) = ']' then
         return Content (Content'First + 1 .. Last - 1);
      else
         return Content;
      end if;
   end Strip_Unecessary_Array;

   --  ------------------------------
   --  Execute a GET operation on the Bbox API to retrieve the result into the property list.
   --  ------------------------------
   procedure Get (Client    : in out Client_Type;
                  Operation : in String;
                  Result    : in out Util.Properties.Manager) is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Get {0}", URI);
      Client.Http.Get (URI, Response);
      Util.Properties.JSON.Parse_JSON (Result, Strip_Unecessary_Array (Response.Get_Body));
   end Get;

   --  ------------------------------
   --  Execute a GET operation on the Bbox API to retrieve the JSON result and return it.
   --  ------------------------------
   function Get (Client    : in out Client_Type;
                 Operation : in String) return String is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Get {0}", URI);
      Client.Http.Get (URI, Response);
      return Response.Get_Body;
   end Get;

   --  ------------------------------
   --  Execute a PUT operation on the Bbox API to change some parameter.
   --  ------------------------------
   procedure Put (Client    : in out Client_Type;
                  Operation : in String;
                  Params    : in String) is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Put {0}", URI);
      Client.Http.Put (URI, Params, Response);
   end Put;

end Bbox.API;

-----------------------------------------------------------------------
--  bbox -- Bbox API
--  Copyright (C) 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 Util.Properties.JSON;
with Util.Log.Loggers;
with Util.Strings;
with Util.Properties.Basic;
package body Bbox.API is

   use Ada.Strings.Unbounded;

   package Int_Property renames Util.Properties.Basic.Integer_Property;
   package Bool_Property renames Util.Properties.Basic.Boolean_Property;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bbox.API");

   function Strip_Unecessary_Array (Content : in String) return String;

   --  ------------------------------
   --  Set the server IP address.
   --  ------------------------------
   procedure Set_Server (Client : in out Client_Type;
                         Server : in String) is
   begin
      Log.Debug ("Using bbox server {0}", Server);
      Client.Server := Ada.Strings.Unbounded.To_Unbounded_String (Server);
   end Set_Server;

   --  ------------------------------
   --  Internal operation to get the URI based on the operation being called.
   --  ------------------------------
   function Get_URI (Client    : in Client_Type;
                     Operation : in String) return String is
   begin
      return "http://" & To_String (Client.Server) & "/api/v1/" & Operation;
   end Get_URI;

   --  ------------------------------
   --  Login to the server Bbox API with the password.
   --  ------------------------------
   procedure Login (Client   : in out Client_Type;
                    Password : in String) is
      procedure Process (Name, Value : in String);

      URI      : constant String := Client.Get_URI ("login");
      Response : Util.Http.Clients.Response;

      procedure Process (Name, Value : in String) is
         Pos, Last : Natural;
      begin
         if Name = "Set-Cookie" then
            Pos := Util.Strings.Index (Value, '=');
            if Pos = 0 then
               return;
            end if;
            Last := Util.Strings.Index (Value, ';');
            if Last = 0 or else Last < Pos then
               return;
            end if;
            Client.Http.Set_Header ("Cookie", Value (Value'First .. Last - 1));
            Client.Is_Logged := True;
         end if;
      end Process;

   begin
      Log.Debug ("Login to {0}", URI);
      Client.Is_Logged := False;
      Client.Http.Set_Header ("Cookie", "");
      Client.Http.Add_Header ("X-Requested-By", "Bbox Ada Api");
      Client.Http.Set_Timeout (10.0);
      Client.Http.Post (URI, "password=" & Password, Response);
      if Response.Get_Status = Util.Http.SC_OK then
         Response.Iterate_Headers (Process'Access);
      else
         Log.Error ("Connection and login to {0} failed", URI);
      end if;
   end Login;

   --  ------------------------------
   --  Strip [] for some Json content.
   --  We did a mistake when we designed the Bbox API and used '[' ... ']' arrays
   --  for most of the JSON result.  Strip that unecessary array.
   --  ------------------------------
   function Strip_Unecessary_Array (Content : in String) return String is
      Last      : Natural := Content'Last;
   begin
      while Last > Content'First and Content (Last) = ASCII.LF loop
         Last := Last - 1;
      end loop;
      if Content (Content'First) = '[' and Content (Last) = ']' then
         return Content (Content'First + 1 .. Last - 1);
      else
         return Content;
      end if;
   end Strip_Unecessary_Array;

   --  ------------------------------
   --  Execute a GET operation on the Bbox API to retrieve the result into the property list.
   --  ------------------------------
   procedure Get (Client    : in out Client_Type;
                  Operation : in String;
                  Result    : in out Util.Properties.Manager) is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Get {0}", URI);
      Client.Http.Set_Timeout (10.0);
      Client.Http.Get (URI, Response);
      Util.Properties.JSON.Parse_JSON (Result, Strip_Unecessary_Array (Response.Get_Body));
   end Get;

   --  ------------------------------
   --  Execute a GET operation on the Bbox API to retrieve the JSON result and return it.
   --  ------------------------------
   function Get (Client    : in out Client_Type;
                 Operation : in String) return String is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Get {0}", URI);
      Client.Http.Set_Timeout (10.0);
      Client.Http.Get (URI, Response);
      return Response.Get_Body;
   end Get;

   --  ------------------------------
   --  Execute a PUT operation on the Bbox API to change some parameter.
   --  ------------------------------
   procedure Put (Client    : in out Client_Type;
                  Operation : in String;
                  Params    : in String) is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Put {0}", URI);
      Client.Http.Set_Timeout (10.0);
      Client.Http.Put (URI, Params, Response);
   end Put;

   procedure Refresh_Token (Client : in out Client_Type) is
      use type Ada.Calendar.Time;

      Now      : constant Ada.Calendar.Time := Ada.Calendar.Clock;
      Response : Util.Http.Clients.Response;
      Tokens   : Util.Properties.Manager;
   begin
      if Length (Client.Token) /= 0 and then Client.Expires > Now then
         return;
      end if;
      Log.Debug ("Get bbox token");
      Client.Http.Set_Timeout (10.0);
      Client.Http.Get (Client.Get_URI ("device/token"), Response);
      Util.Properties.JSON.Parse_JSON (Tokens, Strip_Unecessary_Array (Response.Get_Body));
      Client.Token := To_Unbounded_String (Tokens.Get ("device.token", ""));
      Client.Expires := Ada.Calendar.Clock + 60.0;
   end Refresh_Token;

   --  Execute a POST operation on the Bbox API to change some parameter.
   procedure Post (Client    : in out Client_Type;
                   Operation : in String;
                   Params    : in String) is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Post {0}", URI);
      Client.Refresh_Token;
      Client.Http.Set_Timeout (10.0);
      Client.Http.Post (URI & "?btoken=" & To_String (Client.Token), Params, Response);
   end Post;

   --  Iterate over a JSON array flattened in the properties.
   procedure Iterate (Props : in Util.Properties.Manager;
                      Name  : in String;
                      Process : access procedure (P : in Util.Properties.Manager;
                                                  Base : in String)) is
      Count : constant Integer := Int_Property.Get (Props, Name & ".length", 0);
   begin
      for I in 0 .. Count loop
         declare
            Base : constant String := Name & "." & Util.Strings.Image (I);
         begin
            Process (Props, Base);
         end;
      end loop;
   end Iterate;

end Bbox.API;

Implement the Iterate, Refresh_Token, Iterate operations


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

with HelperText;

package body Display is

   package  HT renames HelperText;

   --------------------------------------------------------------------------------------------
   --  insert_history
   --------------------------------------------------------------------------------------------
   procedure insert_history (HR : history_rec) is
   begin
      if history_arrow = cyclic_range'Last then
         history_arrow := cyclic_range'First;
      else
         history_arrow := history_arrow + 1;
      end if;
      history (history_arrow) := HR;
   end insert_history;

   ------------------------------------------------------------------------
   --  fmtpc
   ------------------------------------------------------------------------
   function fmtpc (f : Float; percent : Boolean) return fivelong
   is
      type loadtype is delta 0.01 digits 4;
      result : fivelong := (others => ' ');
      raw1   : constant loadtype := loadtype (f);
      raw2   : constant String := raw1'Img;
      raw3   : constant String := raw2 (2 .. raw2'Last);
      rlen   : constant Natural := raw3'Length;
      start  : constant Natural := 6 - rlen;
   begin
      result (start .. 5) := raw3;
      if percent then
         result (5) := '%';
      end if;
      return result;
   end fmtpc;

   ------------------------------------------------------------------------
   --  fmtload
   ------------------------------------------------------------------------
   function fmtload (f : Float) return fivelong
   is
      type loadtype is delta 0.01 digits 4;
      result : fivelong := (others => ' ');
   begin
      if f < 100.0 then
         return fmtpc (f, False);
      elsif f < 1000.0 then
         declare
            type loadtype is delta 0.1 digits 4;
            raw1 : constant loadtype := loadtype (f);
         begin
            return HT.trim (raw1'Img);
         end;
      elsif f < 10000.0 then
         declare
            raw1 : constant Integer := Integer (f);
         begin
            --  preceded by space, 1000.0 .. 9999.99, should be 5 chars
            return raw1'Image;
         end;
      elsif f < 100000.0 then
         declare
            raw1 : constant Integer := Integer (f);
         begin
            --  100000.0 .. 99999.9
            return HT.trim (raw1'Img);
         end;
      else
         return "100k+";
      end if;
   exception
      when others =>
         return "ERROR";
   end fmtload;

end Display;

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

with HelperText;

package body Display is

   package  HT renames HelperText;

   --------------------------------------------------------------------------------------------
   --  insert_history
   --------------------------------------------------------------------------------------------
   procedure insert_history (HR : history_rec) is
   begin
      if history_arrow = cyclic_range'Last then
         history_arrow := cyclic_range'First;
      else
         history_arrow := history_arrow + 1;
      end if;
      history (history_arrow) := HR;
   end insert_history;

   ------------------------------------------------------------------------
   --  fmtpc
   ------------------------------------------------------------------------
   function fmtpc (f : Float; percent : Boolean) return fivelong
   is
      type loadtype is delta 0.01 digits 4;
      result : fivelong := (others => ' ');
      raw1   : constant loadtype := loadtype (f);
      raw2   : constant String := raw1'Img;
      raw3   : constant String := raw2 (2 .. raw2'Last);
      rlen   : constant Natural := raw3'Length;
      start  : constant Natural := 6 - rlen;
   begin
      result (start .. 5) := raw3;
      if percent then
         result (5) := '%';
      end if;
      return result;
   end fmtpc;

   ------------------------------------------------------------------------
   --  fmtload
   ------------------------------------------------------------------------
   function fmtload (f : Float) return fivelong
   is
      type loadtype is delta 0.01 digits 4;
      result : fivelong := (others => ' ');
   begin
      if f < 100.0 then
         return fmtpc (f, False);
      elsif f < 1000.0 then
         declare
            type loadtype is delta 0.1 digits 4;
            raw1 : constant loadtype := loadtype (f);
         begin
            return HT.trim (raw1'Img);
         end;
      elsif f < 10000.0 then
         declare
            raw1 : constant Integer := Integer (f);
         begin
            --  preceded by space, 1000.0 .. 9999.99, should be 5 chars
            return raw1'Img;
         end;
      elsif f < 100000.0 then
         declare
            raw1 : constant Integer := Integer (f);
         begin
            --  100000.0 .. 99999.9
            return HT.trim (raw1'Img);
         end;
      else
         return "100k+";
      end if;
   exception
      when others =>
         return "ERROR";
   end fmtload;

end Display;

Fix typo (caught by gcc6!)

Fix typo (caught by gcc6!)