-----------------------------------------------------------------------
--  gen-commands-templates -- Template based command
--  Copyright (C) 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 Ada.Text_IO;
with Ada.IO_Exceptions;
with Ada.Directories;

with GNAT.Command_Line;

with Gen.Artifacts;

with Util.Log.Loggers;
with Util.Files;
with Util.Beans.Objects;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.IO.XML;
package body Gen.Commands.Templates is

   use Ada.Strings.Unbounded;
   use Util.Log;
   use GNAT.Command_Line;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Commands.Templates");

   --  ------------------------------
   --  Page Creation Command
   --  ------------------------------
   --  This command adds a XHTML page to the web application.

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      function Get_Output_Dir return String;

      function Get_Output_Dir return String is
         Dir        : constant String := Generator.Get_Result_Directory;
      begin
         if Length (Cmd.Base_Dir) = 0 then
            return Dir;
         else
            return Util.Files.Compose (Dir, To_String (Cmd.Base_Dir));
         end if;
      end Get_Output_Dir;

      Out_Dir : constant String := Get_Output_Dir;
      Iter    : Param_Vectors.Cursor := Cmd.Params.First;
   begin
      Generator.Read_Project ("dynamo.xml", False);
      while Param_Vectors.Has_Element (Iter) loop
         declare
            P     : constant Param := Param_Vectors.Element (Iter);
            Value : constant String := Get_Argument;
         begin
            if not P.Is_Optional and Value'Length = 0 then
               Generator.Error ("Missing argument for {0}", To_String (P.Argument));
               return;
            end if;
            Generator.Set_Global (To_String (P.Name), Value);
         end;
         Param_Vectors.Next (Iter);
      end loop;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (To_Unbounded_String (Out_Dir));
      declare
         Iter : Util.Strings.Sets.Cursor := Cmd.Templates.First;
      begin
         while Util.Strings.Sets.Has_Element (Iter) loop
            Gen.Generator.Generate (Generator, Gen.Artifacts.ITERATION_TABLE,
                                    Util.Strings.Sets.Element (Iter));
            Util.Strings.Sets.Next (Iter);
         end loop;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Generator);

      use Ada.Text_IO;
   begin
      Put_Line (To_String (Cmd.Name) & ": " & To_String (Cmd.Title));
      Put_Line ("Usage: " & To_String (Cmd.Usage));
      New_Line;
      Put_Line (To_String (Cmd.Help_Msg));
   end Help;

   type Command_Fields is (FIELD_NAME,
                           FIELD_HELP,
                           FIELD_USAGE,
                           FIELD_TITLE,
                           FIELD_BASEDIR,
                           FIELD_PARAM,
                           FIELD_PARAM_NAME,
                           FIELD_PARAM_OPTIONAL,
                           FIELD_PARAM_ARG,
                           FIELD_TEMPLATE,
                           FIELD_COMMAND);

   type Command_Loader is record
      Command : Command_Access := null;
      P       : Param;
   end record;
   type Command_Loader_Access is access all Command_Loader;

   procedure Set_Member (Closure : in out Command_Loader;
                         Field   : in Command_Fields;
                         Value   : in Util.Beans.Objects.Object);

   function To_String (Value : in Util.Beans.Objects.Object) return Unbounded_String;

   --  ------------------------------
   --  Convert the object value into a string and trim any space/tab/newlines.
   --  ------------------------------
   function To_String (Value : in Util.Beans.Objects.Object) return Unbounded_String is
      Result    : constant String := Util.Beans.Objects.To_String (Value);
      First_Pos : Natural := Result'First;
      Last_Pos  : Natural := Result'Last;
      C : Character;
   begin
      while First_Pos <= Last_Pos loop
         C := Result (First_Pos);
         exit when C /= ' ' and C /= ASCII.LF and C /= ASCII.CR and C /= ASCII.HT;
         First_Pos := First_Pos + 1;
      end loop;
      while Last_Pos >= First_Pos loop
         C := Result (Last_Pos);
         exit when C /= ' ' and C /= ASCII.LF and C /= ASCII.CR and C /= ASCII.HT;
         Last_Pos := Last_Pos - 1;
      end loop;
      return To_Unbounded_String (Result (First_Pos .. Last_Pos));
   end To_String;

   procedure Set_Member (Closure : in out Command_Loader;
                         Field   : in Command_Fields;
                         Value   : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      if Field = FIELD_COMMAND then
         if Closure.Command /= null then
            Log.Info ("Adding command {0}", Closure.Command.Name);

            Add_Command (Name => To_String (Closure.Command.Name),
                         Cmd  => Closure.Command.all'Access);
            Closure.Command := null;
         end if;
      else
         if Closure.Command = null then
            Closure.Command := new Gen.Commands.Templates.Command;
         end if;
         case Field is
            when FIELD_NAME =>
               Closure.Command.Name := To_String (Value);

            when FIELD_TITLE =>
               Closure.Command.Title := To_String (Value);

            when FIELD_USAGE =>
               Closure.Command.Usage := To_String (Value);

            when FIELD_HELP =>
               Closure.Command.Help_Msg := To_String (Value);

            when FIELD_TEMPLATE =>
               Closure.Command.Templates.Include (To_String (Value));

            when FIELD_PARAM_NAME =>
               Closure.P.Name := To_Unbounded_String (Value);

            when FIELD_PARAM_OPTIONAL =>
               Closure.P.Is_Optional := To_Boolean (Value);

            when FIELD_PARAM_ARG =>
               Closure.P.Argument := To_Unbounded_String (Value);

            when FIELD_PARAM =>
               Closure.P.Value := To_Unbounded_String (Value);
               Closure.Command.Params.Append (Closure.P);
               Closure.P.Name        := Ada.Strings.Unbounded.Null_Unbounded_String;
               Closure.P.Argument    := Ada.Strings.Unbounded.Null_Unbounded_String;
               Closure.P.Is_Optional := False;

            when FIELD_BASEDIR =>
               Closure.Command.Base_Dir := To_Unbounded_String (Value);

            when FIELD_COMMAND =>
               null;

            when others =>
               null;

         end case;
      end if;
   end Set_Member;

   package Command_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Command_Loader,
                                               Element_Type_Access => Command_Loader_Access,
                                               Fields              => Command_Fields,
                                               Set_Member          => Set_Member);

   Cmd_Mapper : aliased Command_Mapper.Mapper;

   --  ------------------------------
   --  Read the template commands defined in dynamo configuration directory.
   --  ------------------------------
   procedure Read_Commands (Generator : in out Gen.Generator.Handler) is

      procedure Read_Command (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean);

      --  ------------------------------
      --  Read the XML command file.
      --  ------------------------------
      procedure Read_Command (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean) is
         pragma Unreferenced (Name);

         Loader : aliased Command_Loader;
         Reader : Util.Serialize.IO.XML.Parser;
      begin
         Log.Info ("Reading command file '{0}'", File_Path);
         Done := False;

         --  Create the mapping to load the XML command file.
         Reader.Add_Mapping ("commands", Cmd_Mapper'Access);

         --  Set the context for Set_Member.
         Command_Mapper.Set_Context (Reader, Loader'Unchecked_Access);

         --  Read the XML command file.
         Reader.Parse (File_Path);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Generator.Error ("Command file {0} does not exist", File_Path);
      end Read_Command;

      Config_Dir : constant String := Generator.Get_Config_Directory;
      Cmd_Dir    : constant String := Generator.Get_Parameter ("generator.commands.dir");
      Path       : constant String := Util.Files.Compose (Config_Dir, Cmd_Dir);
   begin
      if Ada.Directories.Exists (Path) then
         Util.Files.Iterate_Files_Path (Path    => Path,
                                        Pattern => "*.xml",
                                        Process => Read_Command'Access);
      end if;
   end Read_Commands;

begin
   --  Setup the mapper to load XML commands.
   Cmd_Mapper.Add_Mapping ("command/name", FIELD_NAME);
   Cmd_Mapper.Add_Mapping ("command/title", FIELD_TITLE);
   Cmd_Mapper.Add_Mapping ("command/usage", FIELD_USAGE);
   Cmd_Mapper.Add_Mapping ("command/help", FIELD_HELP);
   Cmd_Mapper.Add_Mapping ("command/basedir", FIELD_BASEDIR);
   Cmd_Mapper.Add_Mapping ("command/param", FIELD_PARAM);
   Cmd_Mapper.Add_Mapping ("command/param/@name", FIELD_PARAM_NAME);
   Cmd_Mapper.Add_Mapping ("command/param/@optional", FIELD_PARAM_OPTIONAL);
   Cmd_Mapper.Add_Mapping ("command/param/@arg", FIELD_PARAM_ARG);
   Cmd_Mapper.Add_Mapping ("command/template", FIELD_TEMPLATE);
   Cmd_Mapper.Add_Mapping ("command", FIELD_COMMAND);
end Gen.Commands.Templates;

-----------------------------------------------------------------------
--  gen-commands-templates -- Template based command
--  Copyright (C) 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 Ada.Text_IO;
with Ada.IO_Exceptions;
with Ada.Directories;

with GNAT.Command_Line;

with Gen.Artifacts;

with Util.Log.Loggers;
with Util.Files;
with Util.Beans.Objects;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.IO.XML;
package body Gen.Commands.Templates is

   use Ada.Strings.Unbounded;
   use Util.Log;
   use GNAT.Command_Line;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Commands.Templates");

   --  ------------------------------
   --  Page Creation Command
   --  ------------------------------
   --  This command adds a XHTML page to the web application.

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      function Get_Output_Dir return String;

      function Get_Output_Dir return String is
         Dir        : constant String := Generator.Get_Result_Directory;
      begin
         if Length (Cmd.Base_Dir) = 0 then
            return Dir;
         else
            return Util.Files.Compose (Dir, To_String (Cmd.Base_Dir));
         end if;
      end Get_Output_Dir;

      Out_Dir : constant String := Get_Output_Dir;
      Iter    : Param_Vectors.Cursor := Cmd.Params.First;
   begin
      Generator.Read_Project ("dynamo.xml", False);
      while Param_Vectors.Has_Element (Iter) loop
         declare
            P     : constant Param := Param_Vectors.Element (Iter);
            Value : constant String := Get_Argument;
         begin
            if not P.Is_Optional and Value'Length = 0 then
               Generator.Error ("Missing argument for {0}", To_String (P.Argument));
               return;
            end if;
            Generator.Set_Global (To_String (P.Name), Value);
         end;
         Param_Vectors.Next (Iter);
      end loop;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (To_Unbounded_String (Out_Dir));
      declare
         Iter : Util.Strings.Sets.Cursor := Cmd.Templates.First;
      begin
         while Util.Strings.Sets.Has_Element (Iter) loop
            Gen.Generator.Generate (Generator, Gen.Artifacts.ITERATION_TABLE,
                                    Util.Strings.Sets.Element (Iter));
            Util.Strings.Sets.Next (Iter);
         end loop;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Generator);

      use Ada.Text_IO;
   begin
      Put_Line (To_String (Cmd.Name) & ": " & To_String (Cmd.Title));
      Put_Line ("Usage: " & To_String (Cmd.Usage));
      New_Line;
      Put_Line (To_String (Cmd.Help_Msg));
   end Help;

   type Command_Fields is (FIELD_NAME,
                           FIELD_HELP,
                           FIELD_USAGE,
                           FIELD_TITLE,
                           FIELD_BASEDIR,
                           FIELD_PARAM,
                           FIELD_PARAM_NAME,
                           FIELD_PARAM_OPTIONAL,
                           FIELD_PARAM_ARG,
                           FIELD_TEMPLATE,
                           FIELD_COMMAND);

   type Command_Loader is record
      Command : Command_Access := null;
      P       : Param;
   end record;
   type Command_Loader_Access is access all Command_Loader;

   procedure Set_Member (Closure : in out Command_Loader;
                         Field   : in Command_Fields;
                         Value   : in Util.Beans.Objects.Object);

   function To_String (Value : in Util.Beans.Objects.Object) return Unbounded_String;

   --  ------------------------------
   --  Convert the object value into a string and trim any space/tab/newlines.
   --  ------------------------------
   function To_String (Value : in Util.Beans.Objects.Object) return Unbounded_String is
      Result    : constant String := Util.Beans.Objects.To_String (Value);
      First_Pos : Natural := Result'First;
      Last_Pos  : Natural := Result'Last;
      C : Character;
   begin
      while First_Pos <= Last_Pos loop
         C := Result (First_Pos);
         exit when C /= ' ' and C /= ASCII.LF and C /= ASCII.CR and C /= ASCII.HT;
         First_Pos := First_Pos + 1;
      end loop;
      while Last_Pos >= First_Pos loop
         C := Result (Last_Pos);
         exit when C /= ' ' and C /= ASCII.LF and C /= ASCII.CR and C /= ASCII.HT;
         Last_Pos := Last_Pos - 1;
      end loop;
      return To_Unbounded_String (Result (First_Pos .. Last_Pos));
   end To_String;

   procedure Set_Member (Closure : in out Command_Loader;
                         Field   : in Command_Fields;
                         Value   : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      if Field = FIELD_COMMAND then
         if Closure.Command /= null then
            Log.Info ("Adding command {0}", Closure.Command.Name);

            Add_Command (Name => To_String (Closure.Command.Name),
                         Cmd  => Closure.Command.all'Access);
            Closure.Command := null;
         end if;
      else
         if Closure.Command = null then
            Closure.Command := new Gen.Commands.Templates.Command;
         end if;
         case Field is
            when FIELD_NAME =>
               Closure.Command.Name := To_String (Value);

            when FIELD_TITLE =>
               Closure.Command.Title := To_String (Value);

            when FIELD_USAGE =>
               Closure.Command.Usage := To_String (Value);

            when FIELD_HELP =>
               Closure.Command.Help_Msg := To_String (Value);

            when FIELD_TEMPLATE =>
               Closure.Command.Templates.Include (To_String (Value));

            when FIELD_PARAM_NAME =>
               Closure.P.Name := To_Unbounded_String (Value);

            when FIELD_PARAM_OPTIONAL =>
               Closure.P.Is_Optional := To_Boolean (Value);

            when FIELD_PARAM_ARG =>
               Closure.P.Argument := To_Unbounded_String (Value);

            when FIELD_PARAM =>
               Closure.P.Value := To_Unbounded_String (Value);
               Closure.Command.Params.Append (Closure.P);
               Closure.P.Name        := Ada.Strings.Unbounded.Null_Unbounded_String;
               Closure.P.Argument    := Ada.Strings.Unbounded.Null_Unbounded_String;
               Closure.P.Is_Optional := False;

            when FIELD_BASEDIR =>
               Closure.Command.Base_Dir := To_Unbounded_String (Value);

            when FIELD_COMMAND =>
               null;

         end case;
      end if;
   end Set_Member;

   package Command_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Command_Loader,
                                               Element_Type_Access => Command_Loader_Access,
                                               Fields              => Command_Fields,
                                               Set_Member          => Set_Member);

   Cmd_Mapper : aliased Command_Mapper.Mapper;

   --  ------------------------------
   --  Read the template commands defined in dynamo configuration directory.
   --  ------------------------------
   procedure Read_Commands (Generator : in out Gen.Generator.Handler) is

      procedure Read_Command (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean);

      --  ------------------------------
      --  Read the XML command file.
      --  ------------------------------
      procedure Read_Command (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean) is
         pragma Unreferenced (Name);

         Loader : aliased Command_Loader;
         Reader : Util.Serialize.IO.XML.Parser;
      begin
         Log.Info ("Reading command file '{0}'", File_Path);
         Done := False;

         --  Create the mapping to load the XML command file.
         Reader.Add_Mapping ("commands", Cmd_Mapper'Access);

         --  Set the context for Set_Member.
         Command_Mapper.Set_Context (Reader, Loader'Unchecked_Access);

         --  Read the XML command file.
         Reader.Parse (File_Path);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Generator.Error ("Command file {0} does not exist", File_Path);
      end Read_Command;

      Config_Dir : constant String := Generator.Get_Config_Directory;
      Cmd_Dir    : constant String := Generator.Get_Parameter ("generator.commands.dir");
      Path       : constant String := Util.Files.Compose (Config_Dir, Cmd_Dir);
   begin
      Log.Debug ("Checking commands in {0}", Path);

      if Ada.Directories.Exists (Path) then
         Util.Files.Iterate_Files_Path (Path    => Path,
                                        Pattern => "*.xml",
                                        Process => Read_Command'Access);
      end if;
   end Read_Commands;

begin
   --  Setup the mapper to load XML commands.
   Cmd_Mapper.Add_Mapping ("command/name", FIELD_NAME);
   Cmd_Mapper.Add_Mapping ("command/title", FIELD_TITLE);
   Cmd_Mapper.Add_Mapping ("command/usage", FIELD_USAGE);
   Cmd_Mapper.Add_Mapping ("command/help", FIELD_HELP);
   Cmd_Mapper.Add_Mapping ("command/basedir", FIELD_BASEDIR);
   Cmd_Mapper.Add_Mapping ("command/param", FIELD_PARAM);
   Cmd_Mapper.Add_Mapping ("command/param/@name", FIELD_PARAM_NAME);
   Cmd_Mapper.Add_Mapping ("command/param/@optional", FIELD_PARAM_OPTIONAL);
   Cmd_Mapper.Add_Mapping ("command/param/@arg", FIELD_PARAM_ARG);
   Cmd_Mapper.Add_Mapping ("command/template", FIELD_TEMPLATE);
   Cmd_Mapper.Add_Mapping ("command", FIELD_COMMAND);
end Gen.Commands.Templates;

Add a log and fix compilation warning

Add a log and fix compilation warning


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

package body ADO.Utils is

   --  ------------------------------
   --  Build a bean object from the identifier.
   --  ------------------------------
   function To_Object (Id : in ADO.Identifier) return Util.Beans.Objects.Object is
   begin
      if Id = ADO.NO_IDENTIFIER then
         return Util.Beans.Objects.Null_Object;
      else
         return Util.Beans.Objects.To_Object (Long_Long_Integer (Id));
      end if;
   end To_Object;

   --  ------------------------------
   --  Build the identifier from the bean object.
   --  ------------------------------
   function To_Identifier (Value : in Util.Beans.Objects.Object) return ADO.Identifier is
   begin
      if Util.Beans.Objects.Is_Null (Value) then
         return ADO.NO_IDENTIFIER;
      else
         return ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Value));
      end if;
   end To_Identifier;

end ADO.Utils;

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

package body ADO.Utils is

   --  ------------------------------
   --  Build a bean object from the identifier.
   --  ------------------------------
   function To_Object (Id : in ADO.Identifier) return Util.Beans.Objects.Object is
   begin
      if Id = ADO.NO_IDENTIFIER then
         return Util.Beans.Objects.Null_Object;
      else
         return Util.Beans.Objects.To_Object (Long_Long_Integer (Id));
      end if;
   end To_Object;

   --  ------------------------------
   --  Build the identifier from the bean object.
   --  ------------------------------
   function To_Identifier (Value : in Util.Beans.Objects.Object) return ADO.Identifier is
   begin
      if Util.Beans.Objects.Is_Null (Value) then
         return ADO.NO_IDENTIFIER;
      else
         return ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Value));
      end if;
   end To_Identifier;

   --  ------------------------------
   --  Compute the hash of the identifier.
   --  ------------------------------
   function Hash (Key : in ADO.Identifier) return Ada.Containers.Hash_Type is
      use Ada.Containers;
   begin

      if Key < 0 then
         return Hash_Type (-Key);
      else
         return Hash_Type (Key);
      end if;
   end Hash;

end ADO.Utils;

Implement the Hash operation

Implement the Hash operation


-----------------------------------------------------------------------
--  awa-applications-configs -- Read application configuration files
--  Copyright (C) 2011, 2012, 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 EL.Contexts.Default;
with Util.Serialize.Mappers;

--  The <b>AWA.Applications.Configs</b> package reads the application configuration files.
package AWA.Applications.Configs is

   --  XML reader configuration.  By instantiating this generic package, the XML parser
   --  gets initialized to read the configuration for servlets, filters, managed beans,
   --  permissions, events and other configuration elements.
   generic
      Mapper  : in out Util.Serialize.Mappers.Processing;
      App     : in Application_Access;
      Context : in EL.Contexts.Default.Default_Context_Access;
      Override_Context : in Boolean;
   package Reader_Config is
   end Reader_Config;

   --  Read the application configuration file and configure the application
   procedure Read_Configuration (App     : in out Application'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.Default.Default_Context_Access;
                                 Override_Context : in Boolean);

   --  Get the configuration path for the application name.
   --  The configuration path is search from:
   --  o the current directory,
   --  o the 'config' directory,
   --  o the Dynamo installation directory in share/dynamo
   function Get_Config_Path (Name : in String) return String;

end AWA.Applications.Configs;

-----------------------------------------------------------------------
--  awa-applications-configs -- Read application configuration files
--  Copyright (C) 2011, 2012, 2015, 2017, 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 EL.Contexts.Default;
with Util.Serialize.Mappers;
with Keystore.Properties;

--  The <b>AWA.Applications.Configs</b> package reads the application configuration files.
package AWA.Applications.Configs is

   MAX_PREFIX_LENGTH : constant := 64;

   --  Merge the configuration content and the keystore to a final configuration object.
   --  The keystore can be used to store sensitive information such as database connection,
   --  secret keys while the rest of the configuration remains in clear property files.
   --  The keystore must be unlocked to have access to its content.
   --  The prefix parameter is used to prefix names from the keystore so that the same
   --  keystore could be used by several applications.
   procedure Merge (Into   : in out ASF.Applications.Config;
                    Config : in out ASF.Applications.Config;
                    Wallet : in out Keystore.Properties.Manager;
                    Prefix : in String) with Pre => Prefix'Length <= MAX_PREFIX_LENGTH;

   --  XML reader configuration.  By instantiating this generic package, the XML parser
   --  gets initialized to read the configuration for servlets, filters, managed beans,
   --  permissions, events and other configuration elements.
   generic
      Mapper  : in out Util.Serialize.Mappers.Processing;
      App     : in Application_Access;
      Context : in EL.Contexts.Default.Default_Context_Access;
      Override_Context : in Boolean;
   package Reader_Config is
   end Reader_Config;

   --  Read the application configuration file and configure the application
   procedure Read_Configuration (App     : in out Application'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.Default.Default_Context_Access;
                                 Override_Context : in Boolean);

   --  Get the configuration path for the application name.
   --  The configuration path is search from:
   --  o the current directory,
   --  o the 'config' directory,
   --  o the Dynamo installation directory in share/dynamo
   function Get_Config_Path (Name : in String) return String;

end AWA.Applications.Configs;

Declare the Merge procedure to merge a standard configuration file with a secure configuration


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

with Ada.Strings.Unbounded;
with Ada.Finalization;

with ADO.Parameters;

--  == Database Caches ==
--  The ADO cache manager allows to create and maintain cache of values and use the cache
--  from the SQL expander to replace cached values before evaluating the SQL.  The SQL expander
--  identifies constructs as follows:
--
--    $cache_name[entry-name]
--
--  and look for the cache identified by <tt>cache_name</tt> and then replace the cache entry
--  registered with the name <tt>entry-name</tt>.
--
--  The cache manager is represented by the <tt>Cache_Manager</tt> type and the database
--  session contains one cache manager.  Applications may use their own cache in that case
--  they will declare their cache as follows:
--
--     M : ADO.Caches.Cache_Manager;
--
--  A cache group is identified by a unique name and is represented by the <tt>Cache_Type</tt>
--  base class.  The cache group instance is registered in the cache manager by using the
--  <tt>Add_Cache</tt> operation.
package ADO.Caches is

   No_Value : exception;

   type Cache_Type is abstract limited new Ada.Finalization.Limited_Controlled with private;
   type Cache_Type_Access is access all Cache_Type'Class;

   --  Expand the name into a target parameter value to be used in the SQL query.
   --  The Expander can return a T_NULL when a value is not found or
   --  it may also raise some exception.
   function Expand (Instance : in out Cache_Type;
                    Name     : in String) return ADO.Parameters.Parameter is abstract;

   type Cache_Manager is limited new Ada.Finalization.Limited_Controlled
     and ADO.Parameters.Expander with private;
   type Cache_Manager_Access is access all Cache_Manager'Class;

   --  Expand the name from the given group into a target parameter value to be used in
   --  the SQL query.  The expander can look in a cache or in some configuration to find
   --  the value associated with the name and return it.  The Expander can return a
   --  T_NULL when a value is not found or it may also raise some exception.
   overriding
   function Expand (Instance : in Cache_Manager;
                    Group    : in String;
                    Name     : in String) return ADO.Parameters.Parameter;

   --  Insert a new cache in the manager.  The cache is identified by the given name.
   procedure Add_Cache (Manager : in out Cache_Manager;
                        Name    : in String;
                        Cache   : in Cache_Type_Access);

   --  Finalize the cache manager releasing every cache group.
   overriding
   procedure Finalize (Manager : in out Cache_Manager);

private

   type Cache_Type is abstract limited new Ada.Finalization.Limited_Controlled with record
      Next : Cache_Type_Access;
      Name : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Cache_Manager is limited new Ada.Finalization.Limited_Controlled
     and ADO.Parameters.Expander with record
      First : Cache_Type_Access;
   end record;

end ADO.Caches;

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

with Ada.Strings.Unbounded;
with Ada.Finalization;

with ADO.Parameters;
with Util.Log.Loggers;

--  == Database Caches ==
--  The ADO cache manager allows to create and maintain cache of values and use the cache
--  from the SQL expander to replace cached values before evaluating the SQL.  The SQL expander
--  identifies constructs as follows:
--
--    $cache_name[entry-name]
--
--  and look for the cache identified by <tt>cache_name</tt> and then replace the cache entry
--  registered with the name <tt>entry-name</tt>.
--
--  The cache manager is represented by the <tt>Cache_Manager</tt> type and the database
--  session contains one cache manager.  Applications may use their own cache in that case
--  they will declare their cache as follows:
--
--     M : ADO.Caches.Cache_Manager;
--
--  A cache group is identified by a unique name and is represented by the <tt>Cache_Type</tt>
--  base class.  The cache group instance is registered in the cache manager by using the
--  <tt>Add_Cache</tt> operation.
package ADO.Caches is

   No_Value : exception;

   type Cache_Type is abstract limited new Ada.Finalization.Limited_Controlled with private;
   type Cache_Type_Access is access all Cache_Type'Class;

   --  Expand the name into a target parameter value to be used in the SQL query.
   --  The Expander can return a T_NULL when a value is not found or
   --  it may also raise some exception.
   function Expand (Instance : in out Cache_Type;
                    Name     : in String) return ADO.Parameters.Parameter is abstract;

   type Cache_Manager is limited new Ada.Finalization.Limited_Controlled
     and ADO.Parameters.Expander with private;
   type Cache_Manager_Access is access all Cache_Manager'Class;

   --  Expand the name from the given group into a target parameter value to be used in
   --  the SQL query.  The expander can look in a cache or in some configuration to find
   --  the value associated with the name and return it.  The Expander can return a
   --  T_NULL when a value is not found or it may also raise some exception.
   overriding
   function Expand (Instance : in Cache_Manager;
                    Group    : in String;
                    Name     : in String) return ADO.Parameters.Parameter;

   --  Insert a new cache in the manager.  The cache is identified by the given name.
   procedure Add_Cache (Manager : in out Cache_Manager;
                        Name    : in String;
                        Cache   : in Cache_Type_Access);

   --  Finalize the cache manager releasing every cache group.
   overriding
   procedure Finalize (Manager : in out Cache_Manager);

private

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Caches");

   type Cache_Type is abstract limited new Ada.Finalization.Limited_Controlled with record
      Next : Cache_Type_Access;
      Name : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Cache_Manager is limited new Ada.Finalization.Limited_Controlled
     and ADO.Parameters.Expander with record
      First : Cache_Type_Access;
   end record;

end ADO.Caches;

Declare a logger instance

Declare a logger instance


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

with Security.Openid.Servlets;

with AWA.Modules;
with AWA.Users.Services;
with AWA.Users.Filters;
with AWA.Users.Servlets;

--  == Introduction ==
--  The Users.Module manages the creation, update, removal and authentication of users
--  in an application.  The module provides the foundations for user management in
--  a web application.
--
--  A user can register himself by using a subscription form.  In that case, a verification mail
--  is sent and the user has to follow the verification link defined in the mail to finish
--  the registration process.  The user will authenticate using a password.
--
--  A user can also use an OpenID account and be automatically registered.
--
--  A user can have one or several permissions that allow to protect the application data.
--  User permissions are managed by the Permissions.Module.
--
--  == Configuration ==
--  The *users* module uses a set of configuration properties to configure the OpenID
--  integration.
--
--  @include awa-users-services.ads
--  @include User.hbm.xml
package AWA.Users.Modules is

   NAME : constant String := "users";

   type User_Module is new AWA.Modules.Module with private;
   type User_Module_Access is access all User_Module'Class;

   --  Initialize the user module.
   overriding
   procedure Initialize (Plugin : in out User_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the user manager.
   function Get_User_Manager (Plugin : in User_Module) return Services.User_Service_Access;

   --  Create a user manager.  This operation can be overriden to provide another
   --  user service implementation.
   function Create_User_Manager (Plugin : in User_Module) return Services.User_Service_Access;

   --  Get the user module instance associated with the current application.
   function Get_User_Module return User_Module_Access;

   --  Get the user manager instance associated with the current application.
   function Get_User_Manager return Services.User_Service_Access;

private

   type User_Module is new AWA.Modules.Module with record
      Manager     : Services.User_Service_Access := null;
      Key_Filter  : aliased AWA.Users.Filters.Verify_Filter;
      Auth_Filter : aliased AWA.Users.Filters.Auth_Filter;
      Auth        : aliased Security.Openid.Servlets.Request_Auth_Servlet;
      Verify_Auth : aliased AWA.Users.Servlets.Verify_Auth_Servlet;
   end record;

end AWA.Users.Modules;

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

with Security.Openid.Servlets;

with AWA.Modules;
with AWA.Users.Services;
with AWA.Users.Filters;
with AWA.Users.Servlets;

--  == Introduction ==
--  The Users.Module manages the creation, update, removal and authentication of users
--  in an application.  The module provides the foundations for user management in
--  a web application.
--
--  A user can register himself by using a subscription form.  In that case, a verification mail
--  is sent and the user has to follow the verification link defined in the mail to finish
--  the registration process.  The user will authenticate using a password.
--
--  A user can also use an OpenID account and be automatically registered.
--
--  A user can have one or several permissions that allow to protect the application data.
--  User permissions are managed by the Permissions.Module.
--
--  == Configuration ==
--  The *users* module uses a set of configuration properties to configure the OpenID
--  integration.
--
--  @include awa-users-services.ads
--
--  @include users.xml
--
--  == Data Model ==
--  @include User.hbm.xml
package AWA.Users.Modules is

   NAME : constant String := "users";

   type User_Module is new AWA.Modules.Module with private;
   type User_Module_Access is access all User_Module'Class;

   --  Initialize the user module.
   overriding
   procedure Initialize (Plugin : in out User_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the user manager.
   function Get_User_Manager (Plugin : in User_Module) return Services.User_Service_Access;

   --  Create a user manager.  This operation can be overriden to provide another
   --  user service implementation.
   function Create_User_Manager (Plugin : in User_Module) return Services.User_Service_Access;

   --  Get the user module instance associated with the current application.
   function Get_User_Module return User_Module_Access;

   --  Get the user manager instance associated with the current application.
   function Get_User_Manager return Services.User_Service_Access;

private

   type User_Module is new AWA.Modules.Module with record
      Manager     : Services.User_Service_Access := null;
      Key_Filter  : aliased AWA.Users.Filters.Verify_Filter;
      Auth_Filter : aliased AWA.Users.Filters.Auth_Filter;
      Auth        : aliased Security.Openid.Servlets.Request_Auth_Servlet;
      Verify_Auth : aliased AWA.Users.Servlets.Verify_Auth_Servlet;
   end record;

end AWA.Users.Modules;

Add the user module Ada beans in the documentation


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

--  === Text_IO Input and Output streams ===
--  The `Wiki.Streams.Text_IO` package defines the `File_Input_Stream` and
--  the `File_Output_Stream` types which use the `Ada.Wide_Wide_Text_IO` package
--  to read or write the output streams.
--
--  By default the `File_Input_Stream` is configured to read the standard input.
--  The `Open` procedure can be used to read from a file knowing its name.
--
--  The `File_Output_Stream` is configured to write on the standard output.
--  The `Open` and `Create` procedure can be used to write on a file.
--
package Wiki.Streams.Text_IO is

   type File_Input_Stream is limited new Ada.Finalization.Limited_Controlled
     and Wiki.Streams.Input_Stream with private;
   type File_Input_Stream_Access is access all File_Input_Stream'Class;

   --  Open the file and prepare to read the input stream.
   procedure Open (Stream : in out File_Input_Stream;
                   Path   : in String;
                   Form   : in String := "");

   --  Read the input stream and fill the `Into` buffer until either it is full or
   --  we reach the end of line.  Returns in `Last` the last valid position in the
   --  `Into` buffer.  When there is no character to read, return True in
   --  the `Eof` indicator.
   procedure Read (Input : in out File_Input_Stream;
                   Into  : in out Wiki.Strings.WString;
                   Last  : out Natural;
                   Eof   : out Boolean);

   --  Close the file.
   procedure Close (Stream : in out File_Input_Stream);

   --  Close the stream.
   overriding
   procedure Finalize (Stream : in out File_Input_Stream);

   type File_Output_Stream is limited new Ada.Finalization.Limited_Controlled
     and Wiki.Streams.Output_Stream with private;
   type File_Output_Stream_Access is access all File_Output_Stream'Class;

   --  Open the file and prepare to write the output stream.
   procedure Open (Stream : in out File_Output_Stream;
                   Path   : in String;
                   Form   : in String := "");

   --  Create the file and prepare to write the output stream.
   procedure Create (Stream : in out File_Output_Stream;
                     Path   : in String;
                     Form   : in String := "");

   --  Close the file.
   procedure Close (Stream : in out File_Output_Stream);

   --  Write the string to the output stream.
   overriding
   procedure Write (Stream  : in out File_Output_Stream;
                    Content : in Wiki.Strings.WString);

   --  Write a single character to the output stream.
   overriding
   procedure Write (Stream : in out File_Output_Stream;
                    Char   : in Wiki.Strings.WChar);

   --  Close the stream.
   overriding
   procedure Finalize (Stream : in out File_Output_Stream);

private

   type File_Input_Stream is limited new Ada.Finalization.Limited_Controlled
     and Wiki.Streams.Input_Stream with record
      File : Ada.Wide_Wide_Text_IO.File_Type;
   end record;

   type File_Output_Stream is limited new Ada.Finalization.Limited_Controlled
     and Wiki.Streams.Output_Stream with record
      File   : Ada.Wide_Wide_Text_IO.File_Type;
      Stdout : Boolean := True;
   end record;

end Wiki.Streams.Text_IO;

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

--  === Text_IO Input and Output streams ===
--  The `Wiki.Streams.Text_IO` package defines the `File_Input_Stream` and
--  the `File_Output_Stream` types which use the `Ada.Wide_Wide_Text_IO` package
--  to read or write the output streams.
--
--  By default the `File_Input_Stream` is configured to read the standard input.
--  The `Open` procedure can be used to read from a file knowing its name.
--
--  The `File_Output_Stream` is configured to write on the standard output.
--  The `Open` and `Create` procedure can be used to write on a file.
--
package Wiki.Streams.Text_IO is

   type File_Input_Stream is limited new Ada.Finalization.Limited_Controlled
     and Wiki.Streams.Input_Stream with private;
   type File_Input_Stream_Access is access all File_Input_Stream'Class;

   --  Open the file and prepare to read the input stream.
   procedure Open (Stream : in out File_Input_Stream;
                   Path   : in String;
                   Form   : in String := "");

   --  Read the input stream and fill the `Into` buffer until either it is full or
   --  we reach the end of line.  Returns in `Last` the last valid position in the
   --  `Into` buffer.  When there is no character to read, return True in
   --  the `Eof` indicator.
   procedure Read (Input : in out File_Input_Stream;
                   Into  : in out Wiki.Strings.WString;
                   Last  : out Natural;
                   Eof   : out Boolean);

   --  Close the file.
   procedure Close (Stream : in out File_Input_Stream);

   --  Close the stream.
   overriding
   procedure Finalize (Stream : in out File_Input_Stream);

   type File_Output_Stream is limited new Ada.Finalization.Limited_Controlled
     and Wiki.Streams.Output_Stream with private;
   type File_Output_Stream_Access is access all File_Output_Stream'Class;

   --  Open the file and prepare to write the output stream.
   procedure Open (Stream : in out File_Output_Stream;
                   Path   : in String;
                   Form   : in String := "");

   --  Create the file and prepare to write the output stream.
   procedure Create (Stream : in out File_Output_Stream;
                     Path   : in String;
                     Form   : in String := "");

   --  Close the file.
   procedure Close (Stream : in out File_Output_Stream);

   --  Write the string to the output stream.
   overriding
   procedure Write (Stream  : in out File_Output_Stream;
                    Content : in Wiki.Strings.WString);

   --  Write a single character to the output stream.
   overriding
   procedure Write (Stream : in out File_Output_Stream;
                    Char   : in Wiki.Strings.WChar);

   --  Close the stream.
   overriding
   procedure Finalize (Stream : in out File_Output_Stream);

private

   type File_Input_Stream is limited new Ada.Finalization.Limited_Controlled
     and Wiki.Streams.Input_Stream with record
      File  : Ada.Wide_Wide_Text_IO.File_Type;
      Stdin : Boolean := True;
   end record;

   type File_Output_Stream is limited new Ada.Finalization.Limited_Controlled
     and Wiki.Streams.Output_Stream with record
      File   : Ada.Wide_Wide_Text_IO.File_Type;
      Stdout : Boolean := True;
   end record;

end Wiki.Streams.Text_IO;

Add Stdin boolean in File_Input_Stream to use the Ada Text_IO stdin file by default if Open is not called


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

with System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Integer;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Integer := 4;
   FD_CLOEXEC : constant Integer := 1;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := 8#000#;
   O_WRONLY   : constant Interfaces.C.int := 8#001#;
   O_RDWR     : constant Interfaces.C.int := 8#002#;
   O_CREAT    : constant Interfaces.C.int := 8#100#;
   O_EXCL     : constant Interfaces.C.int := 8#200#;
   O_TRUNC    : constant Interfaces.C.int := 8#1000#;
   O_APPEND   : constant Interfaces.C.int := 8#2000#;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Interfaces.C.int) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Integer;
                       Flags : in Integer) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

end Util.Systems.Os;

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

with System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;
with Util.Systems.Constants;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Integer;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Interfaces.C.int) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

end Util.Systems.Os;

Use the Util.Systems.Constants generated package for some definitions


-----------------------------------------------------------------------
--  mat-commands -- Command support and execution
--  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 GNAT.Sockets;

with MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      Interactive : Boolean := True;
      Graphical   : Boolean := False;
      Address     : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type'Class);

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type'Class;
                                 Options : in out Options_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

   --  Print the application usage.
   procedure Usage;

end MAT.Commands;

-----------------------------------------------------------------------
--  mat-commands -- Command support and execution
--  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 GNAT.Sockets;

with MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

   --  Exception raised if some option is invalid.
   Usage_Error : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      Interactive : Boolean := True;
      Graphical   : Boolean := False;
      Address     : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type'Class);

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type'Class;
                                 Options : in out Options_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

   --  Print the application usage.
   procedure Usage;

end MAT.Commands;

Declare the Usage_Error exception

Declare the Usage_Error exception


-----------------------------------------------------------------------
--  Util.Beans.Objects.Time -- Helper conversion for Ada Calendar Time
--  Copyright (C) 2010, 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 Interfaces.C;
with Ada.Calendar.Formatting;
with Ada.Calendar.Conversions;

package body Util.Beans.Objects.Time is

   use Ada.Calendar;

   Epoch : constant Ada.Calendar.Time :=
     Ada.Calendar.Time_Of (Year    => Year_Number'First,
                           Month   => 1,
                           Day     => 1,
                           Seconds => 12 * 3600.0);

   --  ------------------------------
   --  Time Type
   --  ------------------------------
   type Time_Type_Def is new Duration_Type_Def with null record;

   --  Get the type name
   function Get_Name (Type_Def : Time_Type_Def) return String;

   --  Convert the value into a string.
   function To_String (Type_Def : in Time_Type_Def;
                       Value    : in Object_Value) return String;

   Time_Type  : aliased constant Time_Type_Def := Time_Type_Def '(others => <>);

   --  ------------------------------
   --  Get the type name
   --  ------------------------------
   function Get_Name (Type_Def : in Time_Type_Def) return String is
      pragma Unreferenced (Type_Def);
   begin
      return "Time";
   end Get_Name;

   --  ------------------------------
   --  Convert the value into a string.
   --  ------------------------------
   function To_String (Type_Def : in Time_Type_Def;
                       Value    : in Object_Value) return String is
      pragma Unreferenced (Type_Def);
   begin
      return Ada.Calendar.Formatting.Image (Epoch + Value.Time_Value);
   end To_String;

   --  ------------------------------
   --  Create an object from the given value.
   --  ------------------------------
   function To_Object (Value : in Ada.Calendar.Time) return Object is
   begin
      return Object '(Controlled with
                      V         => Object_Value '(Of_Type    => TYPE_TIME,
                                                  Time_Value => Value - Epoch),
                      Type_Def  => Time_Type'Access);
   end To_Object;

   --  ------------------------------
   --  Convert the object into a time.
   --  Raises Constraint_Error if the object cannot be converter to the target type.
   --  ------------------------------
   function To_Time (Value : in Object) return Ada.Calendar.Time is
   begin
      case Value.V.Of_Type is
         when TYPE_TIME =>
            return Value.V.Time_Value + Epoch;

         when TYPE_STRING | TYPE_WIDE_STRING =>
            declare
               T : constant String := Value.Type_Def.To_String (Value.V);
            begin
               return Ada.Calendar.Formatting.Value (T);

            exception
                  --  Last chance, try to convert a Unix time displayed as an integer.
               when Constraint_Error =>
                  return Ada.Calendar.Conversions.To_Ada_Time (Interfaces.C.long'Value (T));

            end;

         when others =>
            raise Constraint_Error with "Conversion to a date is not possible";
      end case;
   end To_Time;

   --  ------------------------------
   --  Force the object to be a time.
   --  ------------------------------
   function Cast_Time (Value : Object) return Object is
   begin
      case Value.V.Of_Type is
         when TYPE_TIME =>
            return Value;

         when TYPE_STRING | TYPE_WIDE_STRING =>
            return Time.To_Object (Formatting.Value (Value.Type_Def.To_String (Value.V)));

         when others =>
            raise Constraint_Error with "Conversion to a date is not possible";
      end case;
   end Cast_Time;

end Util.Beans.Objects.Time;

-----------------------------------------------------------------------
--  Util.Beans.Objects.Time -- Helper conversion for Ada Calendar Time
--  Copyright (C) 2010, 2013, 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 Interfaces.C;
with Ada.Calendar.Formatting;
with Ada.Calendar.Conversions;

package body Util.Beans.Objects.Time is

   use Ada.Calendar;

   Epoch : constant Ada.Calendar.Time :=
     Ada.Calendar.Time_Of (Year    => Year_Number'First,
                           Month   => 1,
                           Day     => 1,
                           Seconds => 12 * 3600.0);

   --  ------------------------------
   --  Time Type
   --  ------------------------------
   type Time_Type_Def is new Duration_Type_Def with null record;

   --  Get the type name
   function Get_Name (Type_Def : Time_Type_Def) return String;

   --  Convert the value into a string.
   function To_String (Type_Def : in Time_Type_Def;
                       Value    : in Object_Value) return String;

   Time_Type  : aliased constant Time_Type_Def := Time_Type_Def '(null record);

   --  ------------------------------
   --  Get the type name
   --  ------------------------------
   function Get_Name (Type_Def : in Time_Type_Def) return String is
      pragma Unreferenced (Type_Def);
   begin
      return "Time";
   end Get_Name;

   --  ------------------------------
   --  Convert the value into a string.
   --  ------------------------------
   function To_String (Type_Def : in Time_Type_Def;
                       Value    : in Object_Value) return String is
      pragma Unreferenced (Type_Def);
   begin
      return Ada.Calendar.Formatting.Image (Epoch + Value.Time_Value);
   end To_String;

   --  ------------------------------
   --  Create an object from the given value.
   --  ------------------------------
   function To_Object (Value : in Ada.Calendar.Time) return Object is
   begin
      return Object '(Controlled with
                      V         => Object_Value '(Of_Type    => TYPE_TIME,
                                                  Time_Value => Value - Epoch),
                      Type_Def  => Time_Type'Access);
   end To_Object;

   --  ------------------------------
   --  Convert the object into a time.
   --  Raises Constraint_Error if the object cannot be converter to the target type.
   --  ------------------------------
   function To_Time (Value : in Object) return Ada.Calendar.Time is
   begin
      case Value.V.Of_Type is
         when TYPE_TIME =>
            return Value.V.Time_Value + Epoch;

         when TYPE_STRING | TYPE_WIDE_STRING =>
            declare
               T : constant String := Value.Type_Def.To_String (Value.V);
            begin
               return Ada.Calendar.Formatting.Value (T);

            exception
                  --  Last chance, try to convert a Unix time displayed as an integer.
               when Constraint_Error =>
                  return Ada.Calendar.Conversions.To_Ada_Time (Interfaces.C.long'Value (T));

            end;

         when others =>
            raise Constraint_Error with "Conversion to a date is not possible";
      end case;
   end To_Time;

   --  ------------------------------
   --  Force the object to be a time.
   --  ------------------------------
   function Cast_Time (Value : Object) return Object is
   begin
      case Value.V.Of_Type is
         when TYPE_TIME =>
            return Value;

         when TYPE_STRING | TYPE_WIDE_STRING =>
            return Time.To_Object (Formatting.Value (Value.Type_Def.To_String (Value.V)));

         when others =>
            raise Constraint_Error with "Conversion to a date is not possible";
      end case;
   end Cast_Time;

end Util.Beans.Objects.Time;

Fix new GNAT compilation warning in initialization records: use null record


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

with ASF.Sessions;
with ASF.Applications.Messages.Utils;
package body ASF.Contexts.Flash is

   --  ------------------------------
   --  Set the attribute having given name with the value.
   --  ------------------------------
   procedure Set_Attribute (Flash   : in out Flash_Context;
                            Name    : in String;
                            Value   : in Util.Beans.Objects.Object) is
      Instance : Flash_Bean_Access;
   begin
      Flash.Get_Execute_Flash (Instance);
      if Util.Beans.Objects.Is_Null (Value) then
         Instance.Attributes.Delete (Name);
      else
         Instance.Attributes.Include (Name, Value);
      end if;
   end Set_Attribute;

   --  ------------------------------
   --  Set the attribute having given name with the value.
   --  ------------------------------
   procedure Set_Attribute (Flash   : in out Flash_Context;
                            Name    : in Unbounded_String;
                            Value   : in Util.Beans.Objects.Object) is
   begin
      Flash.Set_Attribute (To_String (Name), Value);
   end Set_Attribute;

   --  ------------------------------
   --  Get the attribute with the given name from the 'previous' flash context.
   --  ------------------------------
   function Get_Attribute (Flash : in Flash_Context;
                           Name  : in String) return Util.Beans.Objects.Object is
   begin
      if Flash.Previous = null then
         return Util.Beans.Objects.Null_Object;
      else
         declare
            Pos : constant Util.Beans.Objects.Maps.Cursor := Flash.Previous.Attributes.Find (Name);
         begin
            if Util.Beans.Objects.Maps.Has_Element (Pos) then
               return Util.Beans.Objects.Maps.Element (Pos);
            else
               return Util.Beans.Objects.Null_Object;
            end if;
         end;
      end if;
   end Get_Attribute;

   --  Keep in the flash context the request attribute identified by the name Name.
   procedure Keep (Flash   : in out Flash_Context;
                   Name    : in String) is
   begin
      null;
   end Keep;

   --  ------------------------------
   --  Returns True if the Redirect property was set on the previous flash instance.
   --  ------------------------------
   function Is_Redirect (Flash : in Flash_Context) return Boolean is
   begin
      return Flash.Previous /= null and then Flash.Previous.Redirect;
   end Is_Redirect;

   --  Set this property to True to indicate to the next request on this session will be
   --  a redirect.  After this call, the next request will return the Redirect value
   --  when the Is_Redirect function will be called.
   procedure Set_Redirect (Flash    : in out Flash_Context;
                           Redirect : in Boolean) is
   begin
      null;
   end Set_Redirect;

   --  ------------------------------
   --  Returns True if the faces messages that are queued in the faces context must be
   --  preserved so they are accessible through the flash instance at the next request.
   --  ------------------------------
   function Is_Keep_Messages (Flash : in Flash_Context) return Boolean is
   begin
      return Flash.Keep_Messages;
   end Is_Keep_Messages;

   --  ------------------------------
   --  Set the keep messages property which controlls whether the faces messages
   --  that are queued in the faces context must be preserved so they are accessible through
   --  the flash instance at the next request.
   --  ------------------------------
   procedure Set_Keep_Messages (Flash : in out Flash_Context;
                                Value : in Boolean) is
   begin
      Flash.Keep_Messages := Value;
   end Set_Keep_Messages;

   --  ------------------------------
   --  Perform any specific action before processing the phase referenced by Phase.
   --  This operation is used to restore the flash context for a new request.
   --  ------------------------------
   procedure Do_Pre_Phase_Actions (Flash   : in out Flash_Context;
                                   Phase   : in ASF.Events.Phases.Phase_Type;
                                   Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Events.Phases.Phase_Type;
      use type Util.Beans.Basic.Readonly_Bean_Access;
   begin
      --  Restore the flash bean instance from the session if there is one.
      if Phase = ASF.Events.Phases.RESTORE_VIEW then
         declare
            S : constant ASF.Sessions.Session := Context.Get_Session;
            B : access Util.Beans.Basic.Readonly_Bean'Class;
         begin
            if S.Is_Valid then
               Flash.Object := S.Get_Attribute ("asf.flash.bean");
               B := Util.Beans.Objects.To_Bean (Flash.Object);
               if B /= null and then B.all in Flash_Bean'Class then
                  Flash.Previous := Flash_Bean'Class (B.all)'Unchecked_Access;

                  Context.Add_Messages ("", Flash.Previous.Messages);
               end if;
            end if;
         end;
      end if;
   end Do_Pre_Phase_Actions;

   --  ------------------------------
   --  Perform any specific action after processing the phase referenced by Phase.
   --  This operation is used to save the flash context
   --  ------------------------------
   procedure Do_Post_Phase_Actions (Flash   : in out Flash_Context;
                                    Phase   : in ASF.Events.Phases.Phase_Type;
                                    Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Events.Phases.Phase_Type;
   begin
      if (Phase = ASF.Events.Phases.INVOKE_APPLICATION
          or Phase = ASF.Events.Phases.RENDER_RESPONSE) and then not Flash.Last_Phase_Done then
         Flash.Do_Last_Phase_Actions (Context);
      end if;
   end Do_Post_Phase_Actions;

   --  ------------------------------
   --  Perform the last actions that must be made to save the flash context in the session.
   --  ------------------------------
   procedure Do_Last_Phase_Actions (Flash   : in out Flash_Context;
                                    Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      S : ASF.Sessions.Session := Context.Get_Session;
   begin
      --  If we have to keep the messages, save them in the flash bean context if there are any.
      if Flash.Keep_Messages then
         declare
            Messages : constant Applications.Messages.Vectors.Cursor := Context.Get_Messages ("");
         begin
            if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
               if Flash.Next = null then
                  Flash.Next := new Flash_Bean;
               end if;
               ASF.Applications.Messages.Utils.Copy (Flash.Next.Messages, Messages);
            end if;
         end;
      end if;

      if S.Is_Valid then
         S.Set_Attribute ("asf.flash.bean", Util.Beans.Objects.Null_Object);
      elsif Flash.Next /= null then
         S := Context.Get_Session (Create => True);
      end if;

      if Flash.Next /= null then
         S.Set_Attribute ("asf.flash.bean", Util.Beans.Objects.To_Object (Flash.Next.all'Access));
      end if;
      Flash.Last_Phase_Done := True;
   end Do_Last_Phase_Actions;

   procedure Get_Active_Flash (Flash   : in out Flash_Context;
                               Result  : out Flash_Bean_Access) is
   begin
      if Flash.Previous = null then
         null;
      end if;
      Result := Flash.Previous;
   end Get_Active_Flash;

   procedure Get_Execute_Flash (Flash   : in out Flash_Context;
                                Result  : out Flash_Bean_Access) is
   begin
      if Flash.Next = null then
         Flash.Next := new Flash_Bean;
      end if;
      Result := Flash.Next;
   end Get_Execute_Flash;

   --  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 Flash_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (From, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

end ASF.Contexts.Flash;

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

with ASF.Sessions;
with ASF.Applications.Messages.Utils;
package body ASF.Contexts.Flash is

   --  ------------------------------
   --  Set the attribute having given name with the value.
   --  ------------------------------
   procedure Set_Attribute (Flash   : in out Flash_Context;
                            Name    : in String;
                            Value   : in Util.Beans.Objects.Object) is
      Instance : Flash_Bean_Access;
   begin
      Flash.Get_Execute_Flash (Instance);
      if Util.Beans.Objects.Is_Null (Value) then
         Instance.Attributes.Delete (Name);
      else
         Instance.Attributes.Include (Name, Value);
      end if;
   end Set_Attribute;

   --  ------------------------------
   --  Set the attribute having given name with the value.
   --  ------------------------------
   procedure Set_Attribute (Flash   : in out Flash_Context;
                            Name    : in Unbounded_String;
                            Value   : in Util.Beans.Objects.Object) is
   begin
      Flash.Set_Attribute (To_String (Name), Value);
   end Set_Attribute;

   --  ------------------------------
   --  Get the attribute with the given name from the 'previous' flash context.
   --  ------------------------------
   function Get_Attribute (Flash : in Flash_Context;
                           Name  : in String) return Util.Beans.Objects.Object is
   begin
      if Flash.Previous = null then
         return Util.Beans.Objects.Null_Object;
      else
         declare
            Pos : constant Util.Beans.Objects.Maps.Cursor := Flash.Previous.Attributes.Find (Name);
         begin
            if Util.Beans.Objects.Maps.Has_Element (Pos) then
               return Util.Beans.Objects.Maps.Element (Pos);
            else
               return Util.Beans.Objects.Null_Object;
            end if;
         end;
      end if;
   end Get_Attribute;

   --  Keep in the flash context the request attribute identified by the name Name.
   procedure Keep (Flash   : in out Flash_Context;
                   Name    : in String) is
   begin
      null;
   end Keep;

   --  ------------------------------
   --  Returns True if the Redirect property was set on the previous flash instance.
   --  ------------------------------
   function Is_Redirect (Flash : in Flash_Context) return Boolean is
   begin
      return Flash.Previous /= null and then Flash.Previous.Redirect;
   end Is_Redirect;

   --  Set this property to True to indicate to the next request on this session will be
   --  a redirect.  After this call, the next request will return the Redirect value
   --  when the Is_Redirect function will be called.
   procedure Set_Redirect (Flash    : in out Flash_Context;
                           Redirect : in Boolean) is
   begin
      null;
   end Set_Redirect;

   --  ------------------------------
   --  Returns True if the faces messages that are queued in the faces context must be
   --  preserved so they are accessible through the flash instance at the next request.
   --  ------------------------------
   function Is_Keep_Messages (Flash : in Flash_Context) return Boolean is
   begin
      return Flash.Keep_Messages;
   end Is_Keep_Messages;

   --  ------------------------------
   --  Set the keep messages property which controlls whether the faces messages
   --  that are queued in the faces context must be preserved so they are accessible through
   --  the flash instance at the next request.
   --  ------------------------------
   procedure Set_Keep_Messages (Flash : in out Flash_Context;
                                Value : in Boolean) is
   begin
      Flash.Keep_Messages := Value;
   end Set_Keep_Messages;

   --  ------------------------------
   --  Perform any specific action before processing the phase referenced by Phase.
   --  This operation is used to restore the flash context for a new request.
   --  ------------------------------
   procedure Do_Pre_Phase_Actions (Flash   : in out Flash_Context;
                                   Phase   : in ASF.Events.Phases.Phase_Type;
                                   Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Events.Phases.Phase_Type;
      use type Util.Beans.Basic.Readonly_Bean_Access;
   begin
      --  Restore the flash bean instance from the session if there is one.
      if Phase = ASF.Events.Phases.RESTORE_VIEW then
         declare
            S : constant ASF.Sessions.Session := Context.Get_Session;
            B : access Util.Beans.Basic.Readonly_Bean'Class;
         begin
            if S.Is_Valid then
               Flash.Object := S.Get_Attribute ("asf.flash.bean");
               B := Util.Beans.Objects.To_Bean (Flash.Object);
               if B /= null and then B.all in Flash_Bean'Class then
                  Flash.Previous := Flash_Bean'Class (B.all)'Unchecked_Access;

                  Context.Add_Messages ("", Flash.Previous.Messages);
               end if;
            end if;
         end;
      end if;
   end Do_Pre_Phase_Actions;

   --  ------------------------------
   --  Perform any specific action after processing the phase referenced by Phase.
   --  This operation is used to save the flash context
   --  ------------------------------
   procedure Do_Post_Phase_Actions (Flash   : in out Flash_Context;
                                    Phase   : in ASF.Events.Phases.Phase_Type;
                                    Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Events.Phases.Phase_Type;
   begin
      if (Phase = ASF.Events.Phases.INVOKE_APPLICATION
          or Phase = ASF.Events.Phases.RENDER_RESPONSE) and then not Flash.Last_Phase_Done
      then
         Flash.Do_Last_Phase_Actions (Context);
      end if;
   end Do_Post_Phase_Actions;

   --  ------------------------------
   --  Perform the last actions that must be made to save the flash context in the session.
   --  ------------------------------
   procedure Do_Last_Phase_Actions (Flash   : in out Flash_Context;
                                    Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      S : ASF.Sessions.Session := Context.Get_Session;
   begin
      --  If we have to keep the messages, save them in the flash bean context if there are any.
      if Flash.Keep_Messages then
         declare
            Messages : constant Applications.Messages.Vectors.Cursor := Context.Get_Messages ("");
         begin
            if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
               if Flash.Next = null then
                  Flash.Next := new Flash_Bean;
               end if;
               ASF.Applications.Messages.Utils.Copy (Flash.Next.Messages, Messages);
            end if;
         end;
      end if;

      if S.Is_Valid then
         S.Set_Attribute ("asf.flash.bean", Util.Beans.Objects.Null_Object);
      elsif Flash.Next /= null then
         S := Context.Get_Session (Create => True);
      end if;

      if Flash.Next /= null then
         S.Set_Attribute ("asf.flash.bean", Util.Beans.Objects.To_Object (Flash.Next.all'Access));
      end if;
      Flash.Last_Phase_Done := True;
   end Do_Last_Phase_Actions;

   procedure Get_Active_Flash (Flash   : in out Flash_Context;
                               Result  : out Flash_Bean_Access) is
   begin
      if Flash.Previous = null then
         null;
      end if;
      Result := Flash.Previous;
   end Get_Active_Flash;

   procedure Get_Execute_Flash (Flash   : in out Flash_Context;
                                Result  : out Flash_Bean_Access) is
   begin
      if Flash.Next = null then
         Flash.Next := new Flash_Bean;
      end if;
      Result := Flash.Next;
   end Get_Execute_Flash;

   --  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 Flash_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (From, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

end ASF.Contexts.Flash;

Fix indentation style warning

Fix indentation style warning