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

with DOM.Core;
with Gen.Model.Packages;
with Gen.Model.XMI;
with Util.Strings.Sets;

--  The Gen.Artifacts.XMI package is an artifact for the generation of Ada code
--  from an UML XMI description.
package Gen.Artifacts.XMI is

   --  ------------------------------
   --  UML XMI artifact
   --  ------------------------------
   type Artifact is new Gen.Artifacts.Artifact with private;

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   overriding
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class);

   --  Read the UML/XMI model file.
   procedure Read_Model (Handler       : in out Artifact;
                         File          : in String;
                         Context       : in out Generator'Class;
                         Is_Predefined : in Boolean := False);

private

   --  Read the UML profiles that are referenced by the current models.
   --  The UML profiles are installed in the UML config directory for dynamo's installation.
   procedure Read_Profiles (Handler : in out Artifact;
                            Context : in out Generator'Class);

   type Artifact is new Gen.Artifacts.Artifact with record
      Nodes      : aliased Gen.Model.XMI.UML_Model;

      --  A set of profiles that are necessary for the model definitions.
      Profiles   : aliased Util.Strings.Sets.Set;

      Has_Config : Boolean := False;

      --  Stereotype which triggers the generation of database table.
      Table_Stereotype      : Gen.Model.XMI.Stereotype_Element_Access;
      PK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      FK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      Data_Model_Stereotype : Gen.Model.XMI.Stereotype_Element_Access;
      Nullable_Stereotype   : Gen.Model.XMI.Stereotype_Element_Access;
      Not_Null_Stereotype   : Gen.Model.XMI.Stereotype_Element_Access;
      Use_FK_Stereotype     : Gen.Model.XMI.Stereotype_Element_Access;
      Version_Stereotype    : Gen.Model.XMI.Stereotype_Element_Access;

      --  Tag definitions which control the generation.
      Has_List_Tag          : Gen.Model.XMI.Tag_Definition_Element_Access;
      Table_Name_Tag        : Gen.Model.XMI.Tag_Definition_Element_Access;
      Sql_Type_Tag          : Gen.Model.XMI.Tag_Definition_Element_Access;
      Generator_Tag         : Gen.Model.XMI.Tag_Definition_Element_Access;
      Literal_Tag           : Gen.Model.XMI.Tag_Definition_Element_Access;
      Sql_Length_Tag        : Gen.Model.XMI.Tag_Definition_Element_Access;

      --  Stereotype which triggers the generation of AWA bean types.
      Bean_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      Limited_Bean_Stereotype : Gen.Model.XMI.Stereotype_Element_Access;

      --  Stereotype which triggers the generation of serialization.
      Serialize_Stereotype    : Gen.Model.XMI.Stereotype_Element_Access;
   end record;

end Gen.Artifacts.XMI;

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

with DOM.Core;
with Gen.Model.Packages;
with Gen.Model.XMI;
with Util.Strings.Sets;

--  The Gen.Artifacts.XMI package is an artifact for the generation of Ada code
--  from an UML XMI description.
package Gen.Artifacts.XMI is

   --  ------------------------------
   --  UML XMI artifact
   --  ------------------------------
   type Artifact is new Gen.Artifacts.Artifact with private;

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   overriding
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class);

   --  Read the UML/XMI model file.
   procedure Read_Model (Handler       : in out Artifact;
                         File          : in String;
                         Context       : in out Generator'Class;
                         Is_Predefined : in Boolean := False);

private

   --  Read the UML profiles that are referenced by the current models.
   --  The UML profiles are installed in the UML config directory for dynamo's installation.
   procedure Read_Profiles (Handler : in out Artifact;
                            Context : in out Generator'Class);

   type Artifact is new Gen.Artifacts.Artifact with record
      Nodes      : aliased Gen.Model.XMI.UML_Model;

      --  A set of profiles that are necessary for the model definitions.
      Profiles   : aliased Util.Strings.Sets.Set;

      Has_Config : Boolean := False;

      --  Stereotype which triggers the generation of database table.
      Table_Stereotype      : Gen.Model.XMI.Stereotype_Element_Access;
      PK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      FK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      Data_Model_Stereotype : Gen.Model.XMI.Stereotype_Element_Access;
      Nullable_Stereotype   : Gen.Model.XMI.Stereotype_Element_Access;
      Not_Null_Stereotype   : Gen.Model.XMI.Stereotype_Element_Access;
      Use_FK_Stereotype     : Gen.Model.XMI.Stereotype_Element_Access;
      Version_Stereotype    : Gen.Model.XMI.Stereotype_Element_Access;
      Auditable_Stereotype  : Gen.Model.XMI.Stereotype_Element_Access;

      --  Tag definitions which control the generation.
      Has_List_Tag          : Gen.Model.XMI.Tag_Definition_Element_Access;
      Table_Name_Tag        : Gen.Model.XMI.Tag_Definition_Element_Access;
      Sql_Type_Tag          : Gen.Model.XMI.Tag_Definition_Element_Access;
      Generator_Tag         : Gen.Model.XMI.Tag_Definition_Element_Access;
      Literal_Tag           : Gen.Model.XMI.Tag_Definition_Element_Access;
      Sql_Length_Tag        : Gen.Model.XMI.Tag_Definition_Element_Access;

      --  Stereotype which triggers the generation of AWA bean types.
      Bean_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      Limited_Bean_Stereotype : Gen.Model.XMI.Stereotype_Element_Access;

      --  Stereotype which triggers the generation of serialization.
      Serialize_Stereotype    : Gen.Model.XMI.Stereotype_Element_Access;
   end record;

end Gen.Artifacts.XMI;

Add the Auditable_Stereotype member to the Artifact type


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

with ADO.Sequences;
with ADO.Caches;
with ADO.Sessions.Sources;

--  == Session Factory ==
--  The session factory is the entry point to obtain a database session.
--  The `ADO.Sessions.Factory` package defines the factory for creating
--  sessions.
--
--    with ADO.Sessions.Factory;
--    ...
--    Sess_Factory : ADO.Sessions.Factory;
--
--  The session factory can be initialized by using the `Create` operation and
--  by giving a URI string that identifies the driver and the information to connect
--  to the database.  The session factory is created only once when the application starts.
--
--    ADO.Sessions.Factory.Create (Sess_Factory, "mysql://localhost:3306/ado_test?user=test");
--
--  Having a session factory, one can get a database by using the `Get_Session` or
--  `Get_Master_Session` function.  Each time this operation is called, a new session
--  is returned.  The session is released when the session variable is finalized.
--
--    DB : ADO.Sessions.Session := Sess_Factory.Get_Session;
--
--  The session factory is also responsible for maintaining some data that is shared by
--  all the database connections.  This includes:
--
--    * the sequence generators used to allocate unique identifiers for database tables,
--    * the entity cache,
--    * some application specific global cache.
--
package ADO.Sessions.Factory is

   pragma Elaborate_Body;

   ENTITY_CACHE_NAME : constant String := "entity_type";

   --  ------------------------------
   --  Session factory
   --  ------------------------------
   type Session_Factory is tagged limited private;
   type Session_Factory_Access is access all Session_Factory'Class;

   --  Get a read-only session from the factory.
   function Get_Session (Factory : in Session_Factory) return Session;

   --  Get a read-write session from the factory.
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session;

   --  Open a session
   procedure Open_Session (Factory : in out Session_Factory;
                           Database : out Session);

   --  Open a session
   procedure Open_Session (Factory : in Session_Factory;
                           Database : out Master_Session);

   --  Create the session factory to connect to the database represented
   --  by the data source.
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Sessions.Sources.Data_Source);

   --  Create the session factory to connect to the database identified
   --  by the URI.
   procedure Create (Factory : out Session_Factory;
                     URI     : in String);

   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the SESSION_EXPIRED exception.
   function Get_Session (Proxy : in Session_Record_Access) return Session;
