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

with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Hashed_Maps;

with Util.Beans.Objects;
with Util.Properties;

with ASF.Applications.Main;
with ASF.Contexts.Faces;

with Gen.Model.Packages;
with Gen.Model.Projects;
with Gen.Artifacts.Hibernate;
with Gen.Artifacts.Query;
with Gen.Artifacts.Mappings;
with Gen.Artifacts.Distribs;
with Gen.Artifacts.XMI;
package Gen.Generator is

   --  A fatal error that prevents the generator to proceed has occurred.
   Fatal_Error : exception;

   G_URI : constant String := "http://code.google.com/p/ada-ado/generator";

   type Package_Type is (PACKAGE_MODEL, PACKAGE_FORMS);

   type Mapping_File is record
      Path   : Ada.Strings.Unbounded.Unbounded_String;
      Output : Ada.Text_IO.File_Type;
   end record;

   type Handler is new ASF.Applications.Main.Application and Gen.Artifacts.Generator with private;

   --  Initialize the generator
   procedure Initialize (H : in out Handler;
                         Config_Dir : in Ada.Strings.Unbounded.Unbounded_String;
                         Debug : in Boolean);

   --  Get the configuration properties.
   function Get_Properties (H : in Handler) return Util.Properties.Manager;

   --  Report an error and set the exit status accordingly
   procedure Error (H : in out Handler;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "");

   --  Report an info message.
   procedure Info (H : in out Handler;
                   Message : in String;
                   Arg1    : in String := "";
                   Arg2    : in String := "";
                   Arg3    : in String := "");

   --  Read the XML package file
   procedure Read_Package (H    : in out Handler;
                           File : in String);

   --  Read the model mapping types and initialize the hibernate artifact.
   procedure Read_Mappings (H    : in out Handler);

   --  Read the XML model file
   procedure Read_Model (H      : in out Handler;
                         File   : in String;
                         Silent : in Boolean);

   --  Read the model and query files stored in the application directory db.
   procedure Read_Models (H : in out Handler;
                          Dirname : in String);

   --  Read the XML project file.  When Recursive is set, read the GNAT project
   --  files used by the main project and load all the dynamo.xml files defined
   --  by these project.
   procedure Read_Project (H         : in out Handler;
                           File      : in String;
                           Recursive : in Boolean := False);

   --  Prepare the model by checking, verifying and initializing it after it is completely known.
   procedure Prepare (H : in out Handler);

   --  Finish the generation.  Some artifacts could generate other files that take into
   --  account files generated previously.
   procedure Finish (H : in out Handler);

   --  Tell the generator to activate the generation of the given template name.
   --  The name is a property name that must be defined in generator.properties to
   --  indicate the template file.  Several artifacts can trigger the generation
   --  of a given template.  The template is generated only once.
   procedure Add_Generation (H    : in out Handler;
                             Name : in String;
                             Mode : in Gen.Artifacts.Iteration_Mode;
                             Mapping : in String);

   --  Enable the generation of the Ada package given by the name.  By default all the Ada
   --  packages found in the model are generated.  When called, this enables the generation
   --  only for the Ada packages registered here.
   procedure Enable_Package_Generation (H    : in out Handler;
                                        Name : in String);

   --  Save the content generated by the template generator.
   procedure Save_Content (H       : in out Handler;
                           File    : in String;
                           Content : in Ada.Strings.Unbounded.Unbounded_String);

   --  Generate the code using the template file
   procedure Generate (H     : in out Handler;
                       Mode  : in Gen.Artifacts.Iteration_Mode;
                       File  : in String;
                       Save  : not null access
                         procedure (H       : in out Handler;
                                    File    : in String;
                                    Content : in Ada.Strings.Unbounded.Unbounded_String));

   --  Generate the code using the template file
   procedure Generate (H     : in out Handler;
                       File  : in String;
                       Model : in Gen.Model.Definition_Access;
                       Save  : not null access
                         procedure (H       : in out Handler;
                                    File    : in String;
                                    Content : in Ada.Strings.Unbounded.Unbounded_String));

   --  Generate all the code for the templates activated through Add_Generation.
   procedure Generate_All (H    : in out Handler);

   --  Generate all the code generation files stored in the directory
   procedure Generate_All (H    : in out Handler;
                           Mode : in Gen.Artifacts.Iteration_Mode;
                           Name : in String);

   --  Set the directory where template files are stored.
   procedure Set_Template_Directory (H    : in out Handler;
                                     Path : in Ada.Strings.Unbounded.Unbounded_String);

   --  Set the directory where results files are generated.
   procedure Set_Result_Directory (H    : in out Handler;
                                   Path : in String);

   --  Get the result directory path.
   function Get_Result_Directory (H : in Handler) return String;

   --  Get the project plugin directory path.
   function Get_Plugin_Directory (H : in Handler) return String;

   --  Get the config directory path.
   function Get_Config_Directory (H : in Handler) return String;

   --  Get the dynamo installation directory path.
   function Get_Install_Directory (H : in Handler) return String;

   --  Return the search directories that the AWA application can use to find files.
   --  The search directories is built by using the project dependencies.
   function Get_Search_Directories (H : in Handler) return String;

   --  Get the exit status
   --  Returns 0 if the generation was successful
   --  Returns 1 if there was a generation error
   function Get_Status (H : in Handler) return Ada.Command_Line.Exit_Status;

   --  Get the configuration parameter.
   function Get_Parameter (H       : in Handler;
                           Name    : in String;
                           Default : in String := "") return String;

   --  Get the configuration parameter.
   function Get_Parameter (H       : in Handler;
                           Name    : in String;
                           Default : in Boolean := False) return Boolean;

   --  Set the force-save file mode.  When False, if the generated file exists already,
   --  an error message is reported.
   procedure Set_Force_Save (H  : in out Handler;
                             To : in Boolean);

   --  Set the project name.
   procedure Set_Project_Name (H    : in out Handler;
                               Name : in String);

   --  Get the project name.
   function Get_Project_Name (H : in Handler) return String;

   --  Set the project property.
   procedure Set_Project_Property (H     : in out Handler;
                                   Name  : in String;
                                   Value : in String);

   --  Get the project property identified by the given name.  If the project property
   --  does not exist, returns the default value.  Project properties are loaded
   --  by Read_Project.
   function Get_Project_Property (H       : in Handler;
                                  Name    : in String;
                                  Default : in String := "") return String;

   --  Save the project description and parameters.
   procedure Save_Project (H : in out Handler);

   --  Get the path of the last generated file.
   function Get_Generated_File (H : in Handler) return String;

   --  Update the project model through the Process procedure.
   procedure Update_Project (H : in out Handler;
                             Process : not null access
                               procedure (P : in out Model.Projects.Root_Project_Definition));

   --  Scan the dynamo directories and execute the Process procedure with the
   --  directory path.
   procedure Scan_Directories (H : in Handler;
                               Process : not null access
                                 procedure (Dir : in String));

