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

   use Ada.Strings.Unbounded;

   --  The logger
   Logs : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create (Driver_Name);

   --  ------------------------------
   --  Get the description associated with the command.
   --  ------------------------------
   function Get_Description (Command : in Command_Type) return String is
   begin
      return To_String (Command.Description);
   end Get_Description;

   --  ------------------------------
   --  Get the name used to register the command.
   --  ------------------------------
   function Get_Name (Command : in Command_Type) return String is
   begin
      return To_String (Command.Name);
   end Get_Name;

   --  ------------------------------
   --  Write the command usage.
   --  ------------------------------
   procedure Usage (Command : in out Command_Type;
                    Name    : in String;
                    Context : in out Context_Type) is
      Config  : Config_Type;
   begin
      Command_Type'Class (Command).Setup (Config, Context);
      Config_Parser.Usage (Name, Config);
   end Usage;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   --  ------------------------------
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Command.Driver.Log (Level, Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Compute_Size (Position : in Command_Sets.Cursor);
      procedure Print (Position : in Command_Sets.Cursor);

      Column : Ada.Text_IO.Positive_Count := 1;

      procedure Compute_Size (Position : in Command_Sets.Cursor) is
         Cmd  : constant Command_Access := Command_Sets.Element (Position);
         Len  : constant Natural := Length (Cmd.Name);
      begin
         if Natural (Column) < Len then
            Column := Ada.Text_IO.Positive_Count (Len);
         end if;
      end Compute_Size;

      procedure Print (Position : in Command_Sets.Cursor) is
         Cmd  : constant Command_Access := Command_Sets.Element (Position);
      begin
         Put ("   ");
         Put (To_String (Cmd.Name));
         if Length (Cmd.Description) > 0 then
            Set_Col (Column + 7);
            Put (To_String (Cmd.Description));
         end if;
         New_Line;
      end Print;

   begin
      Logs.Debug ("Execute command {0}", Name);

      if Args.Get_Count = 0 then
         Usage (Command.Driver.all, Args, Context);
         New_Line;
         Put ("Type '");
         Put (Args.Get_Command_Name);
         Put_Line (" help {command}' for help on a specific command.");
         New_Line;
         Put_Line ("Available subcommands:");

         Command.Driver.List.Iterate (Process => Compute_Size'Access);
         Command.Driver.List.Iterate (Process => Print'Access);
      else
         declare
            Cmd_Name   : constant String := Args.Get_Argument (1);
            Target_Cmd : constant Command_Access := Command.Driver.Find_Command (Cmd_Name);
         begin
            if Target_Cmd = null then
               Logs.Error ("Unknown command '{0}'", Cmd_Name);
               raise Not_Found;
            else
               Target_Cmd.Help (Cmd_Name, Context);
            end if;
         end;
      end if;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in out Help_Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

   --  ------------------------------
   --  Report the command usage.
   --  ------------------------------
   procedure Usage (Driver  : in Driver_Type;
                    Args    : in Argument_List'Class;
                    Context : in out Context_Type;
                    Name    : in String := "") is
   begin
      Put_Line (To_String (Driver.Desc));
      New_Line;
      if Name'Length > 0 then
         declare
            Command : constant Command_Access := Driver.Find_Command (Name);
         begin
            if Command /= null then
               Command.Usage (Name, Context);
            else
               Put ("Invalid command");
            end if;
         end;
      else
         Put ("Usage: ");
         Put (Args.Get_Command_Name);
         Put (" ");
         Put_Line (To_String (Driver.Usage));
      end if;
   end Usage;

   --  ------------------------------
   --  Set the driver description printed in the usage.
   --  ------------------------------
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String) is
   begin
      Driver.Desc := Ada.Strings.Unbounded.To_Unbounded_String (Description);
   end Set_Description;

   --  ------------------------------
   --  Set the driver usage printed in the usage.
   --  ------------------------------
   procedure Set_Usage (Driver  : in out Driver_Type;
                        Usage   : in String) is
   begin
      Driver.Usage := Ada.Strings.Unbounded.To_Unbounded_String (Usage);
   end Set_Usage;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access) is
   begin
      Command.Name := To_Unbounded_String (Name);
      Command.Driver := Driver'Unchecked_Access;
      Driver.List.Include (Command);
   end Add_Command;

   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Command     : in Command_Access) is
   begin
      Command.Name := To_Unbounded_String (Name);
      Command.Description := To_Unbounded_String (Description);
      Add_Command (Driver, Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Handler     : in Command_Handler) is
      Command : constant Command_Access
        := new Handler_Command_Type '(Driver      => Driver'Unchecked_Access,
                                      Description => To_Unbounded_String (Description),
                                      Name        => To_Unbounded_String (Name),
                                      Handler     => Handler);
   begin
      Driver.List.Include (Command);
   end Add_Command;

   --  ------------------------------
   --  Find the command having the given name.
   --  Returns null if the command was not found.
   --  ------------------------------
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access is
      Cmd : aliased Help_Command_Type;
      Pos : Command_Sets.Cursor;
   begin
      Cmd.Name := To_Unbounded_String (Name);
      Pos := Driver.List.Find (Cmd'Unchecked_Access);
      if Command_Sets.Has_Element (Pos) then
         return Command_Sets.Element (Pos);
      else
         return null;
      end if;
   end Find_Command;

   --  ------------------------------
   --  Execute the command registered under the given name.
   --  ------------------------------
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type) is
      procedure Execute (Cmd_Args : in Argument_List'Class);

      Command : constant Command_Access := Driver.Find_Command (Name);

      procedure Execute (Cmd_Args : in Argument_List'Class) is
      begin
         Command.Execute (Name, Cmd_Args, Context);
      end Execute;

   begin
      if Command /= null then
         declare
            Config  : Config_Type;
         begin
            Command.Setup (Config, Context);
            Config_Parser.Execute (Config, Args, Execute'Access);
         end;
      else
         Logs.Error ("Unkown command '{0}'", Name);
         raise Not_Found;
      end if;
   end Execute;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  ------------------------------
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
      pragma Unreferenced (Driver);
   begin
      Logs.Print (Level, "{0}: {1}", Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Handler (Name, Args, Context);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in out Handler_Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

end Util.Commands.Drivers;

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

   use Ada.Strings.Unbounded;

   --  The logger
   Logs : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create (Driver_Name);

   function "-" (Message : in String) return String is (Translate (Message)) with Inline;

   --  ------------------------------
   --  Get the description associated with the command.
   --  ------------------------------
   function Get_Description (Command : in Command_Type) return String is
   begin
      return To_String (Command.Description);
   end Get_Description;

   --  ------------------------------
   --  Get the name used to register the command.
   --  ------------------------------
   function Get_Name (Command : in Command_Type) return String is
   begin
      return To_String (Command.Name);
   end Get_Name;

   --  ------------------------------
   --  Write the command usage.
   --  ------------------------------
   procedure Usage (Command : in out Command_Type;
                    Name    : in String;
                    Context : in out Context_Type) is
      Config  : Config_Type;
   begin
      Command_Type'Class (Command).Setup (Config, Context);
      Config_Parser.Usage (Name, Config);
   end Usage;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   --  ------------------------------
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Command.Driver.Log (Level, Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Compute_Size (Position : in Command_Sets.Cursor);
      procedure Print (Position : in Command_Sets.Cursor);

      Column : Ada.Text_IO.Positive_Count := 1;

      procedure Compute_Size (Position : in Command_Sets.Cursor) is
         Cmd  : constant Command_Access := Command_Sets.Element (Position);
         Len  : constant Natural := Length (Cmd.Name);
      begin
         if Natural (Column) < Len then
            Column := Ada.Text_IO.Positive_Count (Len);
         end if;
      end Compute_Size;

      procedure Print (Position : in Command_Sets.Cursor) is
         Cmd  : constant Command_Access := Command_Sets.Element (Position);
      begin
         Put ("   ");
         Put (To_String (Cmd.Name));
         if Length (Cmd.Description) > 0 then
            Set_Col (Column + 7);
            Put (To_String (Cmd.Description));
         end if;
         New_Line;
      end Print;

   begin
      Logs.Debug ("Execute command {0}", Name);

      if Args.Get_Count = 0 then
         Usage (Command.Driver.all, Args, Context);
         New_Line;
         Put ("Type '");
         Put (Driver_Name);
         Put_Line (" help {command}' for help on a specific command.");
         New_Line;
         Put_Line (-("Available subcommands:"));

         Command.Driver.List.Iterate (Process => Compute_Size'Access);
         Command.Driver.List.Iterate (Process => Print'Access);
      else
         declare
            Cmd_Name   : constant String := Args.Get_Argument (1);
            Target_Cmd : constant Command_Access := Command.Driver.Find_Command (Cmd_Name);
         begin
            if Target_Cmd = null then
               Logs.Error (-("Unknown command '{0}'"), Cmd_Name);
               raise Not_Found;
            else
               Target_Cmd.Help (Cmd_Name, Context);
            end if;
         end;
      end if;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in out Help_Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

   --  ------------------------------
   --  Report the command usage.
   --  ------------------------------
   procedure Usage (Driver  : in Driver_Type;
                    Args    : in Argument_List'Class;
                    Context : in out Context_Type;
                    Name    : in String := "") is
   begin
      Put_Line (To_String (Driver.Desc));
      New_Line;
      if Name'Length > 0 then
         declare
            Command : constant Command_Access := Driver.Find_Command (Name);
         begin
            if Command /= null then
               Command.Usage (Name, Context);
            else
               Put (-("Invalid command"));
            end if;
         end;
      else
         Put (-("Usage: "));
         Put (Args.Get_Command_Name);
         Put (" ");
         Put_Line (To_String (Driver.Usage));
      end if;
   end Usage;

   --  ------------------------------
   --  Set the driver description printed in the usage.
   --  ------------------------------
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String) is
   begin
      Driver.Desc := Ada.Strings.Unbounded.To_Unbounded_String (Description);
   end Set_Description;

   --  ------------------------------
   --  Set the driver usage printed in the usage.
   --  ------------------------------
   procedure Set_Usage (Driver  : in out Driver_Type;
                        Usage   : in String) is
   begin
      Driver.Usage := Ada.Strings.Unbounded.To_Unbounded_String (Usage);
   end Set_Usage;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access) is
   begin
      Command.Name := To_Unbounded_String (Name);
      Command.Driver := Driver'Unchecked_Access;
      Driver.List.Include (Command);
   end Add_Command;

   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Command     : in Command_Access) is
   begin
      Command.Name := To_Unbounded_String (Name);
      Command.Description := To_Unbounded_String (Description);
      Add_Command (Driver, Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Handler     : in Command_Handler) is
      Command : constant Command_Access
        := new Handler_Command_Type '(Driver      => Driver'Unchecked_Access,
                                      Description => To_Unbounded_String (Description),
                                      Name        => To_Unbounded_String (Name),
                                      Handler     => Handler);
   begin
      Driver.List.Include (Command);
   end Add_Command;

   --  ------------------------------
   --  Find the command having the given name.
   --  Returns null if the command was not found.
   --  ------------------------------
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access is
      Cmd : aliased Help_Command_Type;
      Pos : Command_Sets.Cursor;
   begin
      Cmd.Name := To_Unbounded_String (Name);
      Pos := Driver.List.Find (Cmd'Unchecked_Access);
      if Command_Sets.Has_Element (Pos) then
         return Command_Sets.Element (Pos);
      else
         return null;
      end if;
   end Find_Command;

   --  ------------------------------
   --  Execute the command registered under the given name.
   --  ------------------------------
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type) is
      procedure Execute (Cmd_Args : in Argument_List'Class);

      Command : constant Command_Access := Driver.Find_Command (Name);

      procedure Execute (Cmd_Args : in Argument_List'Class) is
      begin
         Command.Execute (Name, Cmd_Args, Context);
      end Execute;

   begin
      if Command /= null then
         declare
            Config  : Config_Type;
         begin
            Command.Setup (Config, Context);
            Config_Parser.Execute (Config, Args, Execute'Access);
         end;
      else
         Logs.Error (-("Unkown command '{0}'"), Name);
         raise Not_Found;
      end if;
   end Execute;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  ------------------------------
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
      pragma Unreferenced (Driver);
   begin
      Logs.Print (Level, "{0}: {1}", Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Handler (Name, Args, Context);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in out Handler_Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

end Util.Commands.Drivers;

Use the Translate function for every message that can be reported to the user


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

with MAT.Events;
with MAT.Types;
with MAT.Readers.Marshaller;
with Interfaces;
package body MAT.Readers is

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

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

   --  ------------------------------
   --  Register the reader 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_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Message_Handler;
   begin
      Handler.For_Servant := Reader;
      Handler.Id := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Readers.Insert (Name, Handler);
   end Register_Reader;

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message) is
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      if Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         declare
            Handler : constant Message_Handler := Handler_Maps.Element (Pos);
         begin
            Dispatch (Handler.For_Servant.all, Handler.Id, Handler.Mapping.all'Access, Msg);
         end;
      end if;
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint8 := MAT.Readers.Marshaller.Get_Uint8 (Msg.Buffer);
      Pos   : constant Reader_Maps.Cursor := Client.Readers.Find (Name);

      procedure Read_Attributes (Key     : in String;
                                 Element : in out Message_Handler) is
      begin
         Element.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
         for I in 1 .. Natural (Count) loop
            declare
               Name : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
               Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
            begin
               for J in Element.Attributes'Range loop
                  if Element.Attributes (J).Name.all = Name then
                     Element.Mapping (I) := Element.Attributes (J);
                  end if;
               end loop;
            end;
         end loop;
      end Read_Attributes;

   begin
      Log.Debug ("Read event definition {0}", Name);
      if Reader_Maps.Has_Element (Pos) then
         Client.Readers.Update_Element (Pos, Read_Attributes'Access);
      end if;
   end Read_Definition;

   --  ------------------------------
   --  Read the event data stream headers with the event description.
   --  Configure the reader to analyze the data stream according to the event descriptions.
   --  ------------------------------
   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message) is
      Count : MAT.Types.Uint16;
   begin
      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;
   end Read_Headers;

end MAT.Readers;

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

with MAT.Events;
with MAT.Types;
with MAT.Readers.Marshaller;
with Interfaces;
package body MAT.Readers is

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

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

   --  ------------------------------
   --  Register the reader 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_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Message_Handler;
   begin
      Handler.For_Servant := Reader;
      Handler.Id := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Readers.Insert (Name, Handler);
   end Register_Reader;

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message) is
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      Log.Debug ("Dispatch message {0} - size {1}",
                 MAT.Types.Uint16'Image (Event),
                 Natural'Image (Msg.Size));

      if not Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         declare
            Handler : constant Message_Handler := Handler_Maps.Element (Pos);
         begin
            Dispatch (Handler.For_Servant.all, Handler.Id, Handler.Mapping.all'Access, Msg);
         end;
      end if;
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint8 := MAT.Readers.Marshaller.Get_Uint8 (Msg.Buffer);
      Pos   : constant Reader_Maps.Cursor := Client.Readers.Find (Name);
   begin
      Log.Debug ("Read event definition {0}", Name);
      for I in 1 .. Natural (Count) loop
         declare
            Name : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
            Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Message_Handler) is
               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);
                  end if;
               end loop;
            end Read_Attribute;

         begin
            if Reader_Maps.Has_Element (Pos) then
               Client.Readers.Update_Element (Pos, Read_Attribute'Access);
            end if;
         end;
      end loop;

   end Read_Definition;

   --  ------------------------------
   --  Read the event data stream headers with the event description.
   --  Configure the reader to analyze the data stream according to the event descriptions.
   --  ------------------------------
   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message) is
      Count : MAT.Types.Uint16;
   begin
      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;
   end Read_Headers;

end MAT.Readers;

Fix reading the event description in the header section


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

package body Gen.Artifacts.Docs.Googlecode is

   --  ------------------------------
   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   --  ------------------------------
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Document.Name) & ".wiki";
   end Get_Document_Name;

   --  ------------------------------
   --  Start a new document.
   --  ------------------------------
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is
   begin
      Ada.Text_IO.Put_Line (File, "#summary " & Ada.Strings.Unbounded.To_String (Document.Title));
      Ada.Text_IO.New_Line (File);
   end Start_Document;

   --  ------------------------------
   --  Write a line in the target document formatting the line if necessary.
   --  ------------------------------
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is
   begin
      if Line.Kind = L_LIST then
         Ada.Text_IO.New_Line (File);
         Ada.Text_IO.Put (File, Line.Content);
         Formatter.Need_Newline := True;

      elsif Line.Kind = L_LIST_ITEM then
         Ada.Text_IO.Put (File, Line.Content);
         Formatter.Need_Newline := True;

      else
         if Formatter.Need_Newline then
            Ada.Text_IO.New_Line (File);
            Formatter.Need_Newline := False;
         end if;
         Ada.Text_IO.Put_Line (File, Line.Content);
      end if;
   end Write_Line;

end Gen.Artifacts.Docs.Googlecode;

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

package body Gen.Artifacts.Docs.Googlecode is

   --  ------------------------------
   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   --  ------------------------------
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Document.Name) & ".wiki";
   end Get_Document_Name;

   --  ------------------------------
   --  Start a new document.
   --  ------------------------------
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is
   begin
      Ada.Text_IO.Put_Line (File, "#summary " & Ada.Strings.Unbounded.To_String (Document.Title));
      Ada.Text_IO.New_Line (File);
   end Start_Document;

   --  ------------------------------
   --  Write a line in the target document formatting the line if necessary.
   --  ------------------------------
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is
   begin
      if Line.Kind = L_LIST then
         Ada.Text_IO.New_Line (File);
         Ada.Text_IO.Put (File, Line.Content);
         Formatter.Need_Newline := True;

      elsif Line.Kind = L_LIST_ITEM then
         Ada.Text_IO.Put (File, Line.Content);
         Formatter.Need_Newline := True;

      else
         if Formatter.Need_Newline then
            Ada.Text_IO.New_Line (File);
            Formatter.Need_Newline := False;
         end if;
         Ada.Text_IO.Put_Line (File, Line.Content);
      end if;
   end Write_Line;

   --  ------------------------------
   --  Finish the document.
   --  ------------------------------
   overriding
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String) is
   begin
      Ada.Text_IO.New_Line (File);
      Ada.Text_IO.Put_Line (File, "----");
      Ada.Text_IO.Put_Line (File,
                            "[https://github.com/stcarrez/dynamo Generated by Dynamo] from _"
                            & Source & "_");
   end Finish_Document;

end Gen.Artifacts.Docs.Googlecode;

Implement the Finish_Document procedure

Implement the Finish_Document procedure


-----------------------------------------------------------------------
--  schemas Tests -- Test loading of database schema
--  Copyright (C) 2009, 2010, 2011, 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.Tests;
package ADO.Schemas.Tests is

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

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

   --  Test reading the entity cache and the Find_Entity_Type operation
   procedure Test_Find_Entity_Type (T : in out Test);

   --  Test calling Find_Entity_Type with an invalid table.
   procedure Test_Find_Entity_Type_Error (T : in out Test);

   --  Test the Load_Schema operation and check the result schema.
   procedure Test_Load_Schema (T : in out Test);

   --  Test the Table_Cursor operations and check the result schema.
   procedure Test_Table_Iterator (T : in out Test);

   --  Test the Table_Cursor operations on an empty schema.
   procedure Test_Empty_Schema (T : in out Test);

end ADO.Schemas.Tests;

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

with Util.Tests;
package ADO.Schemas.Tests is

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

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

   --  Test reading the entity cache and the Find_Entity_Type operation
   procedure Test_Find_Entity_Type (T : in out Test);

   --  Test calling Find_Entity_Type with an invalid table.
   procedure Test_Find_Entity_Type_Error (T : in out Test);

   --  Test the Load_Schema operation and check the result schema.
   procedure Test_Load_Schema (T : in out Test);

   --  Test the Table_Cursor operations and check the result schema.
   procedure Test_Table_Iterator (T : in out Test);

   --  Test the Table_Cursor operations on an empty schema.
   procedure Test_Empty_Schema (T : in out Test);

   --  Test the creation of database.
   procedure Test_Create_Schema (T : in out Test);

end ADO.Schemas.Tests;

Declare the Test_Create_Schema procedure


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

with MAT.Types;
with MAT.Frames;

with Interfaces;
package MAT.Memory is

   type Allocation is record
      Size   : MAT.Types.Target_Size;
      Frame  : Frames.Frame_Ptr;
      Time   : MAT.Types.Target_Tick_Ref;
      Thread : MAT.Types.Target_Thread_Ref;
   end record;

   use type MAT.Types.Target_Addr;
   package Allocation_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Allocation);

   --  Memory allocation objects are stored in an AVL tree sorted
   --  on the memory slot address.
--
   subtype Allocation_Map is Allocation_Maps.Map;
--
--     subtype Allocation_Ref is Allocation_AVL.Iterator;
--     --  Type representing a reference to a memory allocation slot.
--
--     use Allocation_AVL;
--     package Allocation_Ref_Containers is new BC.Containers (Allocation_Ref);
--     package Allocation_Ref_Trees is new Allocation_Ref_Containers.Trees;
--     package Allocation_Ref_AVL is
--       new Allocation_Ref_Trees.AVL (Key => Target_Addr,
--                                     Storage => Global_Heap.Storage);
--     --  Tree of references to memory allocation objects.
--
--     subtype Allocation_Ref_Map is Allocation_Ref_AVL.AVL_Tree;
--     subtype Allocation_Ref_Ref is Allocation_Ref_AVL.Iterator;

private

end MAT.Memory;

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

with MAT.Types;
with MAT.Frames;

with Interfaces;
package MAT.Memory is

   type Allocation is record
      Size   : MAT.Types.Target_Size;
      Frame  : Frames.Frame_Ptr;
      Time   : MAT.Types.Target_Tick_Ref;
      Thread : MAT.Types.Target_Thread_Ref;
   end record;

   use type MAT.Types.Target_Addr;
   package Allocation_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Allocation);

   --  Memory allocation objects are stored in an AVL tree sorted
   --  on the memory slot address.
--
   subtype Allocation_Map is Allocation_Maps.Map;
   subtype Allocation_Cursor is Allocation_Maps.Cursor;
--
--     subtype Allocation_Ref is Allocation_AVL.Iterator;
--     --  Type representing a reference to a memory allocation slot.
--
--     use Allocation_AVL;
--     package Allocation_Ref_Containers is new BC.Containers (Allocation_Ref);
--     package Allocation_Ref_Trees is new Allocation_Ref_Containers.Trees;
--     package Allocation_Ref_AVL is
--       new Allocation_Ref_Trees.AVL (Key => Target_Addr,
--                                     Storage => Global_Heap.Storage);
--     --  Tree of references to memory allocation objects.
--
--     subtype Allocation_Ref_Map is Allocation_Ref_AVL.AVL_Tree;
--     subtype Allocation_Ref_Ref is Allocation_Ref_AVL.Iterator;

private

end MAT.Memory;

Define Allocation_Cursor

Define Allocation_Cursor


-----------------------------------------------------------------------
--  util-beans-objects-datasets-tests -- Unit tests for dataset beans
--  Copyright (C) 2013, 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.Test_Caller;

package body Util.Beans.Objects.Datasets.Tests is

   package Caller is new Util.Test_Caller (Test, "Objects.Datasets");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Beans.Objects.Datasets",
                       Test_Fill_Dataset'Access);
   end Add_Tests;

   --  Test the creation, initialization and retrieval of dataset content.
   procedure Test_Fill_Dataset (T : in out Test) is
      Set : Dataset;

      procedure Fill (Row : in out Object_Array) is
      begin
         Row (Row'First)     := To_Object (String '("john"));
         Row (Row'First + 1) := To_Object (String '("jj@gmail.com"));
         Row (Row'First + 2) := To_Object (Set.Get_Count);
      end Fill;

   begin
      Set.Add_Column ("name");
      Set.Add_Column ("email");
      Set.Add_Column ("age");

      for I in 1 .. 100 loop
         Set.Append (Fill'Access);
      end loop;
      Util.Tests.Assert_Equals (T, 100, Set.Get_Count, "Invalid number of rows");

      for I in 1 .. 100 loop
         Set.Set_Row_Index (I);
         declare
            R : constant Object := Set.Get_Row;
         begin
            T.Assert (not Is_Null (R), "Row is null");
            Util.Tests.Assert_Equals (T, "john", To_String (Get_Value (R, "name")),
                                      "Invalid 'name' attribute");
            Util.Tests.Assert_Equals (T, I, To_Integer (Get_Value (R, "age")),
                                      "Invalid 'age' attribute");
         end;
      end loop;
   end Test_Fill_Dataset;

end Util.Beans.Objects.Datasets.Tests;

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

with Util.Test_Caller;

package body Util.Beans.Objects.Datasets.Tests is

   package Caller is new Util.Test_Caller (Test, "Objects.Datasets");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Beans.Objects.Datasets",
                       Test_Fill_Dataset'Access);
   end Add_Tests;

   --  Test the creation, initialization and retrieval of dataset content.
   procedure Test_Fill_Dataset (T : in out Test) is
      procedure Fill (Row : in out Object_Array);

      Set : Dataset;

      procedure Fill (Row : in out Object_Array) is
      begin
         Row (Row'First)     := To_Object (String '("john"));
         Row (Row'First + 1) := To_Object (String '("jj@gmail.com"));
         Row (Row'First + 2) := To_Object (Set.Get_Count);
      end Fill;

   begin
      Set.Add_Column ("name");
      Set.Add_Column ("email");
      Set.Add_Column ("age");

      for I in 1 .. 100 loop
         Set.Append (Fill'Access);
      end loop;
      Util.Tests.Assert_Equals (T, 100, Set.Get_Count, "Invalid number of rows");

      for I in 1 .. 100 loop
         Set.Set_Row_Index (I);
         declare
            R : constant Object := Set.Get_Row;
         begin
            T.Assert (not Is_Null (R), "Row is null");
            Util.Tests.Assert_Equals (T, "john", To_String (Get_Value (R, "name")),
                                      "Invalid 'name' attribute");
            Util.Tests.Assert_Equals (T, I, To_Integer (Get_Value (R, "age")),
                                      "Invalid 'age' attribute");
         end;
      end loop;
   end Test_Fill_Dataset;

end Util.Beans.Objects.Datasets.Tests;

Declare the Fill internal procedure

Declare the Fill internal procedure


-----------------------------------------------------------------------
--  asf-servlets-faces-mappers -- Read faces specific configuration files
--  Copyright (C) 2015, 2016, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Servlet.Core;
with ASF.Routes;
package body ASF.Servlets.Faces.Mappers is

   use type ASF.Routes.Route_Type_Access;
   use type Servlet.Core.Servlet_Access;

   function Find_Servlet (Container : in Servlet_Registry_Access;
                          View      : in String)
                          return ASF.Servlets.Servlet_Access;

   function Find_Servlet (Container : in Servlet_Registry_Access;
                          View      : in String)
                          return ASF.Servlets.Servlet_Access is
      Disp  : constant Servlet.Core.Request_Dispatcher := Container.Get_Request_Dispatcher (View);
      Serv  : constant Servlet_Access := Servlet.Core.Get_Servlet (Disp);
   begin
      if Serv = null then
         raise Util.Serialize.Mappers.Field_Error with "No servlet mapped to view " & View;
      end if;
      return Serv; --  Servlet.Routes.Servlets.Servlet_Route_Type'Class (Route.all).Servlet;
   end Find_Servlet;

   --  ------------------------------
   --  Save in the servlet config object the value associated with the given field.
   --  When the URL_MAPPING, URL_PATTERN, VIEW_ID field
   --  is reached, insert the new configuration rule in the servlet registry.
   --  ------------------------------
   procedure Set_Member (N     : in out Servlet_Config;
                         Field : in Servlet_Fields;
                         Value : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      case Field is
         when URL_PATTERN =>
            N.URL_Pattern := Value;

         when VIEW_ID =>
            N.View_Id := Value;

         when URL_MAPPING =>
            declare
               procedure Insert (Route : in out ASF.Routes.Route_Type_Ref);

               View    : constant String := To_String (N.View_Id);
               Servlet : constant ASF.Servlets.Servlet_Access := Find_Servlet (N.Handler, View);

               procedure Insert (Route : in out ASF.Routes.Route_Type_Ref) is
                  To : ASF.Routes.Faces_Route_Type_Access;
               begin
                  if Route.Is_Null then
                     To := new ASF.Routes.Faces_Route_Type;
                     To.View    := Ada.Strings.Unbounded.To_Unbounded_String (View);
                     To.Servlet := Servlet;
                     Route := ASF.Routes.Route_Type_Refs.Create (To.all'Access);
                  end if;
               end Insert;

            begin
               N.Handler.Add_Route (Pattern   => To_String (N.URL_Pattern),
                                    ELContext => N.Context.all,
                                    Process   => Insert'Access);
            end;
      end case;
   end Set_Member;

   SMapper : aliased Servlet_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the servlet and mapping rules <b>url-mapping</b>.
   --  ------------------------------
   package body Reader_Config is
   begin
      Mapper.Add_Mapping ("faces-config", SMapper'Access);
      Mapper.Add_Mapping ("module", SMapper'Access);
      Mapper.Add_Mapping ("web-app", SMapper'Access);
      Config.Handler := Handler;
      Config.Context := Context;
      Servlet_Mapper.Set_Context (Mapper, Config'Unchecked_Access);
   end Reader_Config;

begin
   SMapper.Add_Mapping ("url-mapping", URL_MAPPING);
   SMapper.Add_Mapping ("url-mapping/pattern", URL_PATTERN);
   SMapper.Add_Mapping ("url-mapping/view-id", VIEW_ID);
end ASF.Servlets.Faces.Mappers;

-----------------------------------------------------------------------
--  asf-servlets-faces-mappers -- Read faces specific configuration files
--  Copyright (C) 2015, 2016, 2017, 2018, 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Servlet.Core;
with ASF.Routes;
package body ASF.Servlets.Faces.Mappers is

   use type Servlet.Core.Servlet_Access;

   function Find_Servlet (Container : in Servlet_Registry_Access;
                          View      : in String)
                          return ASF.Servlets.Servlet_Access;

   function Find_Servlet (Container : in Servlet_Registry_Access;
                          View      : in String)
                          return ASF.Servlets.Servlet_Access is
      Disp  : constant Servlet.Core.Request_Dispatcher := Container.Get_Request_Dispatcher (View);
      Serv  : constant Servlet_Access := Servlet.Core.Get_Servlet (Disp);
   begin
      if Serv = null then
         raise Util.Serialize.Mappers.Field_Error with "No servlet mapped to view " & View;
      end if;
      return Serv;
   end Find_Servlet;

   --  ------------------------------
   --  Save in the servlet config object the value associated with the given field.
   --  When the URL_MAPPING, URL_PATTERN, VIEW_ID field
   --  is reached, insert the new configuration rule in the servlet registry.
   --  ------------------------------
   procedure Set_Member (N     : in out Servlet_Config;
                         Field : in Servlet_Fields;
                         Value : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      case Field is
         when URL_PATTERN =>
            N.URL_Pattern := Value;

         when VIEW_ID =>
            N.View_Id := Value;

         when URL_MAPPING =>
            declare
               procedure Insert (Route : in out ASF.Routes.Route_Type_Ref);

               View    : constant String := To_String (N.View_Id);
               Servlet : constant ASF.Servlets.Servlet_Access := Find_Servlet (N.Handler, View);

               procedure Insert (Route : in out ASF.Routes.Route_Type_Ref) is
                  To : ASF.Routes.Faces_Route_Type_Access;
               begin
                  if Route.Is_Null then
                     To := new ASF.Routes.Faces_Route_Type;
                     To.View    := Ada.Strings.Unbounded.To_Unbounded_String (View);
                     To.Servlet := Servlet;
                     Route := ASF.Routes.Route_Type_Refs.Create (To.all'Access);
                  end if;
               end Insert;

            begin
               N.Handler.Add_Route (Pattern   => To_String (N.URL_Pattern),
                                    ELContext => N.Context.all,
                                    Process   => Insert'Access);
            end;
      end case;
   end Set_Member;

   SMapper : aliased Servlet_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the servlet and mapping rules <b>url-mapping</b>.
   --  ------------------------------
   package body Reader_Config is
   begin
      Mapper.Add_Mapping ("faces-config", SMapper'Access);
      Mapper.Add_Mapping ("module", SMapper'Access);
      Mapper.Add_Mapping ("web-app", SMapper'Access);
      Config.Handler := Handler;
      Config.Context := Context;
      Servlet_Mapper.Set_Context (Mapper, Config'Unchecked_Access);
   end Reader_Config;

begin
   SMapper.Add_Mapping ("url-mapping", URL_MAPPING);
   SMapper.Add_Mapping ("url-mapping/pattern", URL_PATTERN);
   SMapper.Add_Mapping ("url-mapping/view-id", VIEW_ID);
end ASF.Servlets.Faces.Mappers;

Remove unused use clauses

Remove unused use clauses


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

with Ada.Unchecked_Deallocation;

package body Util.Beans.Basic.Lists is

   --  ------------------------------
   --  Initialize the list bean.
   --  ------------------------------
   overriding
   procedure Initialize (Object : in out List_Bean) is
      Bean : constant Readonly_Bean_Access := Object.Current'Unchecked_Access;
   begin
      Object.Row := Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
   end Initialize;

   --  ------------------------------
   --  Get the number of elements in the list.
   --  ------------------------------
   function Get_Count (From : in List_Bean) return Natural is
   begin
      return Natural (Vectors.Length (From.List));
   end Get_Count;

   --  ------------------------------
   --  Set the current row index.  Valid row indexes start at 1.
   --  ------------------------------
   procedure Set_Row_Index (From  : in out List_Bean;
                            Index : in Natural) is
   begin
      From.Current_Index := Index;
      From.Current := Vectors.Element (From.List, Index - 1);
   end Set_Row_Index;

   --  ------------------------------
   --  Returns the current row index.
   --  ------------------------------
   function Get_Row_Index (From : in List_Bean) return Natural is
   begin
      return From.Current_Index;
   end Get_Row_Index;

   --  ------------------------------
   --  Get the element at the current row index.
   --  ------------------------------
   function Get_Row (From : in List_Bean) return Util.Beans.Objects.Object is
   begin
      return From.Row;
   end Get_Row;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Value (From : in List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "count" then
         return Util.Beans.Objects.To_Object (Integer (From.List.Length));
      elsif Name = "rowIndex" then
         return Util.Beans.Objects.To_Object (From.Current_Index);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Deletes the list bean
   --  ------------------------------
   procedure Free (List : in out Util.Beans.Basic.Readonly_Bean_Access) is

      procedure Free is
        new Ada.Unchecked_Deallocation (List_Bean'Class,
                                        List_Bean_Access);
   begin
      if List.all in List_Bean'Class then
         declare
            L : List_Bean_Access := List_Bean (List.all)'Unchecked_Access;
         begin
            Free (L);
            List := null;
         end;
      end if;
   end Free;

end Util.Beans.Basic.Lists;

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

with Ada.Unchecked_Deallocation;

package body Util.Beans.Basic.Lists is

   --  ------------------------------
   --  Initialize the list bean.
   --  ------------------------------
   overriding
   procedure Initialize (Object : in out List_Bean) is
      Bean : constant Readonly_Bean_Access := Object.Current'Unchecked_Access;
   begin
      Object.Row := Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
   end Initialize;

   --  ------------------------------
   --  Get the number of elements in the list.
   --  ------------------------------
   function Get_Count (From : in List_Bean) return Natural is
   begin
      return Natural (Vectors.Length (From.List));
   end Get_Count;

   --  ------------------------------
   --  Set the current row index.  Valid row indexes start at 1.
   --  ------------------------------
   procedure Set_Row_Index (From  : in out List_Bean;
                            Index : in Natural) is
   begin
      From.Current_Index := Index;
      From.Current := Vectors.Element (From.List, Index - 1);
   end Set_Row_Index;

   --  ------------------------------
   --  Returns the current row index.
   --  ------------------------------
   function Get_Row_Index (From : in List_Bean) return Natural is
   begin
      return From.Current_Index;
   end Get_Row_Index;

   --  ------------------------------
   --  Get the element at the current row index.
   --  ------------------------------
   function Get_Row (From : in List_Bean) return Util.Beans.Objects.Object is
   begin
      return From.Row;
   end Get_Row;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Value (From : in List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "count" then
         return Util.Beans.Objects.To_Object (Integer (From.List.Length));
      elsif Name = "rowIndex" then
         return Util.Beans.Objects.To_Object (From.Current_Index);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Deletes the list bean
   --  ------------------------------
   procedure Free (List : in out Util.Beans.Basic.Readonly_Bean_Access) is

      procedure Free is
        new Ada.Unchecked_Deallocation (List_Bean'Class,
                                        List_Bean_Access);
   begin
      if List.all in List_Bean'Class then
         declare
            L : List_Bean_Access := List_Bean (List.all)'Unchecked_Access;
         begin
            Free (L);
            List := null;
         end;
      end if;
   end Free;

end Util.Beans.Basic.Lists;

Update the header

Update the header


-----------------------------------------------------------------------
--  asf_volume_server -- The volume_server application with Ada Server Faces
--  Copyright (C) 2010, 2011 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 ASF.Server.Web;
with ASF.Servlets;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Filters.Dump;
with ASF.Applications;
with ASF.Applications.Main;
with Util.Beans.Objects;

with Volume;
procedure Asf_Volume_Server is

   CONTEXT_PATH : constant String := "/volume";

   Factory : ASF.Applications.Main.Application_Factory;
   App     : aliased ASF.Applications.Main.Application;
   Faces   : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files   : aliased ASF.Servlets.Files.File_Servlet;
   Dump    : aliased ASF.Filters.Dump.Dump_Filter;
   Bean    : aliased Volume.Compute_Bean;
   Conv    : constant access Volume.Float_Converter := new Volume.Float_Converter;
   WS      : ASF.Server.Web.AWS_Container;
   C       : ASF.Applications.Config;
begin
   Bean.Radius := 1.2;
   Bean.Height := 2.0;
   C.Set (ASF.Applications.VIEW_EXT, ".html");
   C.Set (ASF.Applications.VIEW_DIR, "samples/web");
   C.Set ("web.dir", "samples/web");

   App.Initialize (C, Factory);
   App.Set_Global ("contextPath", CONTEXT_PATH);
   App.Set_Global ("compute", Util.Beans.Objects.To_Object (Bean'Unchecked_Access));

   --  Register the servlets and filters
   App.Add_Servlet (Name => "faces", Server => Faces'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);
   App.Add_Filter (Name => "dump", Filter => Dump'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "faces", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");

   App.Add_Converter (Name => "float", Converter => Conv.all'Unchecked_Access);

   WS.Register_Application (CONTEXT_PATH, App'Unchecked_Access);

   WS.Start;

   delay 600.0;

end Asf_Volume_Server;

-----------------------------------------------------------------------
--  asf_volume_server -- The volume_server application with Ada Server Faces
--  Copyright (C) 2010, 2011 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 ASF.Server.Web;
with ASF.Servlets;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Filters.Dump;
with ASF.Applications;
with ASF.Applications.Main;
with Util.Beans.Objects;
with Util.Log.Loggers;

with Volume;
procedure Asf_Volume_Server is

   CONTEXT_PATH : constant String := "/volume";

   Log     : Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Openid");

   Factory : ASF.Applications.Main.Application_Factory;
   App     : aliased ASF.Applications.Main.Application;
   Faces   : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files   : aliased ASF.Servlets.Files.File_Servlet;
   Dump    : aliased ASF.Filters.Dump.Dump_Filter;
   Bean    : aliased Volume.Compute_Bean;
   Conv    : constant access Volume.Float_Converter := new Volume.Float_Converter;
   WS      : ASF.Server.Web.AWS_Container;
   C       : ASF.Applications.Config;
begin
   C.Set (ASF.Applications.VIEW_EXT, ".html");
   C.Set (ASF.Applications.VIEW_DIR, "samples/web");
   C.Set ("web.dir", "samples/web");

   App.Initialize (C, Factory);
   App.Set_Global ("contextPath", CONTEXT_PATH);
   App.Set_Global ("compute", Util.Beans.Objects.To_Object (Bean'Unchecked_Access));

   --  Register the servlets and filters
   App.Add_Servlet (Name => "faces", Server => Faces'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);
   App.Add_Filter (Name => "dump", Filter => Dump'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "faces", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");

   App.Add_Converter (Name => "float", Converter => Conv.all'Unchecked_Access);

   WS.Register_Application (CONTEXT_PATH, App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/volume/compute.html");
   WS.Start;

   delay 600.0;

end Asf_Volume_Server;

Add a log to tell the main URL to look at after the server is started


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

package body Util.Beans.Objects.Vectors is

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

   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   procedure Set_Value (From  : in out Vector_Bean;
                        Name  : in String;
                        Value : in Object) is
   begin
      null;
   end Set_Value;

   --  Create an object that contains a <tt>Vector_Bean</tt> instance.
   function Create return Object is
      M : constant access Vector_Bean'Class := new Vector_Bean;
   begin
      return To_Object (Value => M, Storage => DYNAMIC);
   end Create;

end Util.Beans.Objects.Vectors;

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

package body Util.Beans.Objects.Vectors is

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Value (From : in Vector_Bean;
                       Name : in String) return Object is
   begin
      if Name = "count" then
         return To_Object (Natural (From.Length));
      else
         return Null_Object;
      end if;
   end Get_Value;

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

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

   --  -----------------------
   --  Create an object that contains a <tt>Vector_Bean</tt> instance.
   --  -----------------------
   function Create return Object is
      M : constant access Vector_Bean'Class := new Vector_Bean;
   begin
      return To_Object (Value => M, Storage => DYNAMIC);
   end Create;

end Util.Beans.Objects.Vectors;

Implement the Vector_Bean operations for the Array_Bean interface


-----------------------------------------------------------------------
--  Util.Streams.Files -- File Stream utilities
--  Copyright (C) 2010, 2011, 2012, 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Util.Streams.Buffered;
with Util.Texts.Transforms;
with Ada.Characters.Handling;
with Ada.Wide_Wide_Characters.Handling;
with Ada.Calendar;
with GNAT.Calendar.Time_IO;
package Util.Streams.Texts is

   --  -----------------------
   --  Print stream
   --  -----------------------
   --  The Print_Stream is an output stream which provides helper methods
   --  for writing text streams.
   type Print_Stream is new Buffered.Buffered_Stream with private;
   type Print_Stream_Access is access all Print_Stream'Class;

   procedure Initialize (Stream : in out Print_Stream;
                         To     : in Output_Stream_Access);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Integer);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Long_Long_Integer);

   --  Write a string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a date on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Calendar.Time;
                    Format : in GNAT.Calendar.Time_IO.Picture_String
                    := GNAT.Calendar.Time_IO.ISO_Date);

   --  Get the output stream content as a string.
   function To_String (Stream : in Buffered.Buffered_Stream) return String;

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Buffered.Buffered_Stream'Class;
                         Item   : in Character);

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Buffered.Buffered_Stream'Class;
                         Item   : in Wide_Wide_Character);

   package TR is
     new Util.Texts.Transforms (Stream => Buffered.Buffered_Stream'Class,
                                Char   => Character,
                                Input  => String,
                                Put    => Write_Char,
                                To_Upper => Ada.Characters.Handling.To_Upper,
                                To_Lower => Ada.Characters.Handling.To_Lower);

   package WTR is
     new Util.Texts.Transforms (Stream => Buffered.Buffered_Stream'Class,
                                Char   => Wide_Wide_Character,
                                Input  => Wide_Wide_String,
                                Put    => Write_Char,
                                To_Upper => Ada.Wide_Wide_Characters.Handling.To_Upper,
                                To_Lower => Ada.Wide_Wide_Characters.Handling.To_Lower);

   --  -----------------------
   --  Reader stream
   --  -----------------------
   --  The Reader_Stream is an input stream which provides helper methods
   --  for reading text streams.
   type Reader_Stream is new Buffered.Buffered_Stream with private;
   type Reader_Stream_Access is access all Reader_Stream'Class;

   --  Initialize the reader to read the input from the input stream given in From.
   procedure Initialize (Stream : in out Reader_Stream;
                         From   : in Input_Stream_Access);

   --  Read an input line from the input stream.  The line is terminated by ASCII.LF.
   --  When Strip is set, the line terminators (ASCII.CR, ASCII.LF) are removed.
   procedure Read_Line (Stream : in out Reader_Stream;
                        Into   : out Ada.Strings.Unbounded.Unbounded_String;
                        Strip  : in Boolean := False);

private

   type Print_Stream is new Buffered.Buffered_Stream with null record;

   type Reader_Stream is new Buffered.Buffered_Stream with null record;

end Util.Streams.Texts;

-----------------------------------------------------------------------
--  Util.Streams.Files -- File Stream utilities
--  Copyright (C) 2010, 2011, 2012, 2015, 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Util.Streams.Buffered;
with Util.Texts.Transforms;
with Ada.Characters.Handling;
with Ada.Wide_Wide_Characters.Handling;
with Ada.Calendar;
with GNAT.Calendar.Time_IO;
package Util.Streams.Texts is

   --  -----------------------
   --  Print stream
   --  -----------------------
   --  The Print_Stream is an output stream which provides helper methods
   --  for writing text streams.
   type Print_Stream is new Buffered.Buffered_Stream with private;
   type Print_Stream_Access is access all Print_Stream'Class;

   procedure Initialize (Stream : in out Print_Stream;
                         To     : in Output_Stream_Access);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Integer);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Long_Long_Integer);

   --  Write a string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a date on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Calendar.Time;
                    Format : in GNAT.Calendar.Time_IO.Picture_String
                    := GNAT.Calendar.Time_IO.ISO_Date);

   --  Get the output stream content as a string.
   function To_String (Stream : in Buffered.Buffered_Stream'Class) return String;

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Buffered.Buffered_Stream'Class;
                         Item   : in Character);

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Buffered.Buffered_Stream'Class;
                         Item   : in Wide_Wide_Character);

   package TR is
     new Util.Texts.Transforms (Stream => Buffered.Buffered_Stream'Class,
                                Char   => Character,
                                Input  => String,
                                Put    => Write_Char,
                                To_Upper => Ada.Characters.Handling.To_Upper,
                                To_Lower => Ada.Characters.Handling.To_Lower);

   package WTR is
     new Util.Texts.Transforms (Stream => Buffered.Buffered_Stream'Class,
                                Char   => Wide_Wide_Character,
                                Input  => Wide_Wide_String,
                                Put    => Write_Char,
                                To_Upper => Ada.Wide_Wide_Characters.Handling.To_Upper,
                                To_Lower => Ada.Wide_Wide_Characters.Handling.To_Lower);

   --  -----------------------
   --  Reader stream
   --  -----------------------
   --  The Reader_Stream is an input stream which provides helper methods
   --  for reading text streams.
   type Reader_Stream is new Buffered.Buffered_Stream with private;
   type Reader_Stream_Access is access all Reader_Stream'Class;

   --  Initialize the reader to read the input from the input stream given in From.
   procedure Initialize (Stream : in out Reader_Stream;
                         From   : in Input_Stream_Access);

   --  Read an input line from the input stream.  The line is terminated by ASCII.LF.
   --  When Strip is set, the line terminators (ASCII.CR, ASCII.LF) are removed.
   procedure Read_Line (Stream : in out Reader_Stream;
                        Into   : out Ada.Strings.Unbounded.Unbounded_String;
                        Strip  : in Boolean := False);

private

   type Print_Stream is new Buffered.Buffered_Stream with null record;

   type Reader_Stream is new Buffered.Buffered_Stream with null record;

end Util.Streams.Texts;

Change To_String function to accept class wide buffer stream objects