private

   --  The session factory holds the necessary information to obtain a master or slave
   --  database connection.  The sequence factory is shared by all sessions of the same
   --  factory (implementation is thread-safe).  The factory also contains the entity type
   --  cache which is initialized when the factory is created.
   type Session_Factory is tagged limited record
      Source       : ADO.Sessions.Sources.Data_Source;
      Sequences    : Factory_Access := null;
      Seq_Factory  : aliased ADO.Sequences.Factory;
      --  Entity_Cache : aliased ADO.Schemas.Entities.Entity_Cache;
      Entities     : ADO.Sessions.Entity_Cache_Access := null;
      Cache        : aliased ADO.Caches.Cache_Manager;
      Cache_Values : ADO.Caches.Cache_Manager_Access;
   end record;

   --  Initialize the sequence factory associated with the session factory.
   procedure Initialize_Sequences (Factory : in out Session_Factory);

end ADO.Sessions.Factory;

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

with ADO.Sequences;
with ADO.Caches;
with ADO.Sessions.Sources;

--  == Session Factory ==
--  The session factory is the entry point to obtain a database session.
--  The `ADO.Sessions.Factory` package defines the factory for creating
--  sessions.
--
--    with ADO.Sessions.Factory;
--    ...
--    Sess_Factory : ADO.Sessions.Factory;
--
--  The session factory can be initialized by using the `Create` operation and
--  by giving a URI string that identifies the driver and the information to connect
--  to the database.  The session factory is created only once when the application starts.
--
--    ADO.Sessions.Factory.Create (Sess_Factory, "mysql://localhost:3306/ado_test?user=test");
--
--  Having a session factory, one can get a database by using the `Get_Session` or
--  `Get_Master_Session` function.  Each time this operation is called, a new session
--  is returned.  The session is released when the session variable is finalized.
--
--    DB : ADO.Sessions.Session := Sess_Factory.Get_Session;
--
--  The session factory is also responsible for maintaining some data that is shared by
--  all the database connections.  This includes:
--
--    * the sequence generators used to allocate unique identifiers for database tables,
--    * the entity cache,
--    * some application specific global cache.
--
package ADO.Sessions.Factory is

   pragma Elaborate_Body;

   ENTITY_CACHE_NAME : constant String := "entity_type";

   --  ------------------------------
   --  Session factory
   --  ------------------------------
   type Session_Factory is tagged limited private;
   type Session_Factory_Access is access all Session_Factory'Class;

   --  Get a read-only session from the factory.
   function Get_Session (Factory : in Session_Factory) return Session;

   --  Get a read-write session from the factory.
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session;

   --  Open a session
   procedure Open_Session (Factory : in out Session_Factory;
                           Database : out Session);

   --  Open a session
   procedure Open_Session (Factory : in Session_Factory;
                           Database : out Master_Session);

   --  Create the session factory to connect to the database represented
   --  by the data source.
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Sessions.Sources.Data_Source);

   --  Create the session factory to connect to the database identified
   --  by the URI.
   procedure Create (Factory : out Session_Factory;
                     URI     : in String);

   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the SESSION_EXPIRED exception.
   function Get_Session (Proxy : in Session_Record_Access) return Session;
private

   --  The session factory holds the necessary information to obtain a master or slave
   --  database connection.  The sequence factory is shared by all sessions of the same
   --  factory (implementation is thread-safe).  The factory also contains the entity type
   --  cache which is initialized when the factory is created.
   type Session_Factory is tagged limited record
      Source       : ADO.Sessions.Sources.Data_Source;
      Sequences    : Factory_Access := null;
      Seq_Factory  : aliased ADO.Sequences.Factory;
      --  Entity_Cache : aliased ADO.Schemas.Entities.Entity_Cache;
      Entities     : ADO.Sessions.Entity_Cache_Access := null;
      Cache        : aliased ADO.Caches.Cache_Manager;
      Cache_Values : ADO.Caches.Cache_Manager_Access;
      Queries      : ADO.Queries.Query_Manager_Access;
   end record;

   --  Initialize the sequence factory associated with the session factory.
   procedure Initialize_Sequences (Factory : in out Session_Factory);

end ADO.Sessions.Factory;

Add a Queries member to the session factory to get access to the query manager


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