private

   use Ada.Strings.Unbounded;
   use Gen.Artifacts;

   type Template_Context is record
      Mode    : Gen.Artifacts.Iteration_Mode;
      Mapping : Unbounded_String;
   end record;

   package Template_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Template_Context,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   type Handler is new ASF.Applications.Main.Application and Gen.Artifacts.Generator with record
      Conf       : ASF.Applications.Config;

      --  Config directory.
      Config_Dir : Ada.Strings.Unbounded.Unbounded_String;

      --  Output base directory.
      Output_Dir : Ada.Strings.Unbounded.Unbounded_String;

      Model  : aliased Gen.Model.Packages.Model_Definition;
      Status : Ada.Command_Line.Exit_Status := 0;

      --  The file that must be saved (the file attribute in <f:view>.
      File     : access Util.Beans.Objects.Object;

      --  Indicates whether the file must be saved at each generation or only once.
      --  This is the mode attribute in <f:view>.
      Mode     : access Util.Beans.Objects.Object;

      --  Indicates whether the file must be ignored after the generation.
      --  This is the ignore attribute in <f:view>.  It is intended to be used for the package
      --  body generation to skip that in some cases when it turns out there is no operation.
      Ignore   : access Util.Beans.Objects.Object;

      --  Whether the AdaMappings.xml file was loaded or not.
      Type_Mapping_Loaded : Boolean := False;

      --  The root project document.
      Project : aliased Gen.Model.Projects.Root_Project_Definition;

      --  Hibernate XML artifact
      Hibernate : Gen.Artifacts.Hibernate.Artifact;

      --  Query generation artifact.
      Query     : Gen.Artifacts.Query.Artifact;

      --  Type mapping artifact.
      Mappings  : Gen.Artifacts.Mappings.Artifact;

      --  The distribution artifact.
      Distrib   : Gen.Artifacts.Distribs.Artifact;

      --  Ada generation from UML-XMI models.
      XMI       : Gen.Artifacts.XMI.Artifact;

      --  The list of templates that must be generated.
      Templates : Template_Map.Map;

      --  Force the saving of a generated file, even if a file already exist.
      Force_Save : Boolean := True;
   end record;

   --  Execute the lifecycle phases on the faces context.
   overriding
   procedure Execute_Lifecycle (App     : in Handler;
                                Context : in out ASF.Contexts.Faces.Faces_Context'Class);

end Gen.Generator;

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

with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Hashed_Maps;

with Util.Beans.Objects;
with Util.Properties;

with ASF.Applications.Main;
with ASF.Contexts.Faces;
with ASF.Servlets.Files;

with Gen.Model.Packages;
with Gen.Model.Projects;
with Gen.Artifacts.Hibernate;
with Gen.Artifacts.Query;
with Gen.Artifacts.Mappings;
with Gen.Artifacts.Distribs;
with Gen.Artifacts.XMI;
package Gen.Generator is

   --  A fatal error that prevents the generator to proceed has occurred.
   Fatal_Error : exception;

   G_URI : constant String := "http://code.google.com/p/ada-ado/generator";

   type Package_Type is (PACKAGE_MODEL, PACKAGE_FORMS);

   type Mapping_File is record
      Path   : Ada.Strings.Unbounded.Unbounded_String;
      Output : Ada.Text_IO.File_Type;
   end record;

   type Handler is new ASF.Applications.Main.Application and Gen.Artifacts.Generator with private;

   --  Initialize the generator
   procedure Initialize (H : in out Handler;
                         Config_Dir : in Ada.Strings.Unbounded.Unbounded_String;
                         Debug : in Boolean);

   --  Get the configuration properties.
   function Get_Properties (H : in Handler) return Util.Properties.Manager;

   --  Report an error and set the exit status accordingly
   procedure Error (H : in out Handler;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "");

   --  Report an info message.
   procedure Info (H : in out Handler;
                   Message : in String;
                   Arg1    : in String := "";
                   Arg2    : in String := "";
                   Arg3    : in String := "");

   --  Read the XML package file
   procedure Read_Package (H    : in out Handler;
                           File : in String);

   --  Read the model mapping types and initialize the hibernate artifact.
   procedure Read_Mappings (H    : in out Handler);

   --  Read the XML model file
   procedure Read_Model (H      : in out Handler;
                         File   : in String;
                         Silent : in Boolean);

   --  Read the model and query files stored in the application directory db.
   procedure Read_Models (H : in out Handler;
                          Dirname : in String);

   --  Read the XML project file.  When Recursive is set, read the GNAT project
   --  files used by the main project and load all the dynamo.xml files defined
   --  by these project.
   procedure Read_Project (H         : in out Handler;
                           File      : in String;
                           Recursive : in Boolean := False);

   --  Prepare the model by checking, verifying and initializing it after it is completely known.
   procedure Prepare (H : in out Handler);

   --  Finish the generation.  Some artifacts could generate other files that take into
   --  account files generated previously.
   procedure Finish (H : in out Handler);

   --  Tell the generator to activate the generation of the given template name.
   --  The name is a property name that must be defined in generator.properties to
   --  indicate the template file.  Several artifacts can trigger the generation
   --  of a given template.  The template is generated only once.
   procedure Add_Generation (H    : in out Handler;
                             Name : in String;
                             Mode : in Gen.Artifacts.Iteration_Mode;
                             Mapping : in String);

   --  Enable the generation of the Ada package given by the name.  By default all the Ada
   --  packages found in the model are generated.  When called, this enables the generation
   --  only for the Ada packages registered here.
   procedure Enable_Package_Generation (H    : in out Handler;
                                        Name : in String);

   --  Save the content generated by the template generator.
   procedure Save_Content (H       : in out Handler;
                           File    : in String;
                           Content : in Ada.Strings.Unbounded.Unbounded_String);

   --  Generate the code using the template file
   procedure Generate (H     : in out Handler;
                       Mode  : in Gen.Artifacts.Iteration_Mode;
                       File  : in String;
                       Save  : not null access
                         procedure (H       : in out Handler;
                                    File    : in String;
                                    Content : in Ada.Strings.Unbounded.Unbounded_String));

   --  Generate the code using the template file
   procedure Generate (H     : in out Handler;
                       File  : in String;
                       Model : in Gen.Model.Definition_Access;
                       Save  : not null access
                         procedure (H       : in out Handler;
                                    File    : in String;
                                    Content : in Ada.Strings.Unbounded.Unbounded_String));

   --  Generate all the code for the templates activated through Add_Generation.
   procedure Generate_All (H    : in out Handler);

   --  Generate all the code generation files stored in the directory
   procedure Generate_All (H    : in out Handler;
                           Mode : in Gen.Artifacts.Iteration_Mode;
                           Name : in String);

   --  Set the directory where template files are stored.
   procedure Set_Template_Directory (H    : in out Handler;
                                     Path : in Ada.Strings.Unbounded.Unbounded_String);

   --  Set the directory where results files are generated.
   procedure Set_Result_Directory (H    : in out Handler;
                                   Path : in String);

   --  Get the result directory path.
   function Get_Result_Directory (H : in Handler) return String;

   --  Get the project plugin directory path.
   function Get_Plugin_Directory (H : in Handler) return String;

   --  Get the config directory path.
   function Get_Config_Directory (H : in Handler) return String;

   --  Get the dynamo installation directory path.
   function Get_Install_Directory (H : in Handler) return String;

   --  Return the search directories that the AWA application can use to find files.
   --  The search directories is built by using the project dependencies.
   function Get_Search_Directories (H : in Handler) return String;

   --  Get the exit status
   --  Returns 0 if the generation was successful
   --  Returns 1 if there was a generation error
   function Get_Status (H : in Handler) return Ada.Command_Line.Exit_Status;

   --  Get the configuration parameter.
   function Get_Parameter (H       : in Handler;
                           Name    : in String;
                           Default : in String := "") return String;

   --  Get the configuration parameter.
   function Get_Parameter (H       : in Handler;
                           Name    : in String;
                           Default : in Boolean := False) return Boolean;

   --  Set the force-save file mode.  When False, if the generated file exists already,
   --  an error message is reported.
   procedure Set_Force_Save (H  : in out Handler;
                             To : in Boolean);

   --  Set the project name.
   procedure Set_Project_Name (H    : in out Handler;
                               Name : in String);

   --  Get the project name.
   function Get_Project_Name (H : in Handler) return String;

   --  Set the project property.
   procedure Set_Project_Property (H     : in out Handler;
                                   Name  : in String;
                                   Value : in String);

   --  Get the project property identified by the given name.  If the project property
   --  does not exist, returns the default value.  Project properties are loaded
   --  by Read_Project.
   function Get_Project_Property (H       : in Handler;
                                  Name    : in String;
                                  Default : in String := "") return String;

   --  Save the project description and parameters.
   procedure Save_Project (H : in out Handler);

   --  Get the path of the last generated file.
   function Get_Generated_File (H : in Handler) return String;

   --  Update the project model through the Process procedure.
   procedure Update_Project (H : in out Handler;
                             Process : not null access
                               procedure (P : in out Model.Projects.Root_Project_Definition));

   --  Scan the dynamo directories and execute the Process procedure with the
   --  directory path.
   procedure Scan_Directories (H : in Handler;
                               Process : not null access
                                 procedure (Dir : in String));

private

   use Ada.Strings.Unbounded;
   use Gen.Artifacts;

   type Template_Context is record
      Mode    : Gen.Artifacts.Iteration_Mode;
      Mapping : Unbounded_String;
   end record;

   package Template_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Template_Context,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   type Handler is new ASF.Applications.Main.Application and Gen.Artifacts.Generator with record
      Conf       : ASF.Applications.Config;

      --  Config directory.
      Config_Dir : Ada.Strings.Unbounded.Unbounded_String;

      --  Output base directory.
      Output_Dir : Ada.Strings.Unbounded.Unbounded_String;

      Model  : aliased Gen.Model.Packages.Model_Definition;
      Status : Ada.Command_Line.Exit_Status := 0;

      --  The file that must be saved (the file attribute in <f:view>.
      File     : access Util.Beans.Objects.Object;

      --  Indicates whether the file must be saved at each generation or only once.
      --  This is the mode attribute in <f:view>.
      Mode     : access Util.Beans.Objects.Object;

      --  Indicates whether the file must be ignored after the generation.
      --  This is the ignore attribute in <f:view>.  It is intended to be used for the package
      --  body generation to skip that in some cases when it turns out there is no operation.
      Ignore   : access Util.Beans.Objects.Object;

      --  Whether the AdaMappings.xml file was loaded or not.
      Type_Mapping_Loaded : Boolean := False;

      --  The root project document.
      Project : aliased Gen.Model.Projects.Root_Project_Definition;

      --  Hibernate XML artifact
      Hibernate : Gen.Artifacts.Hibernate.Artifact;

      --  Query generation artifact.
      Query     : Gen.Artifacts.Query.Artifact;

      --  Type mapping artifact.
      Mappings  : Gen.Artifacts.Mappings.Artifact;

      --  The distribution artifact.
      Distrib   : Gen.Artifacts.Distribs.Artifact;

      --  Ada generation from UML-XMI models.
      XMI       : Gen.Artifacts.XMI.Artifact;

      --  The list of templates that must be generated.
      Templates : Template_Map.Map;

      --  Force the saving of a generated file, even if a file already exist.
      Force_Save : Boolean := True;

      --  A fake servlet for template evaluation.
      Servlet    : ASF.Servlets.Servlet_Access;
   end record;

   --  Execute the lifecycle phases on the faces context.
   overriding
   procedure Execute_Lifecycle (App     : in Handler;
                                Context : in out ASF.Contexts.Faces.Faces_Context'Class);

end Gen.Generator;

Add a file servlet to be able to use the <util:file> component in templates


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

with Util.Log.Loggers;
with Util.Test_Caller;

with EL.Contexts.Default;
package body ASF.Routes.Tests is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Routes.Tests");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (fixed path)",
                       Test_Add_Route_With_Path'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (:param path)",
                       Test_Add_Route_With_Param'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (*.ext path)",
                       Test_Add_Route_With_Ext'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (#{} path)",
                       Test_Add_Route_With_EL'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Iterate",
                       Test_Iterate'Access);
   end Add_Tests;

   overriding
   function Get_Value (Bean : in Test_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "id" then
         return Util.Beans.Objects.To_Object (Bean.Id);
      elsif Name = "name" then
         return Util.Beans.Objects.To_Object (Bean.Name);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   overriding
   procedure Set_Value (Bean  : in out Test_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" then
         Bean.Id := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "name" then
         Bean.Name := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Setup the test instance.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
   begin
      T.Bean := new Test_Bean;
      ASF.Tests.EL_Test (T).Set_Up;
      T.Root_Resolver.Register (Ada.Strings.Unbounded.To_Unbounded_String ("user"),
                                Util.Beans.Objects.To_Object (T.Bean.all'Access));
      for I in T.Routes'Range loop
         T.Routes (I).Index := I;
      end loop;
   end Set_Up;

   --  ------------------------------
   --  Verify that the path matches the given route.
   --  ------------------------------
   procedure Verify_Route (T      : in out Test;
                           Router : in out Router_Type;
                           Path   : in String;
                           Index  : in Positive;
                           Bean   : in out Test_Bean'Class) is
      Route   : constant Route_Type_Access := T.Routes (Index)'Unchecked_Access;
      R       : Route_Context_Type;
   begin
      Router.Find_Route (Path, R);
      declare
         P : constant String := Get_Path_Info (R);
      begin
         T.Assert_Equals (Path, P, "Add_Route + Find_Route with " & Path);
         T.Assert (Get_Route (R) /= null, "Get_Route returns a null route for " & Path);
         T.Assert (Get_Route (R) = Route, "Get_Route returns a wrong route for " & Path);

         --  Inject the path parameters in the bean instance.
         Inject_Parameters (R, Bean, T.ELContext.all);
      end;
   end Verify_Route;

   --  ------------------------------
   --  Add the route associted with the path pattern.
   --  ------------------------------
   procedure Add_Route (T      : in out Test;
                        Router : in out Router_Type;
                        Path   : in String;
                        Index  : in Positive;
                        Bean   : in out Test_Bean'Class) is
      Route   : constant Route_Type_Access := T.Routes (Index)'Unchecked_Access;
   begin
      Router.Add_Route (Path, Route, T.ELContext.all);
      Verify_Route (T, Router, Path, Index, Bean);
   end Add_Route;

   --  ------------------------------
   --  Test the Add_Route with simple fixed path components.
   --  Example: /list/index.html
   --  ------------------------------
   procedure Test_Add_Route_With_Path (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/page.html", 1, Bean);
      Add_Route (T, Router, "/list/page.html", 2, Bean);
      Add_Route (T, Router, "/list/index.html", 3, Bean);
      Add_Route (T, Router, "/view/page/content/index.html", 4, Bean);
      Add_Route (T, Router, "/list//page/view.html", 5, Bean);
      Add_Route (T, Router, "/list////page/content.html", 6, Bean);

      Verify_Route (T, Router, "/list/index.html", 3, Bean);
   end Test_Add_Route_With_Path;

   --  ------------------------------
   --  Test the Add_Route with extension mapping.
   --  Example: /list/*.html
   --  ------------------------------
   procedure Test_Add_Route_With_Ext (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/page.html", 1, Bean);
      Add_Route (T, Router, "/list/*.html", 2, Bean);
      Add_Route (T, Router, "/list/index.html", 3, Bean);
      Add_Route (T, Router, "/view/page/content/page1.html", 4, Bean);
      Add_Route (T, Router, "/view/page/content/page2.html", 5, Bean);
      Add_Route (T, Router, "/view/page/content/*.html", 6, Bean);

      --  Verify precedence and wildcard matching.
      Verify_Route (T, Router, "/list/index.html", 3, Bean);
      Verify_Route (T, Router, "/list/admin.html", 2, Bean);
      Verify_Route (T, Router, "/list/1/2/3/admin.html", 2, Bean);
      Verify_Route (T, Router, "/view/page/content/t.html", 6, Bean);
      Verify_Route (T, Router, "/view/page/content/1/t.html", 6, Bean);
      Verify_Route (T, Router, "/view/page/content/1/2/t.html", 6, Bean);
   end Test_Add_Route_With_Ext;

   --  ------------------------------
   --  Test the Add_Route with fixed path components and path parameters.
   --  Example: /users/:id/view.html
   --  ------------------------------
   procedure Test_Add_Route_With_Param (T : in out Test) is
      use Ada.Strings.Unbounded;

      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/users/:id/view.html", 1, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/users/:id/list.html", 2, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/users/:id/index.html", 3, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/view/page/content/index.html", 4, Bean);
      Add_Route (T, Router, "/list//page/view.html", 5, Bean);
      Add_Route (T, Router, "/list////page/content.html", 6, Bean);
      T.Assert_Equals ("", To_String (Bean.Id), "Bean injection failed for fixed path");

      Add_Route (T, Router, "/users/:id/:name/index.html", 7, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals (":name", To_String (Bean.Name), "Bean injection failed for :name");

      Add_Route (T, Router, "/users/list/index.html", 8, Bean);

      Verify_Route (T, Router, "/users/1234/view.html", 1, Bean);
      T.Assert_Equals ("1234", To_String (Bean.Id), "Bean injection failed for :id");

      Verify_Route (T, Router, "/users/234/567/index.html", 7, Bean);
      T.Assert_Equals ("234", To_String (Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals ("567", To_String (Bean.Name), "Bean injection failed for :name");

   end Test_Add_Route_With_Param;

   --  ------------------------------
   --  Test the Add_Route with fixed path components and EL path injection.
   --  Example: /users/#{user.id}/view.html
   --  ------------------------------
   procedure Test_Add_Route_With_EL (T : in out Test) is
            use Ada.Strings.Unbounded;

      Router  : Router_Type;
      Bean    : aliased Test_Bean;
   begin
      Add_Route (T, Router, "/users/#{user.id}", 1, Bean);
      Add_Route (T, Router, "/users/view.html", 2, Bean);
      Add_Route (T, Router, "/users/#{user.id}/#{user.name}/index.html", 3, Bean);
      Add_Route (T, Router, "/users/admin/#{user.id}/pages/#{user.name}", 4, Bean);

      --  Verify that the path parameters are injected in the 'user' bean (= T.Bean).
      Verify_Route (T, Router, "/users/234/567/index.html", 3, Bean);
      T.Assert_Equals ("234", To_String (T.Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals ("567", To_String (T.Bean.Name), "Bean injection failed for :name");

   end Test_Add_Route_With_EL;

   P_1 : aliased constant String := "/list/index.html";
   P_2 : aliased constant String := "/users/:id";
   P_3 : aliased constant String := "/users/:id/view";
   P_4 : aliased constant String := "/users/index.html";
   P_5 : aliased constant String := "/users/:id/:name";
   P_6 : aliased constant String := "/users/:id/:name/view.html";
   P_7 : aliased constant String := "/users/:id/list";
   P_8 : aliased constant String := "/users/test.html";
   P_9 : aliased constant String := "/admin/1/2/3/4/5/list.html";
   P_10 : aliased constant String := "/admin/*.html";
   P_11 : aliased constant String := "/admin/*.png";
   P_12 : aliased constant String := "/admin/*.jpg";
   P_13 : aliased constant String := "/users/:id/page/*.xml";
   P_14 : aliased constant String := "/*.jsf";

   type Const_String_Access is access constant String;

   type String_Array is array (Positive range <>) of Const_String_Access;

   Path_Array : constant String_Array :=
     (P_1'Access, P_2'Access, P_3'Access, P_4'Access,
      P_5'Access, P_6'Access, P_7'Access, P_8'Access,
      P_9'Access, P_10'Access, P_11'Access, P_12'Access,
      P_13'Access, P_14'Access);

   --  ------------------------------
   --  Test the Iterate over several paths.
   --  ------------------------------
   procedure Test_Iterate (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;

      procedure Process (Pattern : in String;
                         Route   : in Route_Type_Access) is
      begin
         T.Assert (Route /= null, "The route is null for " & Pattern);
         T.Assert (Route.all in Test_Route_Type'Class, "Invalid route for " & Pattern);

         Log.Info ("Route {0} to {1}", Pattern, Natural'Image (Test_Route_Type (Route.all).Index));
         T.Assert_Equals (Pattern, Path_Array (Test_Route_Type (Route.all).Index).all,
                          "Invalid route for " & Pattern);
      end Process;

   begin
      for I in Path_Array'Range loop
         Add_Route (T, Router, Path_Array (I).all, I, Bean);
      end loop;
      Router.Iterate (Process'Access);
   end Test_Iterate;

end ASF.Routes.Tests;

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

with Util.Measures;
with Util.Log.Loggers;
with Util.Test_Caller;

with EL.Contexts.Default;
package body ASF.Routes.Tests is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Routes.Tests");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (fixed path)",
                       Test_Add_Route_With_Path'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (:param path)",
                       Test_Add_Route_With_Param'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (*.ext path)",
                       Test_Add_Route_With_Ext'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (#{} path)",
                       Test_Add_Route_With_EL'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Iterate",
                       Test_Iterate'Access);
   end Add_Tests;

   overriding
   function Get_Value (Bean : in Test_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "id" then
         return Util.Beans.Objects.To_Object (Bean.Id);
      elsif Name = "name" then
         return Util.Beans.Objects.To_Object (Bean.Name);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   overriding
   procedure Set_Value (Bean  : in out Test_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" then
         Bean.Id := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "name" then
         Bean.Name := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Setup the test instance.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
   begin
      T.Bean := new Test_Bean;
      ASF.Tests.EL_Test (T).Set_Up;
      T.Root_Resolver.Register (Ada.Strings.Unbounded.To_Unbounded_String ("user"),
                                Util.Beans.Objects.To_Object (T.Bean.all'Access));
      for I in T.Routes'Range loop
         T.Routes (I).Index := I;
      end loop;
   end Set_Up;

   --  ------------------------------
   --  Verify that the path matches the given route.
   --  ------------------------------
   procedure Verify_Route (T      : in out Test;
                           Router : in out Router_Type;
                           Path   : in String;
                           Index  : in Positive;
                           Bean   : in out Test_Bean'Class) is
      Route   : constant Route_Type_Access := T.Routes (Index)'Unchecked_Access;
      R       : Route_Context_Type;
   begin
      Router.Find_Route (Path, R);
      declare
         P : constant String := Get_Path_Info (R);
      begin
         T.Assert_Equals (Path, P, "Add_Route + Find_Route with " & Path);
         T.Assert (Get_Route (R) /= null, "Get_Route returns a null route for " & Path);
         T.Assert (Get_Route (R) = Route, "Get_Route returns a wrong route for " & Path);

         --  Inject the path parameters in the bean instance.
         Inject_Parameters (R, Bean, T.ELContext.all);
      end;
   end Verify_Route;

   --  ------------------------------
   --  Add the route associted with the path pattern.
   --  ------------------------------
   procedure Add_Route (T      : in out Test;
                        Router : in out Router_Type;
                        Path   : in String;
                        Index  : in Positive;
                        Bean   : in out Test_Bean'Class) is
      Route   : constant Route_Type_Access := T.Routes (Index)'Unchecked_Access;
   begin
      Router.Add_Route (Path, Route, T.ELContext.all);
      Verify_Route (T, Router, Path, Index, Bean);
   end Add_Route;

   --  ------------------------------
   --  Test the Add_Route with simple fixed path components.
   --  Example: /list/index.html
   --  ------------------------------
   procedure Test_Add_Route_With_Path (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/page.html", 1, Bean);
      Add_Route (T, Router, "/list/page.html", 2, Bean);
      Add_Route (T, Router, "/list/index.html", 3, Bean);
      Add_Route (T, Router, "/view/page/content/index.html", 4, Bean);
      Add_Route (T, Router, "/list//page/view.html", 5, Bean);
      Add_Route (T, Router, "/list////page/content.html", 6, Bean);

      Verify_Route (T, Router, "/list/index.html", 3, Bean);
   end Test_Add_Route_With_Path;

   --  ------------------------------
   --  Test the Add_Route with extension mapping.
   --  Example: /list/*.html
   --  ------------------------------
   procedure Test_Add_Route_With_Ext (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/page.html", 1, Bean);
      Add_Route (T, Router, "/list/*.html", 2, Bean);
      Add_Route (T, Router, "/list/index.html", 3, Bean);
      Add_Route (T, Router, "/view/page/content/page1.html", 4, Bean);
      Add_Route (T, Router, "/view/page/content/page2.html", 5, Bean);
      Add_Route (T, Router, "/view/page/content/*.html", 6, Bean);

      --  Verify precedence and wildcard matching.
      Verify_Route (T, Router, "/list/index.html", 3, Bean);
      Verify_Route (T, Router, "/list/admin.html", 2, Bean);
      Verify_Route (T, Router, "/list/1/2/3/admin.html", 2, Bean);
      Verify_Route (T, Router, "/view/page/content/t.html", 6, Bean);
      Verify_Route (T, Router, "/view/page/content/1/t.html", 6, Bean);
      Verify_Route (T, Router, "/view/page/content/1/2/t.html", 6, Bean);
   end Test_Add_Route_With_Ext;

   --  ------------------------------
   --  Test the Add_Route with fixed path components and path parameters.
   --  Example: /users/:id/view.html
   --  ------------------------------
   procedure Test_Add_Route_With_Param (T : in out Test) is
      use Ada.Strings.Unbounded;

      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/users/:id/view.html", 1, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/users/:id/list.html", 2, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/users/:id/index.html", 3, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/view/page/content/index.html", 4, Bean);
      Add_Route (T, Router, "/list//page/view.html", 5, Bean);
      Add_Route (T, Router, "/list////page/content.html", 6, Bean);
      T.Assert_Equals ("", To_String (Bean.Id), "Bean injection failed for fixed path");

      Add_Route (T, Router, "/users/:id/:name/index.html", 7, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals (":name", To_String (Bean.Name), "Bean injection failed for :name");

      Add_Route (T, Router, "/users/list/index.html", 8, Bean);

      Verify_Route (T, Router, "/users/1234/view.html", 1, Bean);
      T.Assert_Equals ("1234", To_String (Bean.Id), "Bean injection failed for :id");

      Verify_Route (T, Router, "/users/234/567/index.html", 7, Bean);
      T.Assert_Equals ("234", To_String (Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals ("567", To_String (Bean.Name), "Bean injection failed for :name");

   end Test_Add_Route_With_Param;

   --  ------------------------------
   --  Test the Add_Route with fixed path components and EL path injection.
   --  Example: /users/#{user.id}/view.html
   --  ------------------------------
   procedure Test_Add_Route_With_EL (T : in out Test) is
            use Ada.Strings.Unbounded;

      Router  : Router_Type;
      Bean    : aliased Test_Bean;
   begin
      Add_Route (T, Router, "/users/#{user.id}", 1, Bean);
      Add_Route (T, Router, "/users/view.html", 2, Bean);
      Add_Route (T, Router, "/users/#{user.id}/#{user.name}/index.html", 3, Bean);
      Add_Route (T, Router, "/users/admin/#{user.id}/pages/#{user.name}", 4, Bean);

      --  Verify that the path parameters are injected in the 'user' bean (= T.Bean).
      Verify_Route (T, Router, "/users/234/567/index.html", 3, Bean);
      T.Assert_Equals ("234", To_String (T.Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals ("567", To_String (T.Bean.Name), "Bean injection failed for :name");

   end Test_Add_Route_With_EL;

   P_1 : aliased constant String := "/list/index.html";
   P_2 : aliased constant String := "/users/:id";
   P_3 : aliased constant String := "/users/:id/view";
   P_4 : aliased constant String := "/users/index.html";
   P_5 : aliased constant String := "/users/:id/:name";
   P_6 : aliased constant String := "/users/:id/:name/view.html";
   P_7 : aliased constant String := "/users/:id/list";
   P_8 : aliased constant String := "/users/test.html";
   P_9 : aliased constant String := "/admin/1/2/3/4/5/list.html";
   P_10 : aliased constant String := "/admin/*.html";
   P_11 : aliased constant String := "/admin/*.png";
   P_12 : aliased constant String := "/admin/*.jpg";
   P_13 : aliased constant String := "/users/:id/page/*.xml";
   P_14 : aliased constant String := "/*.jsf";

   type Const_String_Access is access constant String;

   type String_Array is array (Positive range <>) of Const_String_Access;

   Path_Array : constant String_Array :=
     (P_1'Access, P_2'Access, P_3'Access, P_4'Access,
      P_5'Access, P_6'Access, P_7'Access, P_8'Access,
      P_9'Access, P_10'Access, P_11'Access, P_12'Access,
      P_13'Access, P_14'Access);

   --  ------------------------------
   --  Test the Iterate over several paths.
   --  ------------------------------
   procedure Test_Iterate (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;

      procedure Process (Pattern : in String;
                         Route   : in Route_Type_Access) is
      begin
         T.Assert (Route /= null, "The route is null for " & Pattern);
         T.Assert (Route.all in Test_Route_Type'Class, "Invalid route for " & Pattern);

         Log.Info ("Route {0} to {1}", Pattern, Natural'Image (Test_Route_Type (Route.all).Index));
         T.Assert_Equals (Pattern, Path_Array (Test_Route_Type (Route.all).Index).all,
                          "Invalid route for " & Pattern);
      end Process;

   begin
      for I in Path_Array'Range loop
         Add_Route (T, Router, Path_Array (I).all, I, Bean);
      end loop;
      Router.Iterate (Process'Access);

      declare
         R  : Route_Context_Type;
         St : Util.Measures.Stamp;
      begin
         for I in 1 .. 1000 loop
            declare
               R : Route_Context_Type;
            begin
               Router.Find_Route ("/admin/1/2/3/4/5/list.html", R);
            end;
         end loop;
         Util.Measures.Report (St, "Find 1000 routes (fixed path)");
      end;

      declare
         R  : Route_Context_Type;
         St : Util.Measures.Stamp;
      begin
         for I in 1 .. 1000 loop
            declare
               R : Route_Context_Type;
            begin
               Router.Find_Route ("/admin/1/2/3/4/5/list.jsf", R);
            end;
         end loop;
         Util.Measures.Report (St, "Find 1000 routes (extension)");
      end;
   end Test_Iterate;

end ASF.Routes.Tests;

Add some performance tests for the ASF.Routes


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

with Util.Encoders.Base64;
package body Util.Streams.Buffered.Encoders is

   --  -----------------------
   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   --  -----------------------
   procedure Initialize (Stream  : in out Encoding_Stream;
                         Output  : access Output_Stream'Class;
                         Size    : in Natural;
                         Format  : in String) is
      pragma Unreferenced (Format);
   begin
      Stream.Initialize (Output, Size);
      Stream.Transform := new Util.Encoders.Base64.Encoder;
   end Initialize;

   --  -----------------------
   --  Close the sink.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Encoding_Stream) is
   begin
      Stream.Flush;
      Stream.Output.Close;
   end Close;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Write (Stream : in out Encoding_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      First_Encoded : Ada.Streams.Stream_Element_Offset := Buffer'First;
      Last_Encoded  : Ada.Streams.Stream_Element_Offset;
      Last_Pos      : Ada.Streams.Stream_Element_Offset;
   begin
      while First_Encoded <= Buffer'Last loop
         Stream.Transform.Transform
           (Data    => Buffer (First_Encoded .. Buffer'Last),
            Into    => Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
            Last    => Last_Pos,
            Encoded => Last_Encoded);
         if Last_Encoded < Buffer'Last then
            Stream.Output.Write (Stream.Buffer (Stream.Buffer'First .. Last_Pos));
            Stream.Write_Pos := Stream.Buffer'First;
         else
            Stream.Write_Pos := Last_Pos + 1;
         end if;
         First_Encoded := Last_Encoded + 1;
      end loop;
   end Write;

   --  -----------------------
   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   --  -----------------------
   overriding
   procedure Flush (Stream : in out Encoding_Stream) is
      Last_Pos : Ada.Streams.Stream_Element_Offset := Stream.Write_Pos - 1;
   begin
      Stream.Transform.Finish (Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
                               Last_Pos);
      Stream.Write_Pos := Last_Pos + 1;
      Output_Buffer_Stream (Stream).Flush;
   end Flush;

   --  -----------------------
   --  Flush the stream and release the buffer.
   --  -----------------------
   overriding
   procedure Finalize (Object : in out Encoding_Stream) is
   begin
      null;
   end Finalize;

end Util.Streams.Buffered.Encoders;

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

package body Util.Streams.Buffered.Encoders is

   --  -----------------------
   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   --  -----------------------
   overriding
   procedure Initialize (Stream  : in out Encoder_Stream;
                         Output  : access Output_Stream'Class;
                         Size    : in Positive) is
   begin
      Util.Streams.Buffered.Output_Buffer_Stream (Stream).Initialize (Output, Size);
   end Initialize;

   --  -----------------------
   --  Close the sink.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Encoder_Stream) is
   begin
      Stream.Flush;
      Stream.Output.Close;
   end Close;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Write (Stream : in out Encoder_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      First_Encoded : Ada.Streams.Stream_Element_Offset := Buffer'First;
      Last_Encoded  : Ada.Streams.Stream_Element_Offset;
      Last_Pos      : Ada.Streams.Stream_Element_Offset;
   begin
      while First_Encoded <= Buffer'Last loop
         Stream.Transform.Transform
           (Data    => Buffer (First_Encoded .. Buffer'Last),
            Into    => Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
            Last    => Last_Pos,
            Encoded => Last_Encoded);
         if Last_Encoded < Buffer'Last then
            Stream.Output.Write (Stream.Buffer (Stream.Buffer'First .. Last_Pos));
            Stream.Write_Pos := Stream.Buffer'First;
         else
            Stream.Write_Pos := Last_Pos;
         end if;
         First_Encoded := Last_Encoded + 1;
      end loop;
   end Write;

   --  -----------------------
   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   --  -----------------------
   overriding
   procedure Flush (Stream : in out Encoder_Stream) is
      Last_Pos : Ada.Streams.Stream_Element_Offset := Stream.Write_Pos - 1;
   begin
      Stream.Transform.Finish (Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
                               Last_Pos);
      Stream.Write_Pos := Last_Pos;
      Output_Buffer_Stream (Stream).Flush;
   end Flush;

end Util.Streams.Buffered.Encoders;

Change the package to a generic package Fix the Write and Flush operations


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

   use type AWA.Modules.Module_Access;

   --  ------------------------------
   --  Print the configuration identified by the given name.
   --  ------------------------------
   procedure Print (Command     : in out Command_Type;
                    Name        : in String;
                    Value       : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      pragma Unreferenced (Default);

      Pos   : Natural;
   begin
      Context.Console.Start_Row;
      Context.Console.Print_Field (1, Name);
      Pos := Value'First;
      while Pos <= Value'Last loop
         if Value'Last - Pos > Command.Value_Length then
            Context.Console.Print_Field (2, Value (Pos .. Pos + Command.Value_Length - 1));
            Pos := Pos + Command.Value_Length;
            Context.Console.End_Row;
            Context.Console.Start_Row;
            Context.Console.Print_Field (1, "");
         else
            Context.Console.Print_Field (2, Value (Pos .. Value'Last));
            Pos := Pos + Value'Length;
         end if;
      end loop;
      Context.Console.End_Row;
   end Print;

   procedure Print (Command     : in out Command_Type;
                    Application : in out AWA.Applications.Application'Class;
                    Name        : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      Value : constant String := Application.Get_Init_Parameter (Name, Default);
   begin
      Command.Print (Name, Value, Default, Context);
   end Print;

   procedure Print (Command     : in out Command_Type;
                    Module      : in AWA.Modules.Module'Class;
                    Name        : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      Value : constant String := Module.Get_Config (Name, Default);
   begin
      Command.Print (Module.Get_Name & "." & Name, Value, Default, Context);
   end Print;

   --  ------------------------------
   --  Print the configuration about the application.
   --  ------------------------------
   overriding
   procedure Execute (Command     : in out Command_Type;
                      Application : in out AWA.Applications.Application'Class;
                      Args        : in Argument_List'Class;
                      Context     : in out Context_Type) is
      pragma Unreferenced (Args);

      Module : AWA.Modules.Module_Access;
   begin
      if Command.Long_List then
         Command.Value_Length := Natural'Last;
      end if;
      Application.Load_Bundle (Name   => "commands",
                               Locale => "en",
                               Bundle => Command.Bundle);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Database configuration");
      Context.Console.Notice (N_INFO, "----------------------");

      Command.Print (Application, "database", "", Context);
      Command.Print (Application, "ado.queries.paths", "", Context);
      Command.Print (Application, "ado.queries.load", "", Context);
      Command.Print (Application, "ado.drivers.load", "", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Server faces configuration");
      Context.Console.Notice (N_INFO, "--------------------------");

      Command.Print (Application, "view.dir",
                     ASF.Applications.DEF_VIEW_DIR, Context);
      Command.Print (Application, "view.escape_unknown_tags",
                     ASF.Applications.DEF_ESCAPE_UNKNOWN_TAGS, Context);
      Command.Print (Application, "view.ext",
                     ASF.Applications.DEF_VIEW_EXT, Context);
      Command.Print (Application, "view.file_ext",
                     ASF.Applications.DEF_VIEW_FILE_EXT, Context);
      Command.Print (Application, "view.ignore_spaces",
                     ASF.Applications.DEF_IGNORE_WHITE_SPACES, Context);
      Command.Print (Application, "view.ignore_empty_lines",
                     ASF.Applications.DEF_IGNORE_EMPTY_LINES, Context);
      Command.Print (Application, "view.static.dir",
                     ASF.Applications.DEF_STATIC_DIR, Context);
      Command.Print (Application, "bundle.dir", "bundles", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "AWA Application");
      Context.Console.Notice (N_INFO, "--------------------------");
      Command.Print (Application, "app_name", "", Context);
      Command.Print (Application, "app_search_dirs", ".", Context);
      Command.Print (Application, "app.modules.dir", "", Context);
      Command.Print (Application, "app_url_base", "", Context);
      Command.Print (Application, "awa_url_host", "", Context);
      Command.Print (Application, "awa_url_port", "", Context);
      Command.Print (Application, "awa_url_scheme", "", Context);
      Command.Print (Application, "app.config", "awa.xml", Context);
      Command.Print (Application, "app.config.plugins", "", Context);
      Command.Print (Application, "contextPath", "", Context);
      Command.Print (Application, "awa_dispatcher_count", "", Context);
      Command.Print (Application, "awa_dispatcher_priority", "", Context);

      Module := Application.Find_Module ("users");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Users Module");
         Context.Console.Notice (N_INFO, "------------");
         Command.Print (Application, "openid.realm", "", Context);
         Command.Print (Application, "openid.callback_url", "", Context);
         Command.Print (Application, "openid.success_url", "", Context);
         Command.Print (Application, "auth.url.orange", "", Context);
         Command.Print (Application, "auth.provider.orange", "", Context);
         Command.Print (Application, "auth.url.yahoo", "", Context);
         Command.Print (Application, "auth.provider.yahoo", "", Context);
         Command.Print (Application, "auth.url.google", "", Context);
         Command.Print (Application, "auth.provider.google", "", Context);
         Command.Print (Application, "auth.url.facebook", "", Context);
         Command.Print (Application, "auth.provider.facebook", "", Context);
         Command.Print (Application, "auth.url.google-plus", "", Context);
         Command.Print (Application, "auth.provider.google-plus", "", Context);
         Command.Print (Application, "facebook.callback_url", "", Context);
         Command.Print (Application, "facebook.request_url", "", Context);
         Command.Print (Application, "facebook.scope", "", Context);
         Command.Print (Application, "facebook.client_id", "", Context);
         Command.Print (Application, "facebook.secret", "", Context);
         Command.Print (Application, "google-plus.issuer", "", Context);
         Command.Print (Application, "google-plus.callback_url", "", Context);
         Command.Print (Application, "google-plus.request_url", "", Context);
         Command.Print (Application, "google-plus.scope", "", Context);
         Command.Print (Application, "google-plus.client_id", "", Context);
         Command.Print (Application, "google-plus.secret", "", Context);
         Command.Print (Application, "auth-filter.redirect", "", Context);
         Command.Print (Application, "verify-filter.redirect", "", Context);
         Command.Print (Application, "users.auth_key", "", Context);
         Command.Print (Application, "users.server_id", "", Context);
      end if;

      Module := Application.Find_Module ("mail");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Mail Module");
         Context.Console.Notice (N_INFO, "-----------");
         Command.Print (Application, "mail.smtp.host", "", Context);
         Command.Print (Application, "mail.smtp.port", "", Context);
         Command.Print (Application, "mail.smtp.enable", "true", Context);
         Command.Print (Application, "mail.mailer", "smtp", Context);
         Command.Print (Application, "mail.file.maildir", "mail", Context);
         Command.Print (Application, "app_mail_name", "", Context);
         Command.Print (Application, "app_mail_from", "", Context);
      end if;

      Module := Application.Find_Module ("workspaces");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Workspace Module");
         Context.Console.Notice (N_INFO, "----------------");
         Command.Print (Module.all, "permissions_list", "", Context);
         Command.Print (Module.all, "allow_workspace_create", "", Context);
      end if;

      Module := Application.Find_Module ("storages");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Storage Module");
         Context.Console.Notice (N_INFO, "--------------------------");
         Command.Print (Module.all, "database_max_size", "100000", Context);
         Command.Print (Module.all, "storage_root", "storage", Context);
         Command.Print (Module.all, "tmp_storage_root", "tmp", Context);
         Module := Application.Find_Module ("images");
         if Module /= null then
            Command.Print (Module.all, "thumbnail_command", "", Context);
         end if;
      end if;

      Module := Application.Find_Module ("wikis");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Wiki Module");
         Context.Console.Notice (N_INFO, "-----------");
         Command.Print (Module.all, "image_prefix", "", Context);
         Command.Print (Module.all, "page_prefix", "", Context);
         Command.Print (Module.all, "wiki_copy_list", "", Context);
         Module := Application.Find_Module ("wiki_previews");
         if Module /= null then
            Command.Print (Module.all, "wiki_preview_tmp", "tmp", Context);
            Command.Print (Module.all, "wiki_preview_dir", "web/preview", Context);
            Command.Print (Module.all, "wiki_preview_template", "", Context);
            Command.Print (Module.all, "wiki_preview_html", "", Context);
            Command.Print (Module.all, "wiki_preview_command", "", Context);
         end if;
      end if;

      Module := Application.Find_Module ("counters");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Counter Module");
         Context.Console.Notice (N_INFO, "--------------");
         Command.Print (Module.all, "counter_age_limit", "300", Context);
         Command.Print (Module.all, "counter_limit", "1000", Context);
      end if;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Set_Usage (Config => Config,
                    Usage  => Command.Get_Name & " [arguments]",
                    Help   => Command.Get_Description);
      Command_Drivers.Application_Command_Type (Command).Setup (Config, Context);
      GC.Define_Switch (Config => Config,
                        Output => Command.Long_List'Access,
                        Switch => "-l",
                        Long_Switch => "--long-lines",
                        Help   => -("Use long lines to print configuration values"));
   end Setup;

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

begin
   Command_Drivers.Driver.Add_Command ("info",
                                       -("report configuration information"),
                                       Command'Access);
end AWA.Commands.Info;

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

   use type AWA.Modules.Module_Access;

   --  ------------------------------
   --  Print the configuration identified by the given name.
   --  ------------------------------
   procedure Print (Command     : in out Command_Type;
                    Name        : in String;
                    Value       : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      pragma Unreferenced (Default);

      Pos   : Natural;
   begin
      Context.Console.Start_Row;
      Context.Console.Print_Field (1, Name);
      Pos := Value'First;
      while Pos <= Value'Last loop
         if Value'Last - Pos > Command.Value_Length then
            Context.Console.Print_Field (2, Value (Pos .. Pos + Command.Value_Length - 1));
            Pos := Pos + Command.Value_Length;
            Context.Console.End_Row;
            Context.Console.Start_Row;
            Context.Console.Print_Field (1, "");
         else
            Context.Console.Print_Field (2, Value (Pos .. Value'Last));
            Pos := Pos + Value'Length;
         end if;
      end loop;
      Context.Console.End_Row;
   end Print;

   procedure Print (Command     : in out Command_Type;
                    Application : in out AWA.Applications.Application'Class;
                    Name        : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      Value : constant String := Application.Get_Init_Parameter (Name, Default);
   begin
      Command.Print (Name, Value, Default, Context);
   end Print;

   procedure Print (Command     : in out Command_Type;
                    Module      : in AWA.Modules.Module'Class;
                    Name        : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      Value : constant String := Module.Get_Config (Name, Default);
   begin
      Command.Print (Module.Get_Name & "." & Name, Value, Default, Context);
   end Print;

   --  ------------------------------
   --  Print the configuration about the application.
   --  ------------------------------
   overriding
   procedure Execute (Command     : in out Command_Type;
                      Application : in out AWA.Applications.Application'Class;
                      Args        : in Argument_List'Class;
                      Context     : in out Context_Type) is
      pragma Unreferenced (Args);

      Module : AWA.Modules.Module_Access;
   begin
      if Command.Long_List then
         Command.Value_Length := Natural'Last;
      end if;
      Application.Load_Bundle (Name   => "commands",
                               Locale => "en",
                               Bundle => Command.Bundle);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Database configuration");
      Context.Console.Notice (N_INFO, "----------------------");

      Command.Print (Application, "database", "", Context);
      Command.Print (Application, "ado.queries.paths", "", Context);
      Command.Print (Application, "ado.queries.load", "", Context);
      Command.Print (Application, "ado.drivers.load", "", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Server faces configuration");
      Context.Console.Notice (N_INFO, "--------------------------");

      Command.Print (Application, "view.dir",
                     ASF.Applications.DEF_VIEW_DIR, Context);
      Command.Print (Application, "view.escape_unknown_tags",
                     ASF.Applications.DEF_ESCAPE_UNKNOWN_TAGS, Context);
      Command.Print (Application, "view.ext",
                     ASF.Applications.DEF_VIEW_EXT, Context);
      Command.Print (Application, "view.file_ext",
                     ASF.Applications.DEF_VIEW_FILE_EXT, Context);
      Command.Print (Application, "view.ignore_spaces",
                     ASF.Applications.DEF_IGNORE_WHITE_SPACES, Context);
      Command.Print (Application, "view.ignore_empty_lines",
                     ASF.Applications.DEF_IGNORE_EMPTY_LINES, Context);
      Command.Print (Application, "view.static.dir",
                     ASF.Applications.DEF_STATIC_DIR, Context);
      Command.Print (Application, "bundle.dir", "bundles", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "AWA Application");
      Context.Console.Notice (N_INFO, "--------------------------");
      Command.Print (Application, "app_name", "", Context);
      Command.Print (Application, "app_search_dirs", ".", Context);
      Command.Print (Application, "app.modules.dir", "", Context);
      Command.Print (Application, "app_url_base", "", Context);
      Command.Print (Application, "awa_url_host", "", Context);
      Command.Print (Application, "awa_url_port", "", Context);
      Command.Print (Application, "awa_url_scheme", "", Context);
      Command.Print (Application, "app.config", "awa.xml", Context);
      Command.Print (Application, "app.config.plugins", "", Context);
      Command.Print (Application, "contextPath", "", Context);
      Command.Print (Application, "awa_dispatcher_count", "", Context);
      Command.Print (Application, "awa_dispatcher_priority", "", Context);

      Module := Application.Find_Module ("users");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Users Module");
         Context.Console.Notice (N_INFO, "------------");
         Command.Print (Application, "app_login_register", "", Context);
         Command.Print (Application, "app_login_email", "", Context);
         Command.Print (Application, "app_login_openid", "", Context);
         Command.Print (Application, "app_login_methods", "", Context);
         Command.Print (Application, "openid.realm", "", Context);
         Command.Print (Application, "openid.callback_url", "", Context);
         Command.Print (Application, "openid.success_url", "", Context);
         Command.Print (Application, "auth.url.orange", "", Context);
         Command.Print (Application, "auth.provider.orange", "", Context);
         Command.Print (Application, "auth.url.yahoo", "", Context);
         Command.Print (Application, "auth.provider.yahoo", "", Context);
         Command.Print (Application, "auth.url.google", "", Context);
         Command.Print (Application, "auth.provider.google", "", Context);
         Command.Print (Application, "auth.url.facebook", "", Context);
         Command.Print (Application, "auth.provider.facebook", "", Context);
         Command.Print (Application, "auth.url.google-plus", "", Context);
         Command.Print (Application, "auth.provider.google-plus", "", Context);
         Command.Print (Application, "facebook.callback_url", "", Context);
         Command.Print (Application, "facebook.request_url", "", Context);
         Command.Print (Application, "facebook.scope", "", Context);
         Command.Print (Application, "facebook.client_id", "", Context);
         Command.Print (Application, "facebook.secret", "", Context);
         Command.Print (Application, "google-plus.issuer", "", Context);
         Command.Print (Application, "google-plus.callback_url", "", Context);
         Command.Print (Application, "google-plus.request_url", "", Context);
         Command.Print (Application, "google-plus.scope", "", Context);
         Command.Print (Application, "google-plus.client_id", "", Context);
         Command.Print (Application, "google-plus.secret", "", Context);
         Command.Print (Application, "auth-filter.redirect", "", Context);
         Command.Print (Application, "verify-filter.redirect", "", Context);
         Command.Print (Application, "users.auth_key", "", Context);
         Command.Print (Application, "users.server_id", "", Context);
      end if;

      Module := Application.Find_Module ("mail");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Mail Module");
         Context.Console.Notice (N_INFO, "-----------");
         Command.Print (Application, "mail.smtp.host", "", Context);
         Command.Print (Application, "mail.smtp.port", "", Context);
         Command.Print (Application, "mail.smtp.enable", "true", Context);
         Command.Print (Application, "mail.mailer", "smtp", Context);
         Command.Print (Application, "mail.file.maildir", "mail", Context);
         Command.Print (Application, "app_mail_name", "", Context);
         Command.Print (Application, "app_mail_from", "", Context);
      end if;

      Module := Application.Find_Module ("workspaces");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Workspace Module");
         Context.Console.Notice (N_INFO, "----------------");
         Command.Print (Module.all, "permissions_list", "", Context);
         Command.Print (Module.all, "allow_workspace_create", "", Context);
      end if;

      Module := Application.Find_Module ("storages");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Storage Module");
         Context.Console.Notice (N_INFO, "--------------------------");
         Command.Print (Module.all, "database_max_size", "100000", Context);
         Command.Print (Module.all, "storage_root", "storage", Context);
         Command.Print (Module.all, "tmp_storage_root", "tmp", Context);
         Module := Application.Find_Module ("images");
         if Module /= null then
            Command.Print (Module.all, "thumbnail_command", "", Context);
         end if;
      end if;

      Module := Application.Find_Module ("wikis");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Wiki Module");
         Context.Console.Notice (N_INFO, "-----------");
         Command.Print (Module.all, "image_prefix", "", Context);
         Command.Print (Module.all, "page_prefix", "", Context);
         Command.Print (Module.all, "wiki_copy_list", "", Context);
         Module := Application.Find_Module ("wiki_previews");
         if Module /= null then
            Command.Print (Module.all, "wiki_preview_tmp", "tmp", Context);
            Command.Print (Module.all, "wiki_preview_dir", "web/preview", Context);
            Command.Print (Module.all, "wiki_preview_template", "", Context);
            Command.Print (Module.all, "wiki_preview_html", "", Context);
            Command.Print (Module.all, "wiki_preview_command", "", Context);
         end if;
      end if;

      Module := Application.Find_Module ("counters");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Counter Module");
         Context.Console.Notice (N_INFO, "--------------");
         Command.Print (Module.all, "counter_age_limit", "300", Context);
         Command.Print (Module.all, "counter_limit", "1000", Context);
      end if;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Set_Usage (Config => Config,
                    Usage  => Command.Get_Name & " [arguments]",
                    Help   => Command.Get_Description);
      Command_Drivers.Application_Command_Type (Command).Setup (Config, Context);
      GC.Define_Switch (Config => Config,
                        Output => Command.Long_List'Access,
                        Switch => "-l",
                        Long_Switch => "--long-lines",
                        Help   => -("Use long lines to print configuration values"));
   end Setup;

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

begin
   Command_Drivers.Driver.Add_Command ("info",
                                       -("report configuration information"),
                                       Command'Access);
end AWA.Commands.Info;

Add information about app_login_* parameters


-----------------------------------------------------------------------
--  awa-storages-services-tests -- Unit tests for storage service
--  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 Ada.Streams;

with Util.Test_Caller;

with ADO;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Storages.Modules;
with AWA.Tests.Helpers.Users;
package body AWA.Storages.Services.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Storages.Services");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save",
                       Test_Create_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Delete",
                       Test_Delete_Storage'Access);

   end Add_Tests;

   --  ------------------------------
   --  Save something in a storage element and keep track of the store id in the test Id.
   --  ------------------------------
   procedure Save (T : in out Test) is
      Store     : AWA.Storages.Models.Storage_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      T.Manager.Save (Into => Store,
                      Path => "Makefile");
      T.Assert (not Store.Is_Null, "Storage object should not be null");
      T.Id := Store.Get_Id;
      T.Assert (T.Id > 0, "Invalid storage identifier");
   end Save;

   --  ------------------------------
   --  Load the storage element refered to by the test Id.
   --  ------------------------------
   procedure Load (T : in out Test) is
      use type Ada.Streams.Stream_Element_Offset;

      Data      : ADO.Blob_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      T.Manager.Load (From => T.Id, Into => Data);
      T.Assert (not Data.Is_Null, "Null blob returned by load");
      T.Assert (Data.Value.Len > 100, "Invalid length for the blob data");
   end Load;

   --  ------------------------------
   --  Test creation of a storage object
   --  ------------------------------
   procedure Test_Create_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Load;
   end Test_Create_Storage;

   --  ------------------------------
   --  Test deletion of a storage object
   --  ------------------------------
   procedure Test_Delete_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Data      : ADO.Blob_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Manager.Delete (T.Id);
      T.Manager.Load (From => T.Id, Into => Data);
      T.Assert (Data.Is_Null, "A non null blob returned by load");
   end Test_Delete_Storage;

end AWA.Storages.Services.Tests;

-----------------------------------------------------------------------
--  awa-storages-services-tests -- Unit tests for storage service
--  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 Ada.Streams;

with Util.Test_Caller;

with ADO;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Storages.Modules;
with AWA.Tests.Helpers.Users;
package body AWA.Storages.Services.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Storages.Services");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save",
                       Test_Create_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Delete",
                       Test_Delete_Storage'Access);

   end Add_Tests;

   --  ------------------------------
   --  Save something in a storage element and keep track of the store id in the test Id.
   --  ------------------------------
   procedure Save (T : in out Test) is
      Store     : AWA.Storages.Models.Storage_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      T.Manager.Save (Into    => Store,
                      Path    => "Makefile",
                      Storage => AWA.Storages.Models.DATABASE);
      T.Assert (not Store.Is_Null, "Storage object should not be null");
      T.Id := Store.Get_Id;
      T.Assert (T.Id > 0, "Invalid storage identifier");
   end Save;

   --  ------------------------------
   --  Load the storage element refered to by the test Id.
   --  ------------------------------
   procedure Load (T : in out Test) is
      use type Ada.Streams.Stream_Element_Offset;

      Data      : ADO.Blob_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      T.Manager.Load (From => T.Id, Into => Data);
      T.Assert (not Data.Is_Null, "Null blob returned by load");
      T.Assert (Data.Value.Len > 100, "Invalid length for the blob data");
   end Load;

   --  ------------------------------
   --  Test creation of a storage object
   --  ------------------------------
   procedure Test_Create_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Load;
   end Test_Create_Storage;

   --  ------------------------------
   --  Test deletion of a storage object
   --  ------------------------------
   procedure Test_Delete_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Data      : ADO.Blob_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Manager.Delete (T.Id);
      T.Manager.Load (From => T.Id, Into => Data);
      T.Assert (Data.Is_Null, "A non null blob returned by load");
   end Test_Delete_Storage;

end AWA.Storages.Services.Tests;

Update the unit test

Update the unit test