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

with MAT.Readers.Marshaller;
package body MAT.Events.Probes is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Events.Probes");

   procedure Read_Probe (Client : in out Probe_Manager_Type;
                         Msg    : in out MAT.Readers.Message_Type);

   P_TIME_SEC         : constant MAT.Events.Internal_Reference := 0;
   P_TIME_USEC        : constant MAT.Events.Internal_Reference := 1;
   P_THREAD_ID        : constant MAT.Events.Internal_Reference := 2;
   P_THREAD_SP        : constant MAT.Events.Internal_Reference := 3;
   P_RUSAGE_MINFLT    : constant MAT.Events.Internal_Reference := 4;
   P_RUSAGE_MAJFLT    : constant MAT.Events.Internal_Reference := 5;
   P_RUSAGE_NVCSW     : constant MAT.Events.Internal_Reference := 6;
   P_RUSAGE_NIVCSW    : constant MAT.Events.Internal_Reference := 7;
   P_FRAME            : constant MAT.Events.Internal_Reference := 8;
   P_FRAME_PC         : constant MAT.Events.Internal_Reference := 9;

   TIME_SEC_NAME      : aliased constant String := "time-sec";
   TIME_USEC_NAME     : aliased constant String := "time-usec";
   THREAD_ID_NAME     : aliased constant String := "thread-id";
   THREAD_SP_NAME     : aliased constant String := "thread-sp";
   RUSAGE_MINFLT_NAME : aliased constant String := "ru-minflt";
   RUSAGE_MAJFLT_NAME : aliased constant String := "ru-majflt";
   RUSAGE_NVCSW_NAME  : aliased constant String := "ru-nvcsw";
   RUSAGE_NIVCSW_NAME : aliased constant String := "ru-nivcsw";
   FRAME_NAME         : aliased constant String := "frame";
   FRAME_PC_NAME      : aliased constant String := "frame-pc";

   Probe_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => TIME_SEC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_TIME_SEC),
      2 => (Name => TIME_USEC_NAME'Access,
             Size => 0,
             Kind => MAT.Events.T_SIZE_T,
             Ref  => P_TIME_USEC),
      3 => (Name => THREAD_ID_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_ID),
      4 => (Name => THREAD_SP_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_SP),
      5 => (Name => FRAME_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME),
      6 => (Name => FRAME_PC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME_PC),
      7 => (Name => RUSAGE_MINFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MINFLT),
      8 => (Name => RUSAGE_MAJFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MAJFLT),
      9 => (Name => RUSAGE_NVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NVCSW),
      10 => (Name => RUSAGE_NIVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NIVCSW)
     );

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type is
   begin
      return Ada.Containers.Hash_Type (Key);
   end Hash;

   --  ------------------------------
   --  Update the Size and Prev_Id information in the event identified by <tt>Id</tt>.
   --  Update the event represented by <tt>Prev_Id</tt> so that its Next_Id refers
   --  to the <tt>Id</tt> event.
   --  ------------------------------
   procedure Update_Event (Probe   : in Probe_Type;
                           Id      : in MAT.Events.Event_Id_Type;
                           Size    : in MAT.Types.Target_Size;
                           Prev_Id : in MAT.Events.Event_Id_Type) is
   begin
      Probe.Owner.Get_Target_Events.Update_Event (Id, Size, Prev_Id);
   end Update_Event;

   --  ------------------------------
   --  Initialize the manager instance.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out Probe_Manager_Type) is
   begin
      Manager.Events := new MAT.Events.Targets.Target_Events;
      Manager.Frames := MAT.Frames.Create_Root;
   end Initialize;

   --  ------------------------------
   --  Register the probe to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   --  ------------------------------
   procedure Register_Probe (Into   : in out Probe_Manager_Type;
                             Probe  : in Probe_Type_Access;
                             Name   : in String;
                             Id     : in MAT.Events.Probe_Index_Type;
                             Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Probe_Handler;
   begin
      Handler.Probe := Probe;
      Handler.Id    := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Probes.Insert (Name, Handler);
      Probe.Owner := Into'Unchecked_Access;
   end Register_Probe;

   --  ------------------------------
   --  Get the target events.
   --  ------------------------------
   function Get_Target_Events (Client : in Probe_Manager_Type)
                               return MAT.Events.Targets.Target_Events_Access is
   begin
      return Client.Events;
   end Get_Target_Events;

   procedure Read_Probe (Client : in out Probe_Manager_Type;
                         Msg    : in out MAT.Readers.Message) is
      use type MAT.Types.Target_Tick_Ref;

      Count     : Natural := 0;
      Time_Sec  : MAT.Types.Uint32  := 0;
      Time_Usec : MAT.Types.Uint32 := 0;
      Frame     : constant access MAT.Events.Frame_Info := Client.Frame;
   begin
      Client.Event.Thread := 0;
      Frame.Stack  := 0;
      Frame.Cur_Depth := 0;
      for I in Client.Probe'Range loop
         declare
            Def : MAT.Events.Attribute renames Client.Probe (I);
         begin
            case Def.Ref is
               when P_TIME_SEC =>
                  Time_Sec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind);

               when P_TIME_USEC =>
                  Time_Usec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind);

               when P_THREAD_ID =>
                  Client.Event.Thread := MAT.Types.Target_Thread_Ref
                    (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind));

               when P_THREAD_SP =>
                  Frame.Stack := MAT.Readers.Marshaller.Get_Target_Addr (Msg, Def.Kind);

               when P_FRAME =>
                  Count := Natural (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg,
                                    Def.Kind));

               when P_FRAME_PC =>
                  for I in 1 .. Count loop --  reverse Count .. 1 loop
                     if Count < Frame.Depth then
                        Frame.Frame (Count - I + 1) := MAT.Readers.Marshaller.Get_Target_Addr (Msg,
                                                                                Def.Kind);
                     end if;
                  end loop;

               when others =>
                  null;

            end case;
         end;
      end loop;
      --  Convert the time in usec to make computation easier.
      Client.Event.Time := MAT.Types.Target_Tick_Ref (Time_Sec) * 1_000_000;
      Client.Event.Time := Client.Event.Time + MAT.Types.Target_Tick_Ref (Time_Usec);
      Frame.Cur_Depth := Count;

   exception
      when E : others =>
         Log.Error ("Marshaling error, frame count {0}", Natural'Image (Count));
         raise;

   end Read_Probe;

   procedure Dispatch_Message (Client : in out Probe_Manager_Type;
                               Msg    : in out MAT.Readers.Message_Type) is
      use type MAT.Events.Attribute_Table_Ptr;
      use type MAT.Events.Targets.Target_Events_Access;

      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      if Log.Get_Level = Util.Log.DEBUG_LEVEL then
         Log.Debug ("Dispatch message {0} - size {1}",
                    MAT.Types.Uint16'Image (Event),
                    Natural'Image (Msg.Size));
      end if;

      if not Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         if Client.Probe /= null then
            Read_Probe (Client, Msg);
         end if;
         declare
            Handler : constant Probe_Handler := Handler_Maps.Element (Pos);
         begin
            Client.Event.Event := Event;
            Client.Event.Index := Handler.Id;
            Handler.Probe.Extract (Handler.Mapping.all'Access, Msg, Client.Event);
            MAT.Frames.Insert (Frame  => Client.Frames,
                               Pc     => Client.Frame.Frame (1 .. Client.Frame.Cur_Depth),
                               Result => Client.Event.Frame);
            Client.Events.Insert (Client.Event);
            Handler.Probe.Execute (Client.Event);
         end;
      end if;

   exception
      when E : others =>
         Log.Error ("Exception while processing event " & MAT.Types.Uint16'Image (Event), E, True);
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Probe_Manager_Type;
                              Msg    : in out MAT.Readers.Message_Type) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Probe_Maps.Cursor := Client.Probes.Find (Name);
      Frame : Probe_Handler;

      procedure Add_Handler (Key     : in String;
                             Element : in out Probe_Handler);

      procedure Add_Handler (Key     : in String;
                             Element : in out Probe_Handler) is
         pragma Unreferenced (Key);
      begin
         Client.Handlers.Insert (Event, Element);
      end Add_Handler;

   begin
      Log.Debug ("Read event definition {0} with {1} attributes",
                 Name, MAT.Types.Uint16'Image (Count));

      if Name = "start" then
         Frame.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
         Frame.Attributes := Probe_Attributes'Access;
         Client.Probe := Frame.Mapping;
      else
         Frame.Mapping := null;
      end if;
      for I in 1 .. Natural (Count) loop
         declare
            Name : constant String := MAT.Readers.Marshaller.Get_String (Msg);
            Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Probe_Handler);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Probe_Handler) is
               pragma Unreferenced (Key);
               use type MAT.Events.Attribute_Table_Ptr;
            begin
               if Element.Mapping = null then
                  Element.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
               end if;
               for J in Element.Attributes'Range loop
                  if Element.Attributes (J).Name.all = Name then
                     Element.Mapping (I) := Element.Attributes (J);
                     if Size = 1 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT8;
                     elsif Size = 2 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT16;
                     elsif Size = 4 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     elsif Size = 8 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT64;
                     else
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     end if;
                  end if;
               end loop;
            end Read_Attribute;

            use type MAT.Events.Attribute_Table_Ptr;
         begin
            if Probe_Maps.Has_Element (Pos) then
               Client.Probes.Update_Element (Pos, Read_Attribute'Access);
            end if;
            if Frame.Mapping /= null then
               Read_Attribute ("start", Frame);
            end if;
         end;
      end loop;
      if Probe_Maps.Has_Element (Pos) then
         Client.Probes.Update_Element (Pos, Add_Handler'Access);
      end if;
   end Read_Definition;

   --  ------------------------------
   --  Read a list of event definitions from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Event_Definitions (Client : in out Probe_Manager_Type;
                                     Msg    : in out MAT.Readers.Message) is
      Count : MAT.Types.Uint16;
   begin
      if Client.Frame = null then
         Client.Frame := new MAT.Events.Frame_Info (512);
      end if;
      Client.Version := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

      Log.Info ("Read event stream version {0} with {1} definitions",
                MAT.Types.Uint16'Image (Client.Version),
                MAT.Types.Uint16'Image (Count));
      for I in 1 .. Count loop
         Read_Definition (Client, Msg);
      end loop;

   exception
      when E : MAT.Readers.Marshaller.Buffer_Underflow_Error =>
         Log.Error ("Not enough data in the message", E, True);

   end Read_Event_Definitions;

end MAT.Events.Probes;

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

with MAT.Readers.Marshaller;
package body MAT.Events.Probes is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Events.Probes");

   procedure Read_Probe (Client : in out Probe_Manager_Type;
                         Msg    : in out MAT.Readers.Message_Type);

   P_TIME_SEC         : constant MAT.Events.Internal_Reference := 0;
   P_TIME_USEC        : constant MAT.Events.Internal_Reference := 1;
   P_THREAD_ID        : constant MAT.Events.Internal_Reference := 2;
   P_THREAD_SP        : constant MAT.Events.Internal_Reference := 3;
   P_RUSAGE_MINFLT    : constant MAT.Events.Internal_Reference := 4;
   P_RUSAGE_MAJFLT    : constant MAT.Events.Internal_Reference := 5;
   P_RUSAGE_NVCSW     : constant MAT.Events.Internal_Reference := 6;
   P_RUSAGE_NIVCSW    : constant MAT.Events.Internal_Reference := 7;
   P_FRAME            : constant MAT.Events.Internal_Reference := 8;
   P_FRAME_PC         : constant MAT.Events.Internal_Reference := 9;

   TIME_SEC_NAME      : aliased constant String := "time-sec";
   TIME_USEC_NAME     : aliased constant String := "time-usec";
   THREAD_ID_NAME     : aliased constant String := "thread-id";
   THREAD_SP_NAME     : aliased constant String := "thread-sp";
   RUSAGE_MINFLT_NAME : aliased constant String := "ru-minflt";
   RUSAGE_MAJFLT_NAME : aliased constant String := "ru-majflt";
   RUSAGE_NVCSW_NAME  : aliased constant String := "ru-nvcsw";
   RUSAGE_NIVCSW_NAME : aliased constant String := "ru-nivcsw";
   FRAME_NAME         : aliased constant String := "frame";
   FRAME_PC_NAME      : aliased constant String := "frame-pc";

   Probe_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => TIME_SEC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_TIME_SEC),
      2 => (Name => TIME_USEC_NAME'Access,
             Size => 0,
             Kind => MAT.Events.T_SIZE_T,
             Ref  => P_TIME_USEC),
      3 => (Name => THREAD_ID_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_ID),
      4 => (Name => THREAD_SP_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_SP),
      5 => (Name => FRAME_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME),
      6 => (Name => FRAME_PC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME_PC),
      7 => (Name => RUSAGE_MINFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MINFLT),
      8 => (Name => RUSAGE_MAJFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MAJFLT),
      9 => (Name => RUSAGE_NVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NVCSW),
      10 => (Name => RUSAGE_NIVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NIVCSW)
     );

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type is
   begin
      return Ada.Containers.Hash_Type (Key);
   end Hash;

   --  ------------------------------
   --  Update the Size and Prev_Id information in the event identified by <tt>Id</tt>.
   --  Update the event represented by <tt>Prev_Id</tt> so that its Next_Id refers
   --  to the <tt>Id</tt> event.
   --  ------------------------------
   procedure Update_Event (Probe   : in Probe_Type;
                           Id      : in MAT.Events.Event_Id_Type;
                           Size    : in MAT.Types.Target_Size;
                           Prev_Id : in MAT.Events.Event_Id_Type) is
   begin
      Probe.Owner.Get_Target_Events.Update_Event (Id, Size, Prev_Id);
   end Update_Event;

   --  ------------------------------
   --  Initialize the manager instance.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out Probe_Manager_Type) is
   begin
      Manager.Events := new MAT.Events.Targets.Target_Events;
      Manager.Frames := MAT.Frames.Create_Root;
   end Initialize;

   --  ------------------------------
   --  Register the probe to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   --  ------------------------------
   procedure Register_Probe (Into   : in out Probe_Manager_Type;
                             Probe  : in Probe_Type_Access;
                             Name   : in String;
                             Id     : in MAT.Events.Probe_Index_Type;
                             Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Probe_Handler;
   begin
      Handler.Probe := Probe;
      Handler.Id    := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Probes.Insert (Name, Handler);
      Probe.Owner := Into'Unchecked_Access;
   end Register_Probe;

   --  ------------------------------
   --  Get the target events.
   --  ------------------------------
   function Get_Target_Events (Client : in Probe_Manager_Type)
                               return MAT.Events.Targets.Target_Events_Access is
   begin
      return Client.Events;
   end Get_Target_Events;

   procedure Read_Probe (Client : in out Probe_Manager_Type;
                         Msg    : in out MAT.Readers.Message) is
      use type MAT.Types.Target_Tick_Ref;

      Count     : Natural := 0;
      Time_Sec  : MAT.Types.Uint32  := 0;
      Time_Usec : MAT.Types.Uint32 := 0;
      Frame     : constant access MAT.Events.Frame_Info := Client.Frame;
   begin
      Client.Event.Thread := 0;
      Frame.Stack  := 0;
      Frame.Cur_Depth := 0;
      for I in Client.Probe'Range loop
         declare
            Def : MAT.Events.Attribute renames Client.Probe (I);
         begin
            case Def.Ref is
               when P_TIME_SEC =>
                  Time_Sec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind);

               when P_TIME_USEC =>
                  Time_Usec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind);

               when P_THREAD_ID =>
                  Client.Event.Thread := MAT.Types.Target_Thread_Ref
                    (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind));

               when P_THREAD_SP =>
                  Frame.Stack := MAT.Readers.Marshaller.Get_Target_Addr (Msg, Def.Kind);

               when P_FRAME =>
                  Count := Natural (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg,
                                    Def.Kind));

               when P_FRAME_PC =>
                  for I in 1 .. Count loop --  reverse Count .. 1 loop
                     if Count < Frame.Depth then
                        Frame.Frame (Count - I + 1) := MAT.Readers.Marshaller.Get_Target_Addr (Msg,
                                                                                Def.Kind);
                     end if;
                  end loop;

               when others =>
                  null;

            end case;
         end;
      end loop;
      --  Convert the time in usec to make computation easier.
      Client.Event.Time := MAT.Types.Target_Tick_Ref (Time_Sec) * 1_000_000;
      Client.Event.Time := Client.Event.Time + MAT.Types.Target_Tick_Ref (Time_Usec);
      Frame.Cur_Depth := Count;

   exception
      when E : others =>
         Log.Error ("Marshaling error, frame count {0}", Natural'Image (Count));
         raise;

   end Read_Probe;

   procedure Dispatch_Message (Client : in out Probe_Manager_Type;
                               Msg    : in out MAT.Readers.Message_Type) is
      use type MAT.Events.Attribute_Table_Ptr;
      use type MAT.Events.Targets.Target_Events_Access;

      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      if Log.Get_Level = Util.Log.DEBUG_LEVEL then
         Log.Debug ("Dispatch message {0} - size {1}",
                    MAT.Types.Uint16'Image (Event),
                    Natural'Image (Msg.Size));
      end if;

      if not Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         if Client.Probe /= null then
            Read_Probe (Client, Msg);
         end if;
         declare
            Handler : constant Probe_Handler := Handler_Maps.Element (Pos);
         begin
            Client.Event.Prev_Id := 0;
            Client.Event.Event := Event;
            Client.Event.Index := Handler.Id;
            Handler.Probe.Extract (Handler.Mapping.all'Access, Msg, Client.Event);
            MAT.Frames.Insert (Frame  => Client.Frames,
                               Pc     => Client.Frame.Frame (1 .. Client.Frame.Cur_Depth),
                               Result => Client.Event.Frame);
            Client.Events.Insert (Client.Event);
            Handler.Probe.Execute (Client.Event);
         end;
      end if;

   exception
      when E : others =>
         Log.Error ("Exception while processing event " & MAT.Types.Uint16'Image (Event), E, True);
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Probe_Manager_Type;
                              Msg    : in out MAT.Readers.Message_Type) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Probe_Maps.Cursor := Client.Probes.Find (Name);
      Frame : Probe_Handler;

      procedure Add_Handler (Key     : in String;
                             Element : in out Probe_Handler);

      procedure Add_Handler (Key     : in String;
                             Element : in out Probe_Handler) is
         pragma Unreferenced (Key);
      begin
         Client.Handlers.Insert (Event, Element);
      end Add_Handler;

   begin
      Log.Debug ("Read event definition {0} with {1} attributes",
                 Name, MAT.Types.Uint16'Image (Count));

      if Name = "start" then
         Frame.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
         Frame.Attributes := Probe_Attributes'Access;
         Client.Probe := Frame.Mapping;
      else
         Frame.Mapping := null;
      end if;
      for I in 1 .. Natural (Count) loop
         declare
            Name : constant String := MAT.Readers.Marshaller.Get_String (Msg);
            Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Probe_Handler);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Probe_Handler) is
               pragma Unreferenced (Key);
               use type MAT.Events.Attribute_Table_Ptr;
            begin
               if Element.Mapping = null then
                  Element.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
               end if;
               for J in Element.Attributes'Range loop
                  if Element.Attributes (J).Name.all = Name then
                     Element.Mapping (I) := Element.Attributes (J);
                     if Size = 1 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT8;
                     elsif Size = 2 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT16;
                     elsif Size = 4 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     elsif Size = 8 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT64;
                     else
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     end if;
                  end if;
               end loop;
            end Read_Attribute;

            use type MAT.Events.Attribute_Table_Ptr;
         begin
            if Probe_Maps.Has_Element (Pos) then
               Client.Probes.Update_Element (Pos, Read_Attribute'Access);
            end if;
            if Frame.Mapping /= null then
               Read_Attribute ("start", Frame);
            end if;
         end;
      end loop;
      if Probe_Maps.Has_Element (Pos) then
         Client.Probes.Update_Element (Pos, Add_Handler'Access);
      end if;
   end Read_Definition;

   --  ------------------------------
   --  Read a list of event definitions from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Event_Definitions (Client : in out Probe_Manager_Type;
                                     Msg    : in out MAT.Readers.Message) is
      Count : MAT.Types.Uint16;
   begin
      if Client.Frame = null then
         Client.Frame := new MAT.Events.Frame_Info (512);
      end if;
      Client.Version := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

      Log.Info ("Read event stream version {0} with {1} definitions",
                MAT.Types.Uint16'Image (Client.Version),
                MAT.Types.Uint16'Image (Count));
      for I in 1 .. Count loop
         Read_Definition (Client, Msg);
      end loop;

   exception
      when E : MAT.Readers.Marshaller.Buffer_Underflow_Error =>
         Log.Error ("Not enough data in the message", E, True);

   end Read_Event_Definitions;

end MAT.Events.Probes;

Clear the Event.Prev_Id before creating a new event


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

with Wiki.Attributes;
with Wiki.Documents;

--  == Plugins ==
--  The <b>Wiki.Plugins</b> package defines the plugin interface that is used by the wiki
--  engine to provide pluggable extensions in the Wiki.
--
package Wiki.Plugins is

   pragma Preelaborate;

   type Wiki_Plugin is limited interface;
   type Wiki_Plugin_Access is access all Wiki_Plugin'Class;

   --  Expand the plugin configured with the parameters for the document.
   procedure Expand (Plugin   : in out Wiki_Plugin;
                     Document : in out Wiki.Documents.Document_Reader'Class;
                     Params   : in out Wiki.Attributes.Attribute_List_Type) is abstract;

end Wiki.Plugins;

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

with Wiki.Attributes;
with Wiki.Nodes;

--  == Plugins ==
--  The <b>Wiki.Plugins</b> package defines the plugin interface that is used by the wiki
--  engine to provide pluggable extensions in the Wiki.
--
package Wiki.Plugins is

   pragma Preelaborate;

   type Wiki_Plugin is limited interface;
   type Wiki_Plugin_Access is access all Wiki_Plugin'Class;

   --  Expand the plugin configured with the parameters for the document.
   procedure Expand (Plugin   : in out Wiki_Plugin;
                     Document : in out Wiki.Nodes.Document;
                     Params   : in out Wiki.Attributes.Attribute_List_Type) is abstract;

end Wiki.Plugins;

Use the Document type

Use the Document type


-----------------------------------------------------------------------
--  ado-audits -- Auditing support
--  Copyright (C) 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Util.Beans.Objects.Time;
with ADO.Utils;
package body ADO.Audits is

   use Ada.Strings.Unbounded;
   use type ADO.Schemas.Column_Index;
   use type Ada.Calendar.Time;

   package UBOT renames Util.Beans.Objects.Time;

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => Audit_Array,
                                     Name   => Audit_Array_Access);

   procedure Save (Object  : in out Auditable_Object_Record'Class;
                   Session : in out ADO.Sessions.Master_Session'Class) is
      Manager : constant access Audit_Manager'Class := Session.Get_Audit_Manager;
      Audits  : constant Audit_Array_Access := Object.Audits;
      Last    : Audit_Info_Index;
   begin
      if Manager /= null and Audits /= null then
         Last := 1;
         for Pos in Audits'Range loop
            exit when Audits (Pos).Field = 0;
            Last := Pos;
         end loop;
         Manager.Save (Session, Object, Audits (1 .. Last));
      end if;
      Free (Object.Audits);
   end Save;

   --  --------------------
   --  Record an audit information for a field.
   --  --------------------
   procedure Audit_Field (Object    : in out Auditable_Object_Record;
                          Field     : in ADO.Schemas.Column_Index;
                          Old_Value : in UBO.Object;
                          New_Value : in UBO.Object) is
      Audits : Audit_Array_Access := Object.Audits;
   begin
      if Audits = null then
         Audits := new Audit_Array (1 .. Audit_Info_Index (Object.With_Audit.Count));
         Object.Audits := Audits;
      end if;
      for Pos in Object.Audits'Range loop
         if Audits (Pos).Field = Field then
            Audits (Pos).New_Value := New_Value;
            return;
         end if;
         if Audits (Pos).Field = 0 then
            Audits (Pos).Field := Field;
            Audits (Pos).Old_Value := Old_Value;
            Audits (Pos).New_Value := New_Value;
            return;
         end if;
      end loop;
   end Audit_Field;

   --  --------------------
   --  Release the object.
   --  --------------------
   overriding
   procedure Finalize (Object : in out Auditable_Object_Record) is
   begin
      Free (Object.Audits);
      ADO.Objects.Finalize (ADO.Objects.Object_Record (Object));
   end Finalize;

   procedure Set_Field_Unbounded_String (Object : in out Auditable_Object_Record'Class;
                                         Field  : in Column_Index;
                                         Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                                         Value  : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Unbounded_String;

   procedure Set_Field_String (Object : in out Auditable_Object_Record'Class;
                               Field  : in Column_Index;
                               Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                               Value  : in String) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Ada.Strings.Unbounded.Set_Unbounded_String (Into, Value);
         Object.Set_Field (Field);
      end if;
   end Set_Field_String;

   procedure Set_Field_String (Object : in out Auditable_Object_Record'Class;
                               Field  : in Column_Index;
                               Into   : in out ADO.Nullable_String;
                               Value  : in String) is
   begin
      if Into.Is_Null or else Into.Value /= Value then
         if Into.Is_Null then
            Object.Audit_Field (Field, UBO.Null_Object, UBO.To_Object (Value));
         else
            Object.Audit_Field (Field, UBO.To_Object (Into.Value), UBO.To_Object (Value));
         end if;
         Into.Is_Null := False;
         Ada.Strings.Unbounded.Set_Unbounded_String (Into.Value, Value);
         Object.Set_Field (Field);
      end if;
   end Set_Field_String;

   procedure Set_Field_String (Object : in out Auditable_Object_Record'Class;
                               Field  : in Column_Index;
                               Into   : in out ADO.Nullable_String;
                               Value  : in ADO.Nullable_String) is
   begin
      if Into.Is_Null then
         if not Value.Is_Null then
            Object.Audit_Field (Field, UBO.Null_Object, UBO.To_Object (Value.Value));
            Into := Value;
            Object.Set_Field (Field);
         end if;
      elsif Value.Is_Null then
         Object.Audit_Field (Field, UBO.To_Object (Into.Value), UBO.Null_Object);
         Into := Value;
         Object.Set_Field (Field);
      elsif Into.Value /= Value.Value then
         Object.Audit_Field (Field, UBO.To_Object (Into.Value), UBO.To_Object (Value.Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_String;

   procedure Set_Field_Time (Object : in out Auditable_Object_Record'Class;
                             Field  : in Column_Index;
                             Into   : in out Ada.Calendar.Time;
                             Value  : in Ada.Calendar.Time) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBOT.To_Object (Into), UBOT.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Time;

   procedure Set_Field_Time (Object : in out Auditable_Object_Record'Class;
                             Field  : in Column_Index;
                             Into   : in out ADO.Nullable_Time;
                             Value  : in ADO.Nullable_Time) is
   begin
      if Into.Is_Null then
         if not Value.Is_Null then
            Object.Audit_Field (Field, UBO.Null_Object, UBOT.To_Object (Value.Value));
            Into := Value;
            Object.Set_Field (Field);
         end if;
      elsif Value.Is_Null then
         Object.Audit_Field (Field, UBOT.To_Object (Into.Value), UBO.Null_Object);
         Into := Value;
         Object.Set_Field (Field);
      elsif Into.Value /= Value.Value then
         Object.Audit_Field (Field, UBOT.To_Object (Into.Value), UBOT.To_Object (Value.Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Time;

   procedure Set_Field_Integer (Object : in out Auditable_Object_Record'Class;
                                Field  : in Column_Index;
                                Into   : in out Integer;
                                Value  : in Integer) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Integer;

   procedure Set_Field_Integer (Object : in out Auditable_Object_Record'Class;
                                Field  : in Column_Index;
                                Into   : in out ADO.Nullable_Integer;
                                Value  : in ADO.Nullable_Integer) is
   begin
      if Into.Is_Null then
         if not Value.Is_Null then
            Object.Audit_Field (Field, UBO.Null_Object, UBO.To_Object (Value.Value));
            Into := Value;
            Object.Set_Field (Field);
         end if;
      elsif Value.Is_Null then
         Object.Audit_Field (Field, UBO.To_Object (Into.Value), UBO.Null_Object);
         Into := Value;
         Object.Set_Field (Field);
      elsif Into.Value /= Value.Value then
         Object.Audit_Field (Field, UBO.To_Object (Into.Value), UBO.To_Object (Value.Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Integer;

   procedure Set_Field_Natural (Object : in out Auditable_Object_Record'Class;
                                Field  : in Column_Index;
                                Into   : in out Natural;
                                Value  : in Natural) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Natural;

   procedure Set_Field_Positive (Object : in out Auditable_Object_Record'Class;
                                 Field  : in Column_Index;
                                 Into   : in out Positive;
                                 Value  : in Positive) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Positive;

   procedure Set_Field_Boolean (Object : in out Auditable_Object_Record'Class;
                                Field  : in Column_Index;
                                Into   : in out Boolean;
                                Value  : in Boolean) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Boolean;

   procedure Set_Field_Object (Object : in out Auditable_Object_Record'Class;
                               Field  : in Column_Index;
                               Into   : in out ADO.Objects.Object_Ref'Class;
                               Value  : in ADO.Objects.Object_Ref'Class) is
      use type ADO.Objects.Object_Ref;
   begin
      if Into /= Value then
         Object.Audit_Field (Field, ADO.Objects.To_Object (Into.Get_Key),
                             ADO.Objects.To_Object (Value.Get_Key));
         ADO.Objects.Set_Field_Object (Object, Field, Into, Value);
      end if;
   end Set_Field_Object;

   procedure Set_Field_Identifier (Object : in out Auditable_Object_Record'Class;
                                   Field  : in Column_Index;
                                   Into   : in out ADO.Identifier;
                                   Value  : in ADO.Identifier) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, Utils.To_Object (Into), Utils.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Identifier;

   procedure Set_Field_Entity_Type (Object : in out Auditable_Object_Record'Class;
                                    Field  : in Column_Index;
                                    Into   : in out ADO.Entity_Type;
                                    Value  : in ADO.Entity_Type) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Natural (Into)),
                             UBO.To_Object (Natural (Value)));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Entity_Type;

   procedure Set_Field_Entity_Type (Object : in out Auditable_Object_Record'Class;
                                    Field  : in Column_Index;
                                    Into   : in out ADO.Nullable_Entity_Type;
                                    Value  : in ADO.Nullable_Entity_Type) is
   begin
      if Into.Is_Null then
         if not Value.Is_Null then
            Object.Audit_Field (Field, UBO.Null_Object, UBO.To_Object (Natural (Value.Value)));
            Into := Value;
            Object.Set_Field (Field);
         end if;
      elsif Value.Is_Null then
         Object.Audit_Field (Field, UBO.To_Object (Natural (Into.Value)), UBO.Null_Object);
         Into := Value;
         Object.Set_Field (Field);
      elsif Into.Value /= Value.Value then
         Object.Audit_Field (Field, UBO.To_Object (Natural (Into.Value)),
                             UBO.To_Object (Natural (Value.Value)));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Entity_Type;

   procedure Set_Field_Key_Value (Object : in out Auditable_Object_Record'Class;
                                  Field  : in Column_Index;
                                  Value  : in ADO.Identifier) is
   begin
      if Object.Get_Key_Value /= Value then
         Object.Audit_Field (Field, ADO.Objects.To_Object (Object.Get_Key),
                             Utils.To_Object (Value));
         ADO.Objects.Set_Key_Value (Object, Value);
         Object.Set_Field (Field);
      end if;
   end Set_Field_Key_Value;

   procedure Set_Field_Key_Value (Object : in out Auditable_Object_Record'Class;
                                  Field  : in Column_Index;
                                  Value  : in String) is
   begin
      if Object.Get_Key_Value /= Value then
         Object.Audit_Field (Field, ADO.Objects.To_Object (Object.Get_Key),
                             UBO.To_Object (Value));
         ADO.Objects.Set_Key_Value (Object, Value);
         Object.Set_Field (Field);
      end if;
   end Set_Field_Key_Value;

   procedure Set_Field_Key_Value (Object : in out Auditable_Object_Record'Class;
                                  Field  : in Column_Index;
                                  Value  : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      if Object.Get_Key_Value /= Value then
         Object.Audit_Field (Field, ADO.Objects.To_Object (Object.Get_Key),
                             UBO.To_Object (Value));
         ADO.Objects.Set_Key_Value (Object, Value);
         Object.Set_Field (Field);
      end if;
   end Set_Field_Key_Value;

   procedure Set_Field_Operation (Object : in out Auditable_Object_Record'Class;
                                  Field  : in Column_Index;
                                  Into   : in out T;
                                  Value  : in T) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, To_Object (Into), To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Operation;

end ADO.Audits;

-----------------------------------------------------------------------
--  ado-audits -- Auditing support
--  Copyright (C) 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Util.Beans.Objects.Time;
with ADO.Utils;
package body ADO.Audits is

   use Ada.Strings.Unbounded;
   use type ADO.Schemas.Column_Index;
   use type Ada.Calendar.Time;

   package UBOT renames Util.Beans.Objects.Time;

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => Audit_Array,
                                     Name   => Audit_Array_Access);

   procedure Save (Object  : in out Auditable_Object_Record'Class;
                   Session : in out ADO.Sessions.Master_Session'Class) is
      Manager : constant access Audit_Manager'Class := Session.Get_Audit_Manager;
      Audits  : constant Audit_Array_Access := Object.Audits;
      Last    : Audit_Info_Index;
   begin
      if Manager /= null and Audits /= null then
         Last := 1;
         for Pos in Audits'Range loop
            exit when Audits (Pos).Field = 0;
            Last := Pos;
         end loop;
         Manager.Save (Session, Object, Audits (1 .. Last));
      end if;
      Free (Object.Audits);
   end Save;

   --  --------------------
   --  Record an audit information for a field.
   --  --------------------
   procedure Audit_Field (Object    : in out Auditable_Object_Record;
                          Field     : in ADO.Schemas.Column_Index;
                          Old_Value : in UBO.Object;
                          New_Value : in UBO.Object) is
      Audits : Audit_Array_Access := Object.Audits;
   begin
      if Audits = null then
         Audits := new Audit_Array (1 .. Audit_Info_Index (Object.With_Audit.Count));
         Object.Audits := Audits;
      end if;
      for Pos in Object.Audits'Range loop
         if Audits (Pos).Field = Field then
            Audits (Pos).New_Value := New_Value;
            return;
         end if;
         if Audits (Pos).Field = 0 then
            Audits (Pos).Field := Field;
            Audits (Pos).Old_Value := Old_Value;
            Audits (Pos).New_Value := New_Value;
            return;
         end if;
      end loop;
   end Audit_Field;

   --  --------------------
   --  Release the object.
   --  --------------------
   overriding
   procedure Finalize (Object : in out Auditable_Object_Record) is
   begin
      Free (Object.Audits);
      ADO.Objects.Finalize (ADO.Objects.Object_Record (Object));
   end Finalize;

   procedure Set_Field_Unbounded_String (Object : in out Auditable_Object_Record'Class;
                                         Field  : in Column_Index;
                                         Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                                         Value  : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Unbounded_String;

   procedure Set_Field_String (Object : in out Auditable_Object_Record'Class;
                               Field  : in Column_Index;
                               Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                               Value  : in String) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Ada.Strings.Unbounded.Set_Unbounded_String (Into, Value);
         Object.Set_Field (Field);
      end if;
   end Set_Field_String;

   procedure Set_Field_String (Object : in out Auditable_Object_Record'Class;
                               Field  : in Column_Index;
                               Into   : in out ADO.Nullable_String;
                               Value  : in String) is
   begin
      if Into.Is_Null or else Into.Value /= Value then
         if Into.Is_Null then
            Object.Audit_Field (Field, UBO.Null_Object, UBO.To_Object (Value));
         else
            Object.Audit_Field (Field, UBO.To_Object (Into.Value), UBO.To_Object (Value));
         end if;
         Into.Is_Null := False;
         Ada.Strings.Unbounded.Set_Unbounded_String (Into.Value, Value);
         Object.Set_Field (Field);
      end if;
   end Set_Field_String;

   procedure Set_Field_String (Object : in out Auditable_Object_Record'Class;
                               Field  : in Column_Index;
                               Into   : in out ADO.Nullable_String;
                               Value  : in ADO.Nullable_String) is
   begin
      if Into.Is_Null then
         if not Value.Is_Null then
            Object.Audit_Field (Field, UBO.Null_Object, UBO.To_Object (Value.Value));
            Into := Value;
            Object.Set_Field (Field);
         end if;
      elsif Value.Is_Null then
         Object.Audit_Field (Field, UBO.To_Object (Into.Value), UBO.Null_Object);
         Into := Value;
         Object.Set_Field (Field);
      elsif Into.Value /= Value.Value then
         Object.Audit_Field (Field, UBO.To_Object (Into.Value), UBO.To_Object (Value.Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_String;

   procedure Set_Field_Time (Object : in out Auditable_Object_Record'Class;
                             Field  : in Column_Index;
                             Into   : in out Ada.Calendar.Time;
                             Value  : in Ada.Calendar.Time) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBOT.To_Object (Into), UBOT.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Time;

   procedure Set_Field_Time (Object : in out Auditable_Object_Record'Class;
                             Field  : in Column_Index;
                             Into   : in out ADO.Nullable_Time;
                             Value  : in ADO.Nullable_Time) is
   begin
      if Into.Is_Null then
         if not Value.Is_Null then
            Object.Audit_Field (Field, UBO.Null_Object, UBOT.To_Object (Value.Value));
            Into := Value;
            Object.Set_Field (Field);
         end if;
      elsif Value.Is_Null then
         Object.Audit_Field (Field, UBOT.To_Object (Into.Value), UBO.Null_Object);
         Into := Value;
         Object.Set_Field (Field);
      elsif Into.Value /= Value.Value then
         Object.Audit_Field (Field, UBOT.To_Object (Into.Value), UBOT.To_Object (Value.Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Time;

   procedure Set_Field_Integer (Object : in out Auditable_Object_Record'Class;
                                Field  : in Column_Index;
                                Into   : in out Integer;
                                Value  : in Integer) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Integer;

   procedure Set_Field_Integer (Object : in out Auditable_Object_Record'Class;
                                Field  : in Column_Index;
                                Into   : in out ADO.Nullable_Integer;
                                Value  : in ADO.Nullable_Integer) is
   begin
      if Into.Is_Null then
         if not Value.Is_Null then
            Object.Audit_Field (Field, UBO.Null_Object, UBO.To_Object (Value.Value));
            Into := Value;
            Object.Set_Field (Field);
         end if;
      elsif Value.Is_Null then
         Object.Audit_Field (Field, UBO.To_Object (Into.Value), UBO.Null_Object);
         Into := Value;
         Object.Set_Field (Field);
      elsif Into.Value /= Value.Value then
         Object.Audit_Field (Field, UBO.To_Object (Into.Value), UBO.To_Object (Value.Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Integer;

   procedure Set_Field_Natural (Object : in out Auditable_Object_Record'Class;
                                Field  : in Column_Index;
                                Into   : in out Natural;
                                Value  : in Natural) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Natural;

   procedure Set_Field_Positive (Object : in out Auditable_Object_Record'Class;
                                 Field  : in Column_Index;
                                 Into   : in out Positive;
                                 Value  : in Positive) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Positive;

   procedure Set_Field_Boolean (Object : in out Auditable_Object_Record'Class;
                                Field  : in Column_Index;
                                Into   : in out Boolean;
                                Value  : in Boolean) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Boolean;

   procedure Set_Field_Float (Object : in out Auditable_Object_Record'Class;
                              Field  : in Column_Index;
                              Into   : in out Float;
                              Value  : in Float) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Float;

   procedure Set_Field_Long_Float (Object : in out Auditable_Object_Record'Class;
                                   Field  : in Column_Index;
                                   Into   : in out Long_Float;
                                   Value  : in Long_Float) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Into), UBO.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Long_Float;

   procedure Set_Field_Object (Object : in out Auditable_Object_Record'Class;
                               Field  : in Column_Index;
                               Into   : in out ADO.Objects.Object_Ref'Class;
                               Value  : in ADO.Objects.Object_Ref'Class) is
      use type ADO.Objects.Object_Ref;
   begin
      if Into /= Value then
         Object.Audit_Field (Field, ADO.Objects.To_Object (Into.Get_Key),
                             ADO.Objects.To_Object (Value.Get_Key));
         ADO.Objects.Set_Field_Object (Object, Field, Into, Value);
      end if;
   end Set_Field_Object;

   procedure Set_Field_Identifier (Object : in out Auditable_Object_Record'Class;
                                   Field  : in Column_Index;
                                   Into   : in out ADO.Identifier;
                                   Value  : in ADO.Identifier) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, Utils.To_Object (Into), Utils.To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Identifier;

   procedure Set_Field_Entity_Type (Object : in out Auditable_Object_Record'Class;
                                    Field  : in Column_Index;
                                    Into   : in out ADO.Entity_Type;
                                    Value  : in ADO.Entity_Type) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, UBO.To_Object (Natural (Into)),
                             UBO.To_Object (Natural (Value)));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Entity_Type;

   procedure Set_Field_Entity_Type (Object : in out Auditable_Object_Record'Class;
                                    Field  : in Column_Index;
                                    Into   : in out ADO.Nullable_Entity_Type;
                                    Value  : in ADO.Nullable_Entity_Type) is
   begin
      if Into.Is_Null then
         if not Value.Is_Null then
            Object.Audit_Field (Field, UBO.Null_Object, UBO.To_Object (Natural (Value.Value)));
            Into := Value;
            Object.Set_Field (Field);
         end if;
      elsif Value.Is_Null then
         Object.Audit_Field (Field, UBO.To_Object (Natural (Into.Value)), UBO.Null_Object);
         Into := Value;
         Object.Set_Field (Field);
      elsif Into.Value /= Value.Value then
         Object.Audit_Field (Field, UBO.To_Object (Natural (Into.Value)),
                             UBO.To_Object (Natural (Value.Value)));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Entity_Type;

   procedure Set_Field_Key_Value (Object : in out Auditable_Object_Record'Class;
                                  Field  : in Column_Index;
                                  Value  : in ADO.Identifier) is
   begin
      if Object.Get_Key_Value /= Value then
         Object.Audit_Field (Field, ADO.Objects.To_Object (Object.Get_Key),
                             Utils.To_Object (Value));
         ADO.Objects.Set_Key_Value (Object, Value);
         Object.Set_Field (Field);
      end if;
   end Set_Field_Key_Value;

   procedure Set_Field_Key_Value (Object : in out Auditable_Object_Record'Class;
                                  Field  : in Column_Index;
                                  Value  : in String) is
   begin
      if Object.Get_Key_Value /= Value then
         Object.Audit_Field (Field, ADO.Objects.To_Object (Object.Get_Key),
                             UBO.To_Object (Value));
         ADO.Objects.Set_Key_Value (Object, Value);
         Object.Set_Field (Field);
      end if;
   end Set_Field_Key_Value;

   procedure Set_Field_Key_Value (Object : in out Auditable_Object_Record'Class;
                                  Field  : in Column_Index;
                                  Value  : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      if Object.Get_Key_Value /= Value then
         Object.Audit_Field (Field, ADO.Objects.To_Object (Object.Get_Key),
                             UBO.To_Object (Value));
         ADO.Objects.Set_Key_Value (Object, Value);
         Object.Set_Field (Field);
      end if;
   end Set_Field_Key_Value;

   procedure Set_Field_Operation (Object : in out Auditable_Object_Record'Class;
                                  Field  : in Column_Index;
                                  Into   : in out T;
                                  Value  : in T) is
   begin
      if Into /= Value then
         Object.Audit_Field (Field, To_Object (Into), To_Object (Value));
         Into := Value;
         Object.Set_Field (Field);
      end if;
   end Set_Field_Operation;

end ADO.Audits;

Implement Set_Field_Float and Set_Field_Long_Float


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

   --  ------------------------------
   --  Append a node to the tag node.
   --  ------------------------------
   procedure Append (Into : in Node_Type_Access;
                     Node : in Node_Type_Access) is
   begin
      if Into.Children = null then
         Into.Children := new Node_List;
         Into.Children.Current := Into.Children.First'Access;
      end if;
      Append (Into.Children.all, Node);
   end Append;

   --  ------------------------------
   --  Append a node to the node list.
   --  ------------------------------
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access) is
      Block : Node_List_Block_Access := Into.Current;
   begin
      if Block.Last = Block.Max then
         Block.Next := new Node_List_Block (Block.Max * 2);
         Block := Block.Next;
         Into.Current := Block;
      end if;
      Block.Last := Block.Last + 1;
      Block.List (Block.Last) := Node;
      Into.Length := Into.Length + 1;
   end Append;

   --  ------------------------------
   --  Finalize the node list to release the allocated memory.
   --  ------------------------------
   procedure Finalize (List : in out Node_List) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Node_List_Block, Node_List_Block_Access);

      procedure Free is
        new Ada.Unchecked_Deallocation (Node_Type, Node_Type_Access);

      procedure Free is
        new Ada.Unchecked_Deallocation (Node_List, Node_List_Access);

      procedure Release (List : in Node_List_Block_Access);
      procedure Free_Block (Block : in out Node_List_Block);

      procedure Free_Block (Block : in out Node_List_Block) is
      begin
         for I in 1 .. Block.Last loop
            if Block.List (I).Kind = N_TAG_START and then Block.List (I).Children /= null then
               Finalize (Block.List (I).Children.all);
               Free (Block.List (I).Children);
            end if;
            Free (Block.List (I));
         end loop;
      end Free_Block;

      procedure Release (List : in Node_List_Block_Access) is
         Next  : Node_List_Block_Access := List;
         Block : Node_List_Block_Access;
      begin
         while Next /= null loop
            Block := Next;
            Free_Block (Block.all);
            Next := Next.Next;
            Free (Block);
         end loop;
      end Release;

   begin
      Release (List.First.Next);
      Free_Block (List.First);
   end Finalize;

end Wiki.Nodes;

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

   --  ------------------------------
   --  Append a node to the tag node.
   --  ------------------------------
   procedure Append (Into : in Node_Type_Access;
                     Node : in Node_Type_Access) is
   begin
      if Into.Kind in N_HEADER .. N_DEFINITION then
         if Into.Content = null then
            Into.Content := new Node_List;
            Into.Content.Current := Into.Content.First'Access;
         end if;
         Append (Into.Content.all, Node);
      else
         if Into.Children = null then
            Into.Children := new Node_List;
            Into.Children.Current := Into.Children.First'Access;
         end if;
         Append (Into.Children.all, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a node to the node list.
   --  ------------------------------
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access) is
      Block : Node_List_Block_Access := Into.Current;
   begin
      if Block.Last = Block.Max then
         Block.Next := new Node_List_Block (Block.Max * 2);
         Block := Block.Next;
         Into.Current := Block;
      end if;
      Block.Last := Block.Last + 1;
      Block.List (Block.Last) := Node;
      Into.Length := Into.Length + 1;
   end Append;

   --  ------------------------------
   --  Finalize the node list to release the allocated memory.
   --  ------------------------------
   procedure Finalize (List : in out Node_List) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Node_List_Block, Node_List_Block_Access);

      procedure Free is
        new Ada.Unchecked_Deallocation (Node_Type, Node_Type_Access);

      procedure Free is
        new Ada.Unchecked_Deallocation (Node_List, Node_List_Access);

      procedure Release (List : in Node_List_Block_Access);
      procedure Free_Block (Block : in out Node_List_Block);

      procedure Free_Block (Block : in out Node_List_Block) is
      begin
         for I in 1 .. Block.Last loop
            if Block.List (I).Kind = N_TAG_START and then Block.List (I).Children /= null then
               Finalize (Block.List (I).Children.all);
               Free (Block.List (I).Children);
            end if;
            Free (Block.List (I));
         end loop;
      end Free_Block;

      procedure Release (List : in Node_List_Block_Access) is
         Next  : Node_List_Block_Access := List;
         Block : Node_List_Block_Access;
      begin
         while Next /= null loop
            Block := Next;
            Free_Block (Block.all);
            Next := Next.Next;
            Free (Block);
         end loop;
      end Release;

   begin
      Release (List.First.Next);
      Free_Block (List.First);
   end Finalize;

end Wiki.Nodes;

Update the Append procedure to take into account the new node types


-----------------------------------------------------------------------
--  wiki-writers-builders -- Wiki writer to a string builder
--  Copyright (C) 2011, 2012, 2013, 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.Streams.Html.Builders is

   --  Close the current XML entity if an entity was started
   procedure Close_Current (Stream : in out Html_Output_Builder_Stream'Class);

   type Unicode_Char is mod 2**31;

   --  ------------------------------
   --  Close the current XML entity if an entity was started
   --  ------------------------------
   procedure Close_Current (Stream : in out Html_Output_Builder_Stream'Class) is
   begin
      if Stream.Close_Start then
         Stream.Write ('>');
         Stream.Close_Start := False;
      end if;
   end Close_Current;

   --  ------------------------------
   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   --  ------------------------------
   procedure Write_Wide_Attribute (Stream  : in out Html_Output_Builder_Stream;
                                   Name    : in String;
                                   Content : in Wiki.Strings.WString) is
   begin
      if Stream.Close_Start then
         Stream.Write (' ');
         Stream.Write_String (Name);
         Stream.Write ('=');
         Stream.Write ('"');
         for I in Content'Range loop
            declare
               C : constant Wiki.Strings.WChar := Content (I);
            begin
               if C = '"' then
                  Stream.Write (""");
               else
                  Stream.Write_Escape (C);
               end if;
            end;
         end loop;
         Stream.Write ('"');
      end if;
   end Write_Wide_Attribute;

   procedure Write_Wide_Attribute (Stream  : in out Html_Output_Builder_Stream;
                                   Name    : in String;
                                   Content : in Wiki.Strings.UString) is
      Count : constant Natural := Wiki.Strings.Length (Content);
   begin
      if Stream.Close_Start then
         Stream.Write (' ');
         Stream.Write_String (Name);
         Stream.Write ('=');
         Stream.Write ('"');
         for I in 1 .. Count loop
            declare
               C : constant Wiki.Strings.WChar := Wiki.Strings.Element (Content, I);
            begin
               if C = '"' then
                  Stream.Write (""");
               else
                  Stream.Write_Escape (C);
               end if;
            end;
         end loop;
         Stream.Write ('"');
      end if;
   end Write_Wide_Attribute;

   procedure Start_Element (Stream : in out Html_Output_Builder_Stream;
                            Name   : in String) is
   begin
      Close_Current (Stream);
      Stream.Write ('<');
      Stream.Write_String (Name);
      Stream.Close_Start := True;
   end Start_Element;

   procedure End_Element (Stream : in out Html_Output_Builder_Stream;
                          Name   : in String) is
   begin
      if Stream.Close_Start then
         Stream.Write (" />");
         Stream.Close_Start := False;
      else
         Close_Current (Stream);
         Stream.Write ("</");
         Stream.Write_String (Name);
         Stream.Write ('>');
      end if;
   end End_Element;

   procedure Write_Wide_Text (Stream  : in out Html_Output_Builder_Stream;
                              Content : in Wiki.Strings.WString) is
   begin
      Close_Current (Stream);
      for I in Content'Range loop
         Html_Output_Builder_Stream'Class (Stream).Write_Escape (Content (I));
      end loop;
   end Write_Wide_Text;

end Wiki.Streams.Html.Builders;

-----------------------------------------------------------------------
--  wiki-writers-builders -- Wiki writer to a string builder
--  Copyright (C) 2011, 2012, 2013, 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.Streams.Html.Builders is

   --  Close the current XML entity if an entity was started
   procedure Close_Current (Stream : in out Html_Output_Builder_Stream'Class);

   --  ------------------------------
   --  Close the current XML entity if an entity was started
   --  ------------------------------
   procedure Close_Current (Stream : in out Html_Output_Builder_Stream'Class) is
   begin
      if Stream.Close_Start then
         Stream.Write ('>');
         Stream.Close_Start := False;
      end if;
   end Close_Current;

   --  ------------------------------
   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   --  ------------------------------
   procedure Write_Wide_Attribute (Stream  : in out Html_Output_Builder_Stream;
                                   Name    : in String;
                                   Content : in Wiki.Strings.WString) is
   begin
      if Stream.Close_Start then
         Stream.Write_Escape_Attribute (Name, Content);
      end if;
   end Write_Wide_Attribute;

   procedure Write_Wide_Attribute (Stream  : in out Html_Output_Builder_Stream;
                                   Name    : in String;
                                   Content : in Wiki.Strings.UString) is
      Count : constant Natural := Wiki.Strings.Length (Content);
   begin
      if Stream.Close_Start then
         Stream.Write (' ');
         Stream.Write_String (Name);
         Stream.Write ('=');
         Stream.Write ('"');
         for I in 1 .. Count loop
            declare
               C : constant Wiki.Strings.WChar := Wiki.Strings.Element (Content, I);
            begin
               if C = '"' then
                  Stream.Write (""");
               else
                  Stream.Write_Escape (C);
               end if;
            end;
         end loop;
         Stream.Write ('"');
      end if;
   end Write_Wide_Attribute;

   procedure Start_Element (Stream : in out Html_Output_Builder_Stream;
                            Name   : in String) is
   begin
      Close_Current (Stream);
      Stream.Write ('<');
      Stream.Write_String (Name);
      Stream.Close_Start := True;
   end Start_Element;

   procedure End_Element (Stream : in out Html_Output_Builder_Stream;
                          Name   : in String) is
   begin
      if Stream.Close_Start then
         Stream.Write (" />");
         Stream.Close_Start := False;
      else
         Close_Current (Stream);
         Stream.Write ("</");
         Stream.Write_String (Name);
         Stream.Write ('>');
      end if;
   end End_Element;

   procedure Write_Wide_Text (Stream  : in out Html_Output_Builder_Stream;
                              Content : in Wiki.Strings.WString) is
   begin
      Close_Current (Stream);
      Stream.Write_Escape (Content);
   end Write_Wide_Text;

end Wiki.Streams.Html.Builders;

Use the Write_Escape and Write_Escape_Attribute operations


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

with Util.Tests;
package Util.Dates.Formats.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Format (T : in out Test);

   --  Test parsing a date using several formats and different locales.
   procedure Test_Parse (T : in out Test);

   --  Test the Get_Day_Start operation.
   procedure Test_Get_Day_Start (T : in out Test);

   --  Test the Get_Week_Start operation.
   procedure Test_Get_Week_Start (T : in out Test);

   --  Test the Get_Month_Start operation.
   procedure Test_Get_Month_Start (T : in out Test);

   --  Test the Get_Day_End operation.
   procedure Test_Get_Day_End (T : in out Test);

   --  Test the Get_Week_End operation.
   procedure Test_Get_Week_End (T : in out Test);

   --  Test the Get_Month_End operation.
   procedure Test_Get_Month_End (T : in out Test);

   --  Test the Split operation.
   procedure Test_Split (T : in out Test);

   --  Test the Append_Date operation
   procedure Test_Append_Date (T : in out Test);

   --  Test the ISO8601 operations.
   procedure Test_ISO8601 (T : in out Test);

end Util.Dates.Formats.Tests;

-----------------------------------------------------------------------
--  util-dates-formats-tests - Test for date formats
--  Copyright (C) 2011, 2013, 2014, 2015, 2016, 2018, 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.
-----------------------------------------------------------------------

with Util.Tests;
package Util.Dates.Formats.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Format (T : in out Test);

   --  Test parsing a date using several formats and different locales.
   procedure Test_Parse (T : in out Test);

   --  Test parsing a date using several formats and having several errors.
   procedure Test_Parse_Error (T : in out Test);

   --  Test the Get_Day_Start operation.
   procedure Test_Get_Day_Start (T : in out Test);

   --  Test the Get_Week_Start operation.
   procedure Test_Get_Week_Start (T : in out Test);

   --  Test the Get_Month_Start operation.
   procedure Test_Get_Month_Start (T : in out Test);

   --  Test the Get_Day_End operation.
   procedure Test_Get_Day_End (T : in out Test);

   --  Test the Get_Week_End operation.
   procedure Test_Get_Week_End (T : in out Test);

   --  Test the Get_Month_End operation.
   procedure Test_Get_Month_End (T : in out Test);

   --  Test the Split operation.
   procedure Test_Split (T : in out Test);

   --  Test the Append_Date operation
   procedure Test_Append_Date (T : in out Test);

   --  Test the ISO8601 operations.
   procedure Test_ISO8601 (T : in out Test);

end Util.Dates.Formats.Tests;

Declare Test_Parse_Error procedure

Declare Test_Parse_Error procedure


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

with Util.Test_Caller;

package body Util.Events.Timers.Tests is

   use Util.Tests;
   use type Ada.Real_Time.Time;

   package Caller is new Util.Test_Caller (Test, "Events.Timers");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Is_Scheduled",
                       Test_Empty_Timer'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Process",
                       Test_Timer_Event'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Repeat",
                       Test_Repeat_Timer'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Repeat+Process",
                       Test_Many_Timers'Access);
   end Add_Tests;

   overriding
   procedure Time_Handler (Sub   : in out Test;
                           Event : in out Timer_Ref'Class) is
   begin
      Sub.Count := Sub.Count + 1;
      if Sub.Repeat > 1 then
         Sub.Repeat := Sub.Repeat - 1;
         Event.Repeat (Ada.Real_Time.Milliseconds (1));
      end if;
   end Time_Handler;

   --  -----------------------
   --  Test empty timers.
   --  -----------------------
   procedure Test_Empty_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Deadline : Ada.Real_Time.Time;
   begin
      T.Assert (not R.Is_Scheduled, "Empty timer should not be scheduled");
      T.Assert (R.Time_Of_Event = Ada.Real_Time.Time_Last, "Time_Of_Event returned invalid value");
      R.Cancel;
      M.Process (Deadline);
      T.Assert (Deadline = Ada.Real_Time.Time_Last,
                "The Process operation returned invalid deadline");
   end Test_Empty_Timer;

   procedure Test_Timer_Event (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      delay until Deadline;
      M.Process (Deadline);
      Assert_Equals (T, 1, T.Count, "The timer handler was not called");
   end Test_Timer_Event;

   --  -----------------------
   --  Test repeating timers.
   --  -----------------------
   procedure Test_Repeat_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      T.Count := 0;
      T.Repeat := 5;
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      loop
         delay until Deadline;
         M.Process (Deadline);
         exit when Deadline >= Now + Ada.Real_Time.Seconds (1);
      end loop;
      Assert_Equals (T, 5, T.Count, "The timer handler was not repeated");
   end Test_Repeat_Timer;

   --  -----------------------
   --  Test executing several timers.
   --  -----------------------
   procedure Test_Many_Timers (T : in out Test) is
      Timer_Count : constant Positive := 30;

      type Timer_Ref_Array is array (1 .. Timer_Count) of Timer_Ref;
      type Test_Ref_Array is array (1 .. Timer_Count) of aliased Test;

      M        : Timer_List;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      R        : Timer_Ref_Array;
      D        : Test_Ref_Array;
      Dt       : Ada.Real_Time.Time_Span;
      Count    : Natural := 0;
   begin
      for I in R'Range loop
         D (I).Count := 0;
         D (I).Repeat := 4;
         if I mod 2 = 0 then
            Dt := Ada.Real_Time.Milliseconds (40);
         else
            Dt := Ada.Real_Time.Milliseconds (20);
         end if;
         M.Set_Timer (D (I)'Unchecked_Access, R (I), Start + Dt);
      end loop;
      loop
         M.Process (Deadline);
         exit when Deadline >= Start + Ada.Real_Time.Seconds (10);
         Count := Count + 1;
         delay until Deadline;
      end loop;

      --  Depending on the load we can have different values for Count.
      Util.Tests.Assert (T, Count <= 8, "Count of Process");
      Util.Tests.Assert (T, Count <= 4, "Count of Process");
      for I in D'Range loop
         Util.Tests.Assert_Equals (T, 4, D (I).Count, "Invalid count for timer at "
                                     & Natural'Image (I) & " " & Natural'Image (Count));
      end loop;
   end Test_Many_Timers;

end Util.Events.Timers.Tests;

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

with Util.Test_Caller;

package body Util.Events.Timers.Tests is

   use Util.Tests;
   use type Ada.Real_Time.Time;

   package Caller is new Util.Test_Caller (Test, "Events.Timers");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Is_Scheduled",
                       Test_Empty_Timer'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Process",
                       Test_Timer_Event'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Repeat",
                       Test_Repeat_Timer'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Repeat+Process",
                       Test_Many_Timers'Access);
   end Add_Tests;

   overriding
   procedure Time_Handler (Sub   : in out Test;
                           Event : in out Timer_Ref'Class) is
   begin
      Sub.Count := Sub.Count + 1;
      if Sub.Repeat > 1 then
         Sub.Repeat := Sub.Repeat - 1;
         Event.Repeat (Ada.Real_Time.Milliseconds (1));
      end if;
   end Time_Handler;

   --  -----------------------
   --  Test empty timers.
   --  -----------------------
   procedure Test_Empty_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Deadline : Ada.Real_Time.Time;
   begin
      T.Assert (not R.Is_Scheduled, "Empty timer should not be scheduled");
      T.Assert (R.Time_Of_Event = Ada.Real_Time.Time_Last, "Time_Of_Event returned invalid value");
      R.Cancel;
      M.Process (Deadline);
      T.Assert (Deadline = Ada.Real_Time.Time_Last,
                "The Process operation returned invalid deadline");
   end Test_Empty_Timer;

   procedure Test_Timer_Event (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      delay until Deadline;
      M.Process (Deadline);
      Assert_Equals (T, 1, T.Count, "The timer handler was not called");
   end Test_Timer_Event;

   --  -----------------------
   --  Test repeating timers.
   --  -----------------------
   procedure Test_Repeat_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      T.Count := 0;
      T.Repeat := 5;
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      loop
         delay until Deadline;
         M.Process (Deadline);
         exit when Deadline >= Now + Ada.Real_Time.Seconds (1);
      end loop;
      Assert_Equals (T, 5, T.Count, "The timer handler was not repeated");
   end Test_Repeat_Timer;

   --  -----------------------
   --  Test executing several timers.
   --  -----------------------
   procedure Test_Many_Timers (T : in out Test) is
      Timer_Count : constant Positive := 30;

      type Timer_Ref_Array is array (1 .. Timer_Count) of Timer_Ref;
      type Test_Ref_Array is array (1 .. Timer_Count) of aliased Test;

      M        : Timer_List;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      R        : Timer_Ref_Array;
      D        : Test_Ref_Array;
      Dt       : Ada.Real_Time.Time_Span;
      Count    : Natural := 0;
   begin
      for I in R'Range loop
         D (I).Count := 0;
         D (I).Repeat := 4;
         if I mod 2 = 0 then
            Dt := Ada.Real_Time.Milliseconds (40);
         else
            Dt := Ada.Real_Time.Milliseconds (20);
         end if;
         M.Set_Timer (D (I)'Unchecked_Access, R (I), Start + Dt);
      end loop;
      loop
         M.Process (Deadline);
         exit when Deadline >= Start + Ada.Real_Time.Seconds (10);
         Count := Count + 1;
         delay until Deadline;
      end loop;

      --  Depending on the load we can have different values for Count.
      T.Assert (Count <= 8, "Count of Process");
      T.Assert (Count >= 2, "Count of Process");
      for I in D'Range loop
         Util.Tests.Assert_Equals (T, 4, D (I).Count, "Invalid count for timer at "
                                     & Natural'Image (I) & " " & Natural'Image (Count));
      end loop;
   end Test_Many_Timers;

end Util.Events.Timers.Tests;

Fix unit test

Fix unit test


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

with Ada.Strings.Unbounded;
with Ada.Streams.Stream_IO;

with Util.Test_Caller;

with Util.Streams.Files;
with Util.Streams.Texts;
package body Util.Streams.Texts.Tests is

   use Ada.Streams.Stream_IO;

   package Caller is new Util.Test_Caller (Test, "Streams.Texts");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Texts.Open, Read_Line, Close",
                       Test_Read_Line'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading a text stream.
   --  ------------------------------
   procedure Test_Read_Line (T : in out Test) is
      Stream : aliased Files.File_Stream;
      Reader : Util.Streams.Texts.Reader_Stream;
      Count  : Natural := 0;
   begin
      Stream.Open (Name => "Makefile", Mode => In_File);
      Reader.Initialize (From => Stream'Unchecked_Access);

      while not Reader.Is_Eof loop
         declare
            Line : Ada.Strings.Unbounded.Unbounded_String;
         begin
            Reader.Read_Line (Line);
            Count := Count + 1;
         end;
      end loop;
      Stream.Close;
      T.Assert (Count > 100, "Too few lines read");
   end Test_Read_Line;

end Util.Streams.Texts.Tests;

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

with Ada.Strings.Unbounded;
with Ada.Streams.Stream_IO;

with Util.Test_Caller;

with Util.Streams.Files;
with Util.Streams.Texts;
package body Util.Streams.Texts.Tests is

   use Ada.Streams.Stream_IO;

   package Caller is new Util.Test_Caller (Test, "Streams.Texts");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Texts.Open, Read_Line, Close",
                       Test_Read_Line'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading a text stream.
   --  ------------------------------
   procedure Test_Read_Line (T : in out Test) is
      Stream : aliased Files.File_Stream;
      Reader : Util.Streams.Texts.Reader_Stream;
      Count  : Natural := 0;
   begin
      Stream.Open (Name => "Makefile", Mode => In_File);
      Reader.Initialize (From => Stream'Access);

      while not Reader.Is_Eof loop
         declare
            Line : Ada.Strings.Unbounded.Unbounded_String;
         begin
            Reader.Read_Line (Line);
            Count := Count + 1;
         end;
      end loop;
      Stream.Close;
      T.Assert (Count > 100, "Too few lines read");
   end Test_Read_Line;

end Util.Streams.Texts.Tests;

Replace Unchecked_Access by Access in stream initialization