with Util.Streams.Texts;
with Util.Streams.Buffered;
with Util.Serialize.Mappers.Record_Mapper;
package body Util.Serialize.Tools is

   type Object_Field is (FIELD_NAME, FIELD_VALUE);
   type Object_Map_Access is access all Util.Beans.Objects.Maps.Map'Class;

   type Object_Mapper_Context is record
      Map  : Object_Map_Access;
      Name : Util.Beans.Objects.Object;
   end record;
   type Object_Mapper_Context_Access is access all Object_Mapper_Context;

   procedure Set_Member (Into  : in out Object_Mapper_Context;
                         Field : in Object_Field;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (Into  : in out Object_Mapper_Context;
                         Field : in Object_Field;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_VALUE =>
            Into.Map.Include (Util.Beans.Objects.To_String (Into.Name), Value);
            Into.Name := Util.Beans.Objects.Null_Object;

      end case;
   end Set_Member;

   package Object_Mapper is new
     Util.Serialize.Mappers.Record_Mapper (Element_Type        => Object_Mapper_Context,
                                           Element_Type_Access => Object_Mapper_Context_Access,
                                           Fields              => Object_Field,
                                           Set_Member          => Set_Member);

   JSON_Mapping : aliased Object_Mapper.Mapper;

   --  -----------------------
   --  Serialize the objects defined in the object map Map into the Output
   --  JSON stream.  Use the Name as the name of the JSON object.
   --  -----------------------
   procedure To_JSON (Output : in out Util.Serialize.IO.JSON.Output_Stream'Class;
                      Name   : in String;
                      Map    : in Util.Beans.Objects.Maps.Map) is
      use type Ada.Containers.Count_Type;

      procedure Write (Name  : in String;
                       Value : in Util.Beans.Objects.Object);

      procedure Write (Name  : in String;
                       Value : in Util.Beans.Objects.Object) is
      begin
         Output.Start_Entity (Name => "");
         Output.Write_Attribute (Name  => "name",
                                 Value => Util.Beans.Objects.To_Object (Name));
         Output.Write_Attribute (Name  => "value",
                                 Value => Value);
         Output.End_Entity (Name => "");
      end Write;

   begin
      if Map.Length > 0 then
         declare
            Iter : Util.Beans.Objects.Maps.Cursor := Map.First;
         begin
            Output.Start_Array (Name => Name);
            while Util.Beans.Objects.Maps.Has_Element (Iter) loop
               Util.Beans.Objects.Maps.Query_Element (Iter, Write'Access);
               Util.Beans.Objects.Maps.Next (Iter);
            end loop;
            Output.End_Array (Name => Name);
         end;
      end if;
   end To_JSON;

   --  -----------------------
   --  Serialize the objects defined in the object map Map into an XML stream.
   --  Returns the JSON string that contains a serialization of the object maps.
   --  -----------------------
   function To_JSON (Map : in Util.Beans.Objects.Maps.Map) return String is
      use type Ada.Containers.Count_Type;
   begin
      if Map.Length = 0 then
         return "";
      end if;
      declare
         Buffer : aliased Util.Streams.Texts.Print_Stream;
         Output : Util.Serialize.IO.JSON.Output_Stream;
      begin
         Buffer.Initialize (Size => 10000);
         Output.Initialize (Buffer'Unchecked_Access);
         Output.Start_Document;
         To_JSON (Output, "params", Map);
         Output.End_Document;
         return Util.Streams.Texts.To_String (Util.Streams.Buffered.Buffered_Stream (Buffer));
      end;
   end To_JSON;

   --  -----------------------
   --  Deserializes the JSON content passed in Content and restore the object map
   --  with their values.  The object map passed in Map can contain existing values.
   --  They will be overriden by the JSON values.
   --  -----------------------
   procedure From_JSON (Content : in String;
                        Map     : in out Util.Beans.Objects.Maps.Map) is
      Parser  : Util.Serialize.IO.JSON.Parser;
      Context : aliased Object_Mapper_Context;
   begin
      if Content'Length > 0 then
         Context.Map := Map'Unchecked_Access;
         Parser.Add_Mapping ("/params", JSON_Mapping'Access);
         Object_Mapper.Set_Context (Parser, Context'Unchecked_Access);
         Parser.Parse_String (Content);
      end if;
   end From_JSON;

   --  -----------------------
   --  Deserializes the JSON content passed in Content and restore the object map
   --  with their values.
   --  Returns the object map that was restored.
   --  -----------------------
   function From_JSON (Content : in String) return Util.Beans.Objects.Maps.Map is
      Result  : Util.Beans.Objects.Maps.Map;
   begin
      From_JSON (Content, Result);
      return Result;
   end From_JSON;

begin
   JSON_Mapping.Add_Mapping ("name", FIELD_NAME);
   JSON_Mapping.Add_Mapping ("value", FIELD_VALUE);
end Util.Serialize.Tools;

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

with Util.Streams.Texts;
with Util.Streams.Buffered;
with Util.Serialize.Mappers.Record_Mapper;
package body Util.Serialize.Tools is

   type Object_Field is (FIELD_NAME, FIELD_VALUE);
   type Object_Map_Access is access all Util.Beans.Objects.Maps.Map'Class;

   type Object_Mapper_Context is record
      Map  : Object_Map_Access;
      Name : Util.Beans.Objects.Object;
   end record;
   type Object_Mapper_Context_Access is access all Object_Mapper_Context;

   procedure Set_Member (Into  : in out Object_Mapper_Context;
                         Field : in Object_Field;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (Into  : in out Object_Mapper_Context;
                         Field : in Object_Field;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_VALUE =>
            Into.Map.Include (Util.Beans.Objects.To_String (Into.Name), Value);
            Into.Name := Util.Beans.Objects.Null_Object;

      end case;
   end Set_Member;

   package Object_Mapper is new
     Util.Serialize.Mappers.Record_Mapper (Element_Type        => Object_Mapper_Context,
                                           Element_Type_Access => Object_Mapper_Context_Access,
                                           Fields              => Object_Field,
                                           Set_Member          => Set_Member);

   JSON_Mapping : aliased Object_Mapper.Mapper;

   --  -----------------------
   --  Serialize the objects defined in the object map Map into the Output
   --  JSON stream.  Use the Name as the name of the JSON object.
   --  -----------------------
   procedure To_JSON (Output : in out Util.Serialize.IO.JSON.Output_Stream'Class;
                      Name   : in String;
                      Map    : in Util.Beans.Objects.Maps.Map) is
      use type Ada.Containers.Count_Type;

      procedure Write (Name  : in String;
                       Value : in Util.Beans.Objects.Object);

      procedure Write (Name  : in String;
                       Value : in Util.Beans.Objects.Object) is
      begin
         Output.Start_Entity (Name => "");
         Output.Write_Attribute (Name  => "name",
                                 Value => Util.Beans.Objects.To_Object (Name));
         Output.Write_Attribute (Name  => "value",
                                 Value => Value);
         Output.End_Entity (Name => "");
      end Write;

   begin
      if Map.Length > 0 then
         declare
            Iter : Util.Beans.Objects.Maps.Cursor := Map.First;
         begin
            Output.Start_Array (Name => Name);
            while Util.Beans.Objects.Maps.Has_Element (Iter) loop
               Util.Beans.Objects.Maps.Query_Element (Iter, Write'Access);
               Util.Beans.Objects.Maps.Next (Iter);
            end loop;
            Output.End_Array (Name => Name);
         end;
      end if;
   end To_JSON;

   --  -----------------------
   --  Serialize the objects defined in the object map Map into an XML stream.
   --  Returns the JSON string that contains a serialization of the object maps.
   --  -----------------------
   function To_JSON (Map : in Util.Beans.Objects.Maps.Map) return String is
      use type Ada.Containers.Count_Type;
   begin
      if Map.Length = 0 then
         return "";
      end if;
      declare
         Buffer : aliased Util.Streams.Texts.Print_Stream;
         Output : Util.Serialize.IO.JSON.Output_Stream;
      begin
         Buffer.Initialize (Size => 10000);
         Output.Initialize (Buffer'Unchecked_Access);
         Output.Start_Document;
         To_JSON (Output, "params", Map);
         Output.End_Document;
         return Util.Streams.Texts.To_String (Util.Streams.Buffered.Buffered_Stream (Buffer));
      end;
   end To_JSON;

   --  -----------------------
   --  Deserializes the JSON content passed in Content and restore the object map
   --  with their values.  The object map passed in Map can contain existing values.
   --  They will be overriden by the JSON values.
   --  -----------------------
   procedure From_JSON (Content : in String;
                        Map     : in out Util.Beans.Objects.Maps.Map) is
      Parser  : Util.Serialize.IO.JSON.Parser;
      Context : aliased Object_Mapper_Context;
   begin
      if Content'Length > 0 then
         Context.Map := Map'Unchecked_Access;
         Parser.Add_Mapping ("**", JSON_Mapping'Access);
         Object_Mapper.Set_Context (Parser, Context'Unchecked_Access);
         Parser.Parse_String (Content);
      end if;
   end From_JSON;

   --  -----------------------
   --  Deserializes the JSON content passed in Content and restore the object map
   --  with their values.
   --  Returns the object map that was restored.
   --  -----------------------
   function From_JSON (Content : in String) return Util.Beans.Objects.Maps.Map is
      Result  : Util.Beans.Objects.Maps.Map;
   begin
      From_JSON (Content, Result);
      return Result;
   end From_JSON;

begin
   JSON_Mapping.Add_Mapping ("name", FIELD_NAME);
   JSON_Mapping.Add_Mapping ("value", FIELD_VALUE);
end Util.Serialize.Tools;

Update the From_JSON mapping for the parser


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

with Util.Listeners;

with Babel.Files;
with Babel.Files.Queues;
with Babel.Files.Buffers;
with Babel.Stores;
with Babel.Filters;
with Babel.Base;
with Babel.Base.Text;
package Babel.Strategies is

   type Strategy_Type is abstract tagged limited private;
   type Strategy_Type_Access is access all Strategy_Type'Class;

   --  Allocate a buffer to read the file content.
   function Allocate_Buffer (Strategy : in Strategy_Type) return Babel.Files.Buffers.Buffer_Access;

   --  Release the buffer that was allocated by Allocate_Buffer.
   procedure Release_Buffer (Strategy : in Strategy_Type;
                             Buffer   : in out Babel.Files.Buffers.Buffer_Access);

   --  Returns true if there is a directory that must be processed by the current strategy.
   function Has_Directory (Strategy : in Strategy_Type) return Boolean is abstract;

   --  Get the next directory that must be processed by the strategy.
   procedure Peek_Directory (Strategy  : in out Strategy_Type;
                             Directory : out Babel.Files.Directory_Type) is abstract;

   --  Scan the directory
   procedure Scan (Strategy  : in out Strategy_Type;
                   Directory : in Babel.Files.Directory_Type;
                   Container : in out Babel.Files.File_Container'Class);

   --  Scan the directories which are defined in the directory queue and
   --  use the file container to scan the files and directories.
   procedure Scan (Strategy  : in out Strategy_Type;
                   Queue     : in out Babel.Files.Queues.Directory_Queue;
                   Container : in out Babel.Files.File_Container'Class);

   --  Read the file from the read store into the local buffer.
   procedure Read_File (Strategy : in Strategy_Type;
                        File     : in Babel.Files.File_Type;
                        Into     : in Babel.Files.Buffers.Buffer_Access);

   --  Write the file from the local buffer into the write store.
   procedure Write_File (Strategy : in Strategy_Type;
                         File     : in Babel.Files.File_Type;
                         Content  : in Babel.Files.Buffers.Buffer_Access);

   --  Backup the file from the local buffer into the write store.
   procedure Backup_File (Strategy : in out Strategy_Type;
                          File     : in Babel.Files.File_Type;
                          Content  : in out Babel.Files.Buffers.Buffer_Access);

   procedure Execute (Strategy : in out Strategy_Type) is abstract;

   --  Set the file filters that will be used when scanning the read store.
   procedure Set_Filters (Strategy : in out Strategy_Type;
                          Filters  : in Babel.Filters.Filter_Type_Access);

   --  Set the read and write stores that the strategy will use.
   procedure Set_Stores (Strategy : in out Strategy_Type;
                         Read     : in Babel.Stores.Store_Type_Access;
                         Write    : in Babel.Stores.Store_Type_Access);

   --  Set the buffer pool to be used by Allocate_Buffer.
   procedure Set_Buffers (Strategy : in out Strategy_Type;
                          Buffers  : in Babel.Files.Buffers.Buffer_Pool_Access);

   --  Set the listeners to inform about changes.
   procedure Set_Listeners (Strategy  : in out Strategy_Type;
                            Listeners : access Util.Listeners.List);

   --  Set the database for use by the strategy.
   procedure Set_Database (Strategy : in out Strategy_Type;
                           Database : in Babel.Base.Database_Access);

private

   type Strategy_Type is abstract tagged limited record
      Read_Store  : Babel.Stores.Store_Type_Access;
      Write_Store : Babel.Stores.Store_Type_Access;
      Filters     : Babel.Filters.Filter_Type_Access;
      Buffers     : Babel.Files.Buffers.Buffer_Pool_Access;
      Listeners   : access Util.Listeners.List;
      --        Database    : Babel.Base.Database_Access;
      Database    : Babel.Base.Text.Text_Database;
   end record;

end Babel.Strategies;

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

with Util.Listeners;

with Babel.Files;
with Babel.Files.Queues;
with Babel.Files.Buffers;
with Babel.Streams.Refs;
with Babel.Stores;
with Babel.Filters;
with Babel.Base;
with Babel.Base.Text;
package Babel.Strategies is

   type Strategy_Type is abstract tagged limited private;
   type Strategy_Type_Access is access all Strategy_Type'Class;

   --  Allocate a buffer to read the file content.
   function Allocate_Buffer (Strategy : in Strategy_Type) return Babel.Files.Buffers.Buffer_Access;

   --  Release the buffer that was allocated by Allocate_Buffer.
   procedure Release_Buffer (Strategy : in Strategy_Type;
                             Buffer   : in out Babel.Files.Buffers.Buffer_Access);

   --  Returns true if there is a directory that must be processed by the current strategy.
   function Has_Directory (Strategy : in Strategy_Type) return Boolean is abstract;

   --  Get the next directory that must be processed by the strategy.
   procedure Peek_Directory (Strategy  : in out Strategy_Type;
                             Directory : out Babel.Files.Directory_Type) is abstract;

   --  Scan the directory
   procedure Scan (Strategy  : in out Strategy_Type;
                   Directory : in Babel.Files.Directory_Type;
                   Container : in out Babel.Files.File_Container'Class);

   --  Scan the directories which are defined in the directory queue and
   --  use the file container to scan the files and directories.
   procedure Scan (Strategy  : in out Strategy_Type;
                   Queue     : in out Babel.Files.Queues.Directory_Queue;
                   Container : in out Babel.Files.File_Container'Class);

   --  Read the file from the read store into the local buffer.
   procedure Read_File (Strategy : in Strategy_Type;
                        File     : in Babel.Files.File_Type;
                        Into     : in Babel.Files.Buffers.Buffer_Access);

   --  Write the file from the local buffer into the write store.
   procedure Write_File (Strategy : in Strategy_Type;
                         File     : in Babel.Files.File_Type;
                         Content  : in Babel.Files.Buffers.Buffer_Access);

   --  Backup the file from the local buffer into the write store.
   procedure Backup_File (Strategy : in out Strategy_Type;
                          File     : in Babel.Files.File_Type;
                          Content  : in out Babel.Files.Buffers.Buffer_Access);

   procedure Execute (Strategy : in out Strategy_Type) is abstract;

   --  Set the file filters that will be used when scanning the read store.
   procedure Set_Filters (Strategy : in out Strategy_Type;
                          Filters  : in Babel.Filters.Filter_Type_Access);

   --  Set the read and write stores that the strategy will use.
   procedure Set_Stores (Strategy : in out Strategy_Type;
                         Read     : in Babel.Stores.Store_Type_Access;
                         Write    : in Babel.Stores.Store_Type_Access);

   --  Set the buffer pool to be used by Allocate_Buffer.
   procedure Set_Buffers (Strategy : in out Strategy_Type;
                          Buffers  : in Babel.Files.Buffers.Buffer_Pool_Access);

   --  Set the listeners to inform about changes.
   procedure Set_Listeners (Strategy  : in out Strategy_Type;
                            Listeners : access Util.Listeners.List);

   --  Set the database for use by the strategy.
   procedure Set_Database (Strategy : in out Strategy_Type;
                           Database : in Babel.Base.Database_Access);

private

   type Strategy_Type is abstract tagged limited record
      Read_Store  : Babel.Stores.Store_Type_Access;
      Write_Store : Babel.Stores.Store_Type_Access;
      Filters     : Babel.Filters.Filter_Type_Access;
      Buffers     : Babel.Files.Buffers.Buffer_Pool_Access;
      Listeners   : access Util.Listeners.List;
      --        Database    : Babel.Base.Database_Access;
      Database    : Babel.Base.Text.Text_Database;
   end record;

end Babel.Strategies;

Use the Babel.Streams.Refs package

Use the Babel.Streams.Refs package


-----------------------------------------------------------------------
--  wiki-utils -- Wiki utility operations
--  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 Wiki.Render.Text;
with Wiki.Render.Html;
with Wiki.Writers.Builders;
package body Wiki.Utils is

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in HTML into a string.
   --  ------------------------------
   function To_Html (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Writer   : aliased Wiki.Writers.Builders.Html_Writer_Type;
      Renderer : aliased Wiki.Render.Html.Html_Writer;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Wiki.Parsers.Parse (Renderer'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Html;

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in text into a string.
   --  Wiki formatting and decoration are removed.
   --  ------------------------------
   function To_Text (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Writer   : aliased Wiki.Writers.Builders.Writer_Builder_Type;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Wiki.Parsers.Parse (Renderer'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Text;

end Wiki.Utils;

-----------------------------------------------------------------------
--  wiki-utils -- Wiki utility operations
--  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 Wiki.Render.Text;
with Wiki.Render.Html;
with Wiki.Writers.Builders;
package body Wiki.Utils is

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in HTML into a string.
   --  ------------------------------
   function To_Html (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Writer   : aliased Wiki.Writers.Builders.Html_Writer_Type;
      Renderer : aliased Wiki.Render.Html.Html_Renderer;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Wiki.Parsers.Parse (Renderer'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Html;

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in text into a string.
   --  Wiki formatting and decoration are removed.
   --  ------------------------------
   function To_Text (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Writer   : aliased Wiki.Writers.Builders.Writer_Builder_Type;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Wiki.Parsers.Parse (Renderer'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Text;

end Wiki.Utils;

Use the Html_Renderer type

Use the Html_Renderer type


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

with ASF.Applications;

package body ASF.Servlets.Faces is

   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   procedure Initialize (Server  : in out Faces_Servlet;
                         Context : in Servlet_Registry'Class) is
      pragma Unreferenced (Context);

      Ctx : constant Servlet_Registry_Access := Server.Get_Servlet_Context;
   begin
      if Ctx.all in ASF.Applications.Main.Application'Class then
         Server.App := ASF.Applications.Main.Application'Class (Ctx.all)'Unchecked_Access;
      end if;
   end Initialize;

   --  Called by the server (via the service method) to allow a servlet to handle
   --  a GET request.
   --
   --  Overriding this method to support a GET request also automatically supports
   --  an HTTP HEAD request. A HEAD request is a GET request that returns no body
   --  in the response, only the request header fields.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding.
   --  When using a PrintWriter object to return the response, set the content type
   --  before accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container
   --  to use a persistent connection to return its response to the client,
   --  improving performance. The content length is automatically set if the entire
   --  response fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  The GET method should be safe, that is, without any side effects for which
   --  users are held responsible. For example, most form queries have no side effects.
   --  If a client request is intended to change stored data, the request should use
   --  some other HTTP method.
   --
   --  The GET method should also be idempotent, meaning that it can be safely repeated.
   --  Sometimes making a method safe also makes it idempotent. For example, repeating
   --  queries is both safe and idempotent, but buying a product online or modifying
   --  data is neither safe nor idempotent.
   --
   --  If the request is incorrectly formatted, Do_Get  returns an HTTP "Bad Request"
   procedure Do_Get (Server   : in Faces_Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is
      URI    : constant String := Request.Get_Path_Info;
   begin
      Server.App.Dispatch (Page     => URI,
                           Request  => Request,
                           Response => Response);
   end Do_Get;

   --  Called by the server (via the service method) to allow a servlet to handle
   --  a POST request. The HTTP POST method allows the client to send data of unlimited
   --  length to the Web server a single time and is useful when posting information
   --  such as credit card numbers.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding. When using
   --  a PrintWriter object to return the response, set the content type before
   --  accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container to use
   --  a persistent connection to return its response to the client, improving
   --  performance. The content length is automatically set if the entire response
   --  fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  This method does not need to be either safe or idempotent. Operations
   --  requested through POST can have side effects for which the user can be held
   --  accountable, for example, updating stored data or buying items online.
   --
   --  If the HTTP POST request is incorrectly formatted, doPost returns
   --  an HTTP "Bad Request" message.
   procedure Do_Post (Server   : in Faces_Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class) is
      URI    : constant String := Request.Get_Path_Info;
   begin
      Server.App.Dispatch (Page     => URI,
                           Request  => Request,
                           Response => Response);
   end Do_Post;

end ASF.Servlets.Faces;

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

with ASF.Applications;

package body ASF.Servlets.Faces is

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out Faces_Servlet;
                         Context : in Servlet_Registry'Class) is
      pragma Unreferenced (Context);

      Ctx : constant Servlet_Registry_Access := Server.Get_Servlet_Context;
   begin
      if Ctx.all in ASF.Applications.Main.Application'Class then
         Server.App := ASF.Applications.Main.Application'Class (Ctx.all)'Unchecked_Access;
      end if;
   end Initialize;

   --  ------------------------------
   --  Called by the server (via the service method) to allow a servlet to handle
   --  a GET request.
   --
   --  Overriding this method to support a GET request also automatically supports
   --  an HTTP HEAD request. A HEAD request is a GET request that returns no body
   --  in the response, only the request header fields.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding.
   --  When using a PrintWriter object to return the response, set the content type
   --  before accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container
   --  to use a persistent connection to return its response to the client,
   --  improving performance. The content length is automatically set if the entire
   --  response fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  The GET method should be safe, that is, without any side effects for which
   --  users are held responsible. For example, most form queries have no side effects.
   --  If a client request is intended to change stored data, the request should use
   --  some other HTTP method.
   --
   --  The GET method should also be idempotent, meaning that it can be safely repeated.
   --  Sometimes making a method safe also makes it idempotent. For example, repeating
   --  queries is both safe and idempotent, but buying a product online or modifying
   --  data is neither safe nor idempotent.
   --
   --  If the request is incorrectly formatted, Do_Get  returns an HTTP "Bad Request"
   --  ------------------------------
   procedure Do_Get (Server   : in Faces_Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is
      URI    : constant String := Request.Get_Servlet_Path;
   begin
      Server.App.Dispatch (Page     => URI,
                           Request  => Request,
                           Response => Response);
   end Do_Get;

   --  ------------------------------
   --  Called by the server (via the service method) to allow a servlet to handle
   --  a POST request. The HTTP POST method allows the client to send data of unlimited
   --  length to the Web server a single time and is useful when posting information
   --  such as credit card numbers.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding. When using
   --  a PrintWriter object to return the response, set the content type before
   --  accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container to use
   --  a persistent connection to return its response to the client, improving
   --  performance. The content length is automatically set if the entire response
   --  fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  This method does not need to be either safe or idempotent. Operations
   --  requested through POST can have side effects for which the user can be held
   --  accountable, for example, updating stored data or buying items online.
   --
   --  If the HTTP POST request is incorrectly formatted, doPost returns
   --  an HTTP "Bad Request" message.
   --  ------------------------------
   procedure Do_Post (Server   : in Faces_Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class) is
      URI    : constant String := Request.Get_Servlet_Path;
   begin
      Server.App.Dispatch (Page     => URI,
                           Request  => Request,
                           Response => Response);
   end Do_Post;

end ASF.Servlets.Faces;

Use Get_Servlet_Path instead of Get_Path_Info


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

--  === HTML Filters ===
--  The <b>Wiki.Filters.Html</b> package implements a customizable HTML filter that verifies
--  the HTML content embedded in the Wiki text.
--
--  The HTML filter may be declared and configured as follows:
--
--    F : aliased Wiki.Filters.Html.Html_Filter_Type;
--    ...
--    F.Forbidden (Wiki.Filters.Html.SCRIPT_TAG);
--    F.Forbidden (Wiki.Filters.Html.A_TAG);
--
--  The <tt>Set_Document</tt> operation is used to link the HTML filter to a next filter
--  or to the HTML or text renderer:
--
--    F.Set_Document (Renderer'Access);
--
--  The HTML filter is then either inserted as a document for a previous filter or for
--  the wiki parser:
--
--    Wiki.Parsers.Parse (F'Access, Wiki_Text, Syntax);
--
package Wiki.Filters.Html is

   use Wiki.Nodes;

   --  ------------------------------
   --  Filter type
   --  ------------------------------
   type Html_Filter_Type is new Filter_Type with private;

   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   overriding
   procedure Add_Node (Filter    : in out Html_Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind);

   --  Add a text content with the given format to the document.
   overriding
   procedure Add_Text (Filter    : in out Html_Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map);

   --  Add a section header with the given level in the document.
   overriding
   procedure Add_Header (Filter    : in out Html_Filter_Type;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural);

   --  Push a HTML node with the given tag to the document.
   overriding
   procedure Push_Node (Filter     : in out Html_Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Tag        : in Wiki.Html_Tag;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Pop a HTML node with the given tag.
   overriding
   procedure Pop_Node (Filter   : in out Html_Filter_Type;
                       Document : in out Wiki.Documents.Document;
                       Tag      : in Wiki.Html_Tag);

   --  Add a link.
   overriding
   procedure Add_Link (Filter     : in out Html_Filter_Type;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add an image.
   overriding
   procedure Add_Image (Filter     : in out Html_Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Finish the document after complete wiki text has been parsed.
   overriding
   procedure Finish (Filter   : in out Html_Filter_Type;
                     Document : in out Wiki.Documents.Document);

   --  Mark the HTML tag as being forbidden.
   procedure Forbidden (Filter : in out Html_Filter_Type;
                        Tag    : in Html_Tag);

   --  Mark the HTML tag as being allowed.
   procedure Allowed (Filter : in out Html_Filter_Type;
                      Tag    : in Html_Tag);

   --  Mark the HTML tag as being hidden.  The tag and its inner content including the text
   --  will be removed and not passed to the final document.
   procedure Hide (Filter : in out Html_Filter_Type;
                   Tag    : in Html_Tag);

   --  Mark the HTML tag as being visible.
   procedure Visible (Filter : in out Html_Filter_Type;
                      Tag    : in Html_Tag);

   --  Flush the HTML element that have not yet been closed.
   procedure Flush_Stack (Filter   : in out Html_Filter_Type;
                          Document : in out Wiki.Documents.Document);

private

   use Wiki.Nodes;

   type Tag_Boolean_Array is array (Html_Tag) of Boolean;

   package Tag_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Html_Tag);

   subtype Tag_Vector is Tag_Vectors.Vector;
   subtype Tag_Cursor is Tag_Vectors.Cursor;

   type Html_Filter_Type is new Filter_Type with record
      Allowed    : Tag_Boolean_Array := (UNKNOWN_TAG   => False,
                                         SCRIPT_TAG    => False,
                                         ROOT_HTML_TAG => False,
                                         HEAD_TAG      => False,
                                         BODY_TAG      => False,
                                         META_TAG      => False,
                                         TITLE_TAG     => False,
                                         others        => True);

      Hidden     : Tag_Boolean_Array := (UNKNOWN_TAG => False,
                                         SCRIPT_TAG  => True,
                                         STYLE_TAG   => True,
                                         others      => False);
      Stack      : Tag_Vector;
      Hide_Level : Natural := 0;
   end record;

end Wiki.Filters.Html;

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

--  === HTML Filters ===
--  The <b>Wiki.Filters.Html</b> package implements a customizable HTML filter that verifies
--  the HTML content embedded in the Wiki text.
--
--  The HTML filter may be declared and configured as follows:
--
--    F : aliased Wiki.Filters.Html.Html_Filter_Type;
--    ...
--    F.Forbidden (Wiki.Filters.Html.SCRIPT_TAG);
--    F.Forbidden (Wiki.Filters.Html.A_TAG);
--
--  The <tt>Set_Document</tt> operation is used to link the HTML filter to a next filter
--  or to the HTML or text renderer:
--
--    F.Set_Document (Renderer'Access);
--
--  The HTML filter is then either inserted as a document for a previous filter or for
--  the wiki parser:
--
--    Wiki.Parsers.Parse (F'Access, Wiki_Text, Syntax);
--
package Wiki.Filters.Html is

   --  ------------------------------
   --  Filter type
   --  ------------------------------
   type Html_Filter_Type is new Filter_Type with private;

   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   overriding
   procedure Add_Node (Filter    : in out Html_Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind);

   --  Add a text content with the given format to the document.
   overriding
   procedure Add_Text (Filter    : in out Html_Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map);

   --  Add a section header with the given level in the document.
   overriding
   procedure Add_Header (Filter    : in out Html_Filter_Type;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural);

   --  Push a HTML node with the given tag to the document.
   overriding
   procedure Push_Node (Filter     : in out Html_Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Tag        : in Wiki.Html_Tag;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Pop a HTML node with the given tag.
   overriding
   procedure Pop_Node (Filter   : in out Html_Filter_Type;
                       Document : in out Wiki.Documents.Document;
                       Tag      : in Wiki.Html_Tag);

   --  Add a link.
   overriding
   procedure Add_Link (Filter     : in out Html_Filter_Type;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add an image.
   overriding
   procedure Add_Image (Filter     : in out Html_Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Finish the document after complete wiki text has been parsed.
   overriding
   procedure Finish (Filter   : in out Html_Filter_Type;
                     Document : in out Wiki.Documents.Document);

   --  Mark the HTML tag as being forbidden.
   procedure Forbidden (Filter : in out Html_Filter_Type;
                        Tag    : in Html_Tag);

   --  Mark the HTML tag as being allowed.
   procedure Allowed (Filter : in out Html_Filter_Type;
                      Tag    : in Html_Tag);

   --  Mark the HTML tag as being hidden.  The tag and its inner content including the text
   --  will be removed and not passed to the final document.
   procedure Hide (Filter : in out Html_Filter_Type;
                   Tag    : in Html_Tag);

   --  Mark the HTML tag as being visible.
   procedure Visible (Filter : in out Html_Filter_Type;
                      Tag    : in Html_Tag);

   --  Flush the HTML element that have not yet been closed.
   procedure Flush_Stack (Filter   : in out Html_Filter_Type;
                          Document : in out Wiki.Documents.Document);

private

   use Wiki.Nodes;

   type Tag_Boolean_Array is array (Html_Tag) of Boolean;

   package Tag_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Html_Tag);

   subtype Tag_Vector is Tag_Vectors.Vector;
   subtype Tag_Cursor is Tag_Vectors.Cursor;

   type Html_Filter_Type is new Filter_Type with record
      Allowed    : Tag_Boolean_Array := (UNKNOWN_TAG   => False,
                                         SCRIPT_TAG    => False,
                                         ROOT_HTML_TAG => False,
                                         HEAD_TAG      => False,
                                         BODY_TAG      => False,
                                         META_TAG      => False,
                                         TITLE_TAG     => False,
                                         others        => True);

      Hidden     : Tag_Boolean_Array := (UNKNOWN_TAG => False,
                                         SCRIPT_TAG  => True,
                                         STYLE_TAG   => True,
                                         others      => False);
      Stack      : Tag_Vector;
      Hide_Level : Natural := 0;
   end record;

end Wiki.Filters.Html;

Remove use of Wiki.Nodes package

Remove use of Wiki.Nodes package


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

with Util.Test_Caller;

with AWA.Events;

package body AWA.Mail.Modules.Tests is

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Mail.Module.Create_Message",
                       Test_Create_Message'Access);
      Caller.Add_Test (Suite, "Test AWA.Mail.Module.Create_Message (CC:)",
                       Test_Cc_Message'Access);
      Caller.Add_Test (Suite, "Test AWA.Mail.Module.Create_Message (BCC:)",
                       Test_Bcc_Message'Access);
   end Add_Tests;

   --  ------------------------------
   --  Create an email message with the given template and verify its content.
   --  ------------------------------
   procedure Test_Mail_Message (T    : in out Test;
                                Name : in String) is
      use Util.Beans.Objects;

      Mail  : constant AWA.Mail.Modules.Mail_Module_Access := AWA.Mail.Modules.Get_Mail_Module;
      Event : AWA.Events.Module_Event;
      Props : Util.Beans.Objects.Maps.Map;
   begin
      T.Assert (Mail /= null, "There is no current mail module");

      Props.Insert ("name", To_Object (String '("joe")));
      Props.Insert ("email", To_Object (String '("joe.rogers@somewhere.org")));
      Mail.Send_Mail (Template => Name,
                      Props    => Props,
                      Content  => Event);

   end Test_Mail_Message;

   --  ------------------------------
   --  Create an email message and verify its content.
   --  ------------------------------
   procedure Test_Create_Message (T : in out Test) is
   begin
      T.Test_Mail_Message ("mail-info.html");
   end Test_Create_Message;

   --  ------------------------------
   --  Create an email message with Cc: and verify its content.
   --  ------------------------------
   procedure Test_Cc_Message (T : in out Test) is
   begin
      T.Test_Mail_Message ("mail-cc.html");
   end Test_Cc_Message;

   --  ------------------------------
   --  Create an email message with Bcc: and verify its content.
   --  ------------------------------
   procedure Test_Bcc_Message (T : in out Test) is
   begin
      T.Test_Mail_Message ("mail-bcc.html");
   end Test_Bcc_Message;

end AWA.Mail.Modules.Tests;

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

with Util.Test_Caller;

with AWA.Events;

package body AWA.Mail.Modules.Tests is

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Mail.Module.Create_Message",
                       Test_Create_Message'Access);
      Caller.Add_Test (Suite, "Test AWA.Mail.Module.Create_Message (CC:)",
                       Test_Cc_Message'Access);
      Caller.Add_Test (Suite, "Test AWA.Mail.Module.Create_Message (BCC:)",
                       Test_Bcc_Message'Access);
   end Add_Tests;

   --  ------------------------------
   --  Create an email message with the given template and verify its content.
   --  ------------------------------
   procedure Test_Mail_Message (T    : in out Test;
                                Name : in String) is
      use Util.Beans.Objects;

      Mail  : constant AWA.Mail.Modules.Mail_Module_Access := AWA.Mail.Modules.Get_Mail_Module;
      Event : AWA.Events.Module_Event;
      Props : Util.Beans.Objects.Maps.Map;
   begin
      T.Assert (Mail /= null, "There is no current mail module");

      Props.Insert ("name", To_Object (String '("joe")));
      Props.Insert ("email", To_Object (String '("joe.rogers@somewhere.org")));
      Mail.Send_Mail (Template => Name,
                      Props    => Props,
                      Content  => Event);

   end Test_Mail_Message;

   --  ------------------------------
   --  Create an email message and verify its content.
   --  ------------------------------
   procedure Test_Create_Message (T : in out Test) is
   begin
      T.Test_Mail_Message ("mail-info.html");
   end Test_Create_Message;

   --  ------------------------------
   --  Create an email message with Cc: and verify its content.
   --  ------------------------------
   procedure Test_Cc_Message (T : in out Test) is
   begin
      T.Test_Mail_Message ("mail-cc.html");
   end Test_Cc_Message;

   --  ------------------------------
   --  Create an email message with Bcc: and verify its content.
   --  ------------------------------
   procedure Test_Bcc_Message (T : in out Test) is
   begin
      T.Test_Mail_Message ("mail-bcc.html");
   end Test_Bcc_Message;

end AWA.Mail.Modules.Tests;

Fix the name of the test because it is already used by another test


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

   --  ------------------------------
   --  Execute the wifi 'status' command to print the Wifi current status.
   --  ------------------------------
   procedure Do_List (Command   : in Command_Type;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Command);

      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;

      procedure Box_Status (Gateway : in out Druss.Gateways.Gateway_Type) is

         procedure Print_Device (Manager : in Util.Properties.Manager;
                                 Name    : in String) is
            Link : constant String := Manager.Get (Name & ".link", "");
            Kind : constant String := Manager.Get (Name & ".devicetype", "");
         begin
            if Manager.Get (Name & ".active", "") = "0" then
               return;
            end if;
            Console.Start_Row;
            Console.Print_Field (F_BBOX_IP_ADDR, Gateway.Ip);
            Console.Print_Field (F_IP_ADDR, Manager.Get (Name & ".ipaddress", ""));
            Console.Print_Field (F_ETHERNET, Manager.Get (Name & ".macaddress", ""));
            Console.Print_Field (F_HOSTNAME, Manager.Get (Name & ".hostname", ""));
            Console.Print_Field (F_ACTIVE, Manager.Get (Name & ".active", ""));
            Console.Print_Field (F_DEVTYPE, (if Kind = "STB" then "STB" else ""));
            if Link = "Ethernet" then
               Console.Print_Field (F_LINK, Link & " port "
                                    & Manager.Get (Name & ".ethernet.logicalport", ""));
            else
               Console.Print_Field (F_LINK, Link & " RSSI "
                                    & Manager.Get (Name & ".wireless.rssi0", ""));
            end if;
            Console.End_Row;
         end Print_Device;

      begin
         Gateway.Refresh;

         Bbox.API.Iterate (Gateway.Hosts, "hosts.list", Print_Device'Access);
      end Box_Status;

   begin
      Console.Start_Title;
      Console.Print_Title (F_BBOX_IP_ADDR, "Bbox IP", 16);
      Console.Print_Title (F_IP_ADDR, "Device IP", 16);
      Console.Print_Title (F_ETHERNET, "Ethernet", 20);
      Console.Print_Title (F_HOSTNAME, "Hostname", 28);
      Console.Print_Title (F_DEVTYPE, "Type", 6);
      --  Console.Print_Title (F_ACTIVE, "Active", 8);
      Console.Print_Title (F_LINK, "Link", 18);
      Console.End_Title;
      Druss.Gateways.Iterate (Context.Gateways, Gateways.ITER_ENABLE, Box_Status'Access);
   end Do_List;

   --  Execute a status command to report information about the Bbox.
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Name);
   begin
      Command.Do_List (Args, Context);
   end Execute;

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type) is
      pragma Unreferenced (Command);
      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;
   begin
      Console.Notice (N_HELP, "devices: Print information about the devices");
      Console.Notice (N_HELP, "Usage: devices [options]");
      Console.Notice (N_HELP, "");
   end Help;

end Druss.Commands.Devices;

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

   --  ------------------------------
   --  Execute the wifi 'status' command to print the Wifi current status.
   --  ------------------------------
   procedure Do_List (Command   : in Command_Type;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Command, Args);
      procedure Box_Status (Gateway : in out Druss.Gateways.Gateway_Type);

      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;

      procedure Box_Status (Gateway : in out Druss.Gateways.Gateway_Type) is
         procedure Print_Device (Manager : in Util.Properties.Manager;
                                 Name    : in String);

         procedure Print_Device (Manager : in Util.Properties.Manager;
                                 Name    : in String) is
            Link : constant String := Manager.Get (Name & ".link", "");
            Kind : constant String := Manager.Get (Name & ".devicetype", "");
         begin
            if Manager.Get (Name & ".active", "") = "0" then
               return;
            end if;
            Console.Start_Row;
            Console.Print_Field (F_BBOX_IP_ADDR, Gateway.Ip);
            Console.Print_Field (F_IP_ADDR, Manager.Get (Name & ".ipaddress", ""));
            Console.Print_Field (F_ETHERNET, Manager.Get (Name & ".macaddress", ""));
            Console.Print_Field (F_HOSTNAME, Manager.Get (Name & ".hostname", ""));
            Console.Print_Field (F_ACTIVE, Manager.Get (Name & ".active", ""));
            Console.Print_Field (F_DEVTYPE, (if Kind = "STB" then "STB" else ""));
            if Link = "Ethernet" then
               Console.Print_Field (F_LINK, Link & " port "
                                    & Manager.Get (Name & ".ethernet.logicalport", ""));
            else
               Console.Print_Field (F_LINK, Link & " RSSI "
                                    & Manager.Get (Name & ".wireless.rssi0", ""));
            end if;
            Console.End_Row;
         end Print_Device;

      begin
         Gateway.Refresh;

         Bbox.API.Iterate (Gateway.Hosts, "hosts.list", Print_Device'Access);
      end Box_Status;

   begin
      Console.Start_Title;
      Console.Print_Title (F_BBOX_IP_ADDR, "Bbox IP", 16);
      Console.Print_Title (F_IP_ADDR, "Device IP", 16);
      Console.Print_Title (F_ETHERNET, "Ethernet", 20);
      Console.Print_Title (F_HOSTNAME, "Hostname", 28);
      Console.Print_Title (F_DEVTYPE, "Type", 6);
      --  Console.Print_Title (F_ACTIVE, "Active", 8);
      Console.Print_Title (F_LINK, "Link", 18);
      Console.End_Title;
      Druss.Gateways.Iterate (Context.Gateways, Gateways.ITER_ENABLE, Box_Status'Access);
   end Do_List;

   --  ------------------------------
   --  Execute a status command to report information about the Bbox.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Name);
   begin
      Command.Do_List (Args, Context);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type) is
      pragma Unreferenced (Command);
      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;
   begin
      Console.Notice (N_HELP, "devices: Print information about the devices");
      Console.Notice (N_HELP, "Usage: devices [options]");
      Console.Notice (N_HELP, "");
   end Help;

end Druss.Commands.Devices;

Fix compilation warnings

Fix compilation warnings