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

   type Process_Probe_Type is new MAT.Events.Probes.Probe_Type with record
      Target  : Target_Type_Access;
      Manager : MAT.Events.Probes.Probe_Manager_Type_Access;
      Events  : MAT.Events.Targets.Target_Events_Access;
   end record;
   type Process_Probe_Type_Access is access all Process_Probe_Type'Class;

   --  Create a new process after the begin event is received from the event stream.
   procedure Create_Process (Probe : in Process_Probe_Type;
                             Pid   : in MAT.Types.Target_Process_Ref;
                             Path  : in Ada.Strings.Unbounded.Unbounded_String);

   --  Extract the probe information from the message.
   overriding
   procedure Extract (Probe  : in Process_Probe_Type;
                      Params : in MAT.Events.Const_Attribute_Table_Access;
                      Msg    : in out MAT.Readers.Message_Type;
                      Event  : in out MAT.Events.Targets.Probe_Event_Type);

   procedure Execute (Probe : in Process_Probe_Type;
                      Event : in MAT.Events.Targets.Probe_Event_Type);

   --  Register the reader to extract and analyze process events.
   procedure Register (Into  : in out MAT.Events.Probes.Probe_Manager_Type'Class;
                       Probe : in Process_Probe_Type_Access);

   --  Initialize the target object to prepare for reading process events.
   procedure Initialize (Target  : in out Target_Type;
                         Manager : in out MAT.Events.Probes.Probe_Manager_Type'Class);

private

   procedure Probe_Begin (Probe : in Process_Probe_Type;
                          Defs  : in MAT.Events.Attribute_Table;
                          Msg   : in out MAT.Readers.Message;
                          Event : in out MAT.Events.Targets.Probe_Event_Type);

   --  Extract the information from the 'library' event.
   procedure Probe_Library (Probe : in Process_Probe_Type;
                            Defs  : in MAT.Events.Attribute_Table;
                            Msg   : in out MAT.Readers.Message;
                            Event : in out MAT.Events.Targets.Probe_Event_Type);

end MAT.Targets.Probes;

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

   type Process_Probe_Type is new MAT.Events.Probes.Probe_Type with record
      Target  : Target_Type_Access;
      Manager : MAT.Events.Probes.Probe_Manager_Type_Access;
      Events  : MAT.Events.Targets.Target_Events_Access;
   end record;
   type Process_Probe_Type_Access is access all Process_Probe_Type'Class;

   --  Create a new process after the begin event is received from the event stream.
   procedure Create_Process (Probe : in Process_Probe_Type;
                             Pid   : in MAT.Types.Target_Process_Ref;
                             Path  : in Ada.Strings.Unbounded.Unbounded_String);

   --  Extract the probe information from the message.
   overriding
   procedure Extract (Probe  : in Process_Probe_Type;
                      Params : in MAT.Events.Const_Attribute_Table_Access;
                      Msg    : in out MAT.Readers.Message_Type;
                      Event  : in out MAT.Events.Targets.Probe_Event_Type);

   procedure Execute (Probe : in Process_Probe_Type;
                      Event : in out MAT.Events.Targets.Probe_Event_Type);

   --  Register the reader to extract and analyze process events.
   procedure Register (Into  : in out MAT.Events.Probes.Probe_Manager_Type'Class;
                       Probe : in Process_Probe_Type_Access);

   --  Initialize the target object to prepare for reading process events.
   procedure Initialize (Target  : in out Target_Type;
                         Manager : in out MAT.Events.Probes.Probe_Manager_Type'Class);

private

   procedure Probe_Begin (Probe : in Process_Probe_Type;
                          Defs  : in MAT.Events.Attribute_Table;
                          Msg   : in out MAT.Readers.Message;
                          Event : in out MAT.Events.Targets.Probe_Event_Type);

   --  Extract the information from the 'library' event.
   procedure Probe_Library (Probe : in Process_Probe_Type;
                            Defs  : in MAT.Events.Attribute_Table;
                            Msg   : in out MAT.Readers.Message;
                            Event : in out MAT.Events.Targets.Probe_Event_Type);

end MAT.Targets.Probes;

Change the Event parameter of Execute to an in out parameter


-----------------------------------------------------------------------
--  Render Tests - Unit tests for ASF.Applications.Views
--  Copyright (C) 2009, 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 AUnit.Simple_Test_Cases;
with Ada.Text_IO;
with ASF.Applications.Views;
with ASF.Components.Core;
with EL.Contexts;
with EL.Contexts.Default;
with EL.Variables.Default;
with ASF.Contexts.Writer.Tests;
with Ada.Directories;
with Util.Tests;
with Util.Files;
with Util.Measures;
package body ASF.Applications.Views.Tests is

   use AUnit;
   use Ada.Strings.Unbounded;
   use ASF.Contexts.Writer.Tests;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;
   --  Set up performed before each test case

   overriding
   procedure Tear_Down (T : in out Test) is
   begin
      null;
   end Tear_Down;
   --  Tear down performed after each test case

   --  Test loading of facelet file
   procedure Test_Load_Facelet (T : in out Test) is

      use ASF;
      use ASF.Contexts.Faces;

      use EL.Contexts.Default;
      use EL.Variables;
      use EL.Variables.Default;
      use EL.Contexts;

      H        : Applications.Views.View_Handler;

      View_Name   : constant String := To_String (T.File);
      Result_File : constant String := To_String (T.Result);
      Conf        : Applications.Config;
   begin
      Conf.Load_Properties ("regtests/view.properties");
      H.Initialize (Conf);

      for I in 1 .. 2 loop
         declare
            S : Util.Measures.Stamp;
            Writer    : aliased Test_Writer;
            Context   : aliased Faces_Context;
            View      : Components.Core.UIViewRoot;
            ELContext : aliased EL.Contexts.Default.Default_Context;
            Variables : aliased Default_Variable_Mapper;
            Resolver  : aliased Default_ELResolver;
         begin
            Context.Set_Response_Writer (Writer'Unchecked_Access);
            Context.Set_ELContext (ELContext'Unchecked_Access);
            Writer.Initialize ("text/xml", "UTF-8", 8192);

            Set_Current (Context'Unchecked_Access);
            H.Restore_View (View_Name, Context, View);

            H.Render_View (Context, View);
            Writer.Flush;
            Util.Measures.Report (S, "Pass" & Integer'Image (I) & ": Render view "
                                  & View_Name);

            Util.Files.Write_File (Result_File, Writer.Response);
            Util.Tests.Assert_Equal_Files (Expect  => To_String (T.Expect),
                                           Test    => Result_File,
                                           Message => "Restore and render view");
         end;
      end loop;
   end Test_Load_Facelet;

   type Test_Case is new AUnit.Simple_Test_Cases.Test_Case with record
      Name    : Unbounded_String;
      File    : Unbounded_String;
      Expect  : Unbounded_String;
      Result  : Unbounded_String;
      Fixture : Test;
   end record;
   type Test_Case_Access is access all Test_Case;

   --  Test case name
   overriding
   function Name (Test : Test_Case) return Message_String;

   --  Perform the test.
   overriding
   procedure Run_Test (Test : in out Test_Case);

   overriding
   procedure Set_Up (Test : in out Test_Case);

   --  Test case name
   overriding
   function Name (Test : Test_Case) return Message_String is
   begin
      return Format ("Test " & To_String (Test.Name));
   end Name;

   --  Perform the test.
   overriding
   procedure Run_Test (Test : in out Test_Case) is
   begin
      Test.Fixture.Test_Load_Facelet;
   end Run_Test;

   overriding
   procedure Set_Up (Test : in out Test_Case) is
   begin
      Test.Fixture.File   := Test.File;
      Test.Fixture.Expect := Test.Expect;
      Test.Fixture.Result := Test.Result;
      Test.Fixture.Set_Up;
   end Set_Up;

   procedure Add_Tests (Suite : AUnit.Test_Suites.Access_Test_Suite) is
      use Ada.Directories;

      Result_Dir  : constant String := "regtests/result/views";
      Dir         : constant String := "regtests/files/views";
      Expect_Dir  : constant String := "regtests/expect/views";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;
   begin
      if Kind (Path) = Directory then
         Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Simple    : constant String := Simple_Name (Ent);
            File_Path : constant String := Full_Name (Ent);
            Test      : Test_Case_Access;
         begin
            if Simple /= "." and then Simple /= ".."
              and then Simple /= ".svn" then
               Test := new Test_Case;
               Test.Name := To_Unbounded_String (Dir & "/" & Simple);
               Test.File := To_Unbounded_String (File_Path);
               Test.Expect := To_Unbounded_String (Expect_Path & "/" & Simple);
               Test.Result := To_Unbounded_String (Result_Path & "/" & Simple);
               Suite.Add_Test (Test);
            end if;
         end;
      end loop;
   end Add_Tests;

end ASF.Applications.Views.Tests;

-----------------------------------------------------------------------
--  Render Tests - Unit tests for ASF.Applications.Views
--  Copyright (C) 2009, 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 AUnit.Simple_Test_Cases;
with Ada.Text_IO;
with ASF.Applications.Views;
with ASF.Components.Core;
with EL.Contexts;
with EL.Contexts.Default;
with EL.Variables.Default;
with ASF.Contexts.Writer.Tests;
with Ada.Directories;
with Util.Tests;
with Util.Files;
with Util.Measures;
package body ASF.Applications.Views.Tests is

   use AUnit;
   use Ada.Strings.Unbounded;
   use ASF.Contexts.Writer.Tests;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;
   --  Set up performed before each test case

   overriding
   procedure Tear_Down (T : in out Test) is
   begin
      null;
   end Tear_Down;
   --  Tear down performed after each test case

   --  Test loading of facelet file
   procedure Test_Load_Facelet (T : in out Test) is

      use ASF;
      use ASF.Contexts.Faces;

      use EL.Contexts.Default;
      use EL.Variables;
      use EL.Variables.Default;
      use EL.Contexts;

      H        : Applications.Views.View_Handler;

      View_Name   : constant String := To_String (T.File);
      Result_File : constant String := To_String (T.Result);
      Conf        : Applications.Config;
   begin
      Conf.Load_Properties ("regtests/view.properties");
      H.Initialize (Conf);

      for I in 1 .. 2 loop
         declare
            S : Util.Measures.Stamp;
            Writer    : aliased Test_Writer;
            Context   : aliased Faces_Context;
            View      : Components.Core.UIViewRoot;
            ELContext : aliased EL.Contexts.Default.Default_Context;
            Variables : aliased Default_Variable_Mapper;
            Resolver  : aliased Default_ELResolver;
         begin
            Context.Set_Response_Writer (Writer'Unchecked_Access);
            Context.Set_ELContext (ELContext'Unchecked_Access);
            ELContext.Set_Variable_Mapper (Variables'Unchecked_Access);
            ELContext.Set_Resolver (Resolver'Unchecked_Access);
            Writer.Initialize ("text/xml", "UTF-8", 8192);

            Set_Current (Context'Unchecked_Access);
            H.Restore_View (View_Name, Context, View);

            H.Render_View (Context, View);
            Writer.Flush;
            Util.Measures.Report (S, "Pass" & Integer'Image (I) & ": Render view "
                                  & View_Name);

            Util.Files.Write_File (Result_File, Writer.Response);
            Util.Tests.Assert_Equal_Files (Expect  => To_String (T.Expect),
                                           Test    => Result_File,
                                           Message => "Restore and render view");
         end;
      end loop;
   end Test_Load_Facelet;

   type Test_Case is new AUnit.Simple_Test_Cases.Test_Case with record
      Name    : Unbounded_String;
      File    : Unbounded_String;
      Expect  : Unbounded_String;
      Result  : Unbounded_String;
      Fixture : Test;
   end record;
   type Test_Case_Access is access all Test_Case;

   --  Test case name
   overriding
   function Name (Test : Test_Case) return Message_String;

   --  Perform the test.
   overriding
   procedure Run_Test (Test : in out Test_Case);

   overriding
   procedure Set_Up (Test : in out Test_Case);

   --  Test case name
   overriding
   function Name (Test : Test_Case) return Message_String is
   begin
      return Format ("Test " & To_String (Test.Name));
   end Name;

   --  Perform the test.
   overriding
   procedure Run_Test (Test : in out Test_Case) is
   begin
      Test.Fixture.Test_Load_Facelet;
   end Run_Test;

   overriding
   procedure Set_Up (Test : in out Test_Case) is
   begin
      Test.Fixture.File   := Test.File;
      Test.Fixture.Expect := Test.Expect;
      Test.Fixture.Result := Test.Result;
      Test.Fixture.Set_Up;
   end Set_Up;

   procedure Add_Tests (Suite : AUnit.Test_Suites.Access_Test_Suite) is
      use Ada.Directories;

      Result_Dir  : constant String := "regtests/result/views";
      Dir         : constant String := "regtests/files/views";
      Expect_Dir  : constant String := "regtests/expect/views";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;
   begin
      if Kind (Path) = Directory then
         Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Simple    : constant String := Simple_Name (Ent);
            File_Path : constant String := Full_Name (Ent);
            Test      : Test_Case_Access;
         begin
            if Simple /= "." and then Simple /= ".."
              and then Simple /= ".svn" then
               Test := new Test_Case;
               Test.Name := To_Unbounded_String (Dir & "/" & Simple);
               Test.File := To_Unbounded_String (File_Path);
               Test.Expect := To_Unbounded_String (Expect_Path & "/" & Simple);
               Test.Result := To_Unbounded_String (Result_Path & "/" & Simple);
               Suite.Add_Test (Test);
            end if;
         end;
      end loop;
   end Add_Tests;

end ASF.Applications.Views.Tests;

Update unit test

Update unit test


-----------------------------------------------------------------------
--  druss-commands -- Commands available for Druss
--  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 Druss.Commands.Bboxes;
with Druss.Commands.Get;
with Druss.Commands.Status;
with Druss.Commands.Wifi;
package body Druss.Commands is

   Help_Command    : aliased Druss.Commands.Drivers.Help_Command_Type;
   Bbox_Commands   : aliased Druss.Commands.Bboxes.Command_Type;
   Get_Commands    : aliased Druss.Commands.Get.Command_Type;
   Wifi_Commands   : aliased Druss.Commands.Wifi.Command_Type;
   Status_Commands : aliased Druss.Commands.Status.Command_Type;

   procedure Gateway_Command (Command   : in Drivers.Command_Type'Class;
                              Args      : in Util.Commands.Argument_List'Class;
                              Arg_Pos   : in Positive;
                              Process   : access procedure (Gateway : in out Gateways.Gateway_Type;
                                                            Param   : in String);
                              Context   : in out Context_Type) is

   begin
      if Args.Get_Count < Arg_Pos + 1 then
         Druss.Commands.Driver.Usage (Args);
      end if;
      declare
         Param  : constant String := Args.Get_Argument (Arg_Pos);
         Gw     : Druss.Gateways.Gateway_Ref;

         procedure Operation (Gateway : in out Druss.Gateways.Gateway_Type) is
         begin
            Process (Gateway, Param);
         end Operation;

      begin
         if Args.Get_Count = Arg_Pos then
            Druss.Gateways.Iterate (Context.Gateways, Operation'Access);
         else
            for I in Arg_Pos + 1 .. Args.Get_Count loop
               Gw := Druss.Gateways.Find_IP (Context.Gateways, Args.Get_Argument (I));
               if not Gw.Is_Null then
                  Operation (Gw.Value.all);
               end if;
            end loop;
         end if;
      end;
   end Gateway_Command;

   procedure Initialize is
   begin
      Driver.Set_Description ("Druss - The Bbox master controller");
      Driver.Set_Usage ("[-v] [-o file] [-c config] <command> [<args>]" & ASCII.LF &
                          "where:" & ASCII.LF &
                          "  -v         Verbose execution mode" & ASCII.LF &
                          "  -c config  Use the configuration file" &
                          " (instead of $HOME/.config/druss/druss.properties)" & ASCII.LF &
                          "  -o file    The output file to use");
      Driver.Add_Command ("help", Help_Command'Access);
      Driver.Add_Command ("bbox", Bbox_Commands'Access);
      Driver.Add_Command ("get", Get_Commands'Access);
      Driver.Add_Command ("wifi", Wifi_Commands'Access);
      Driver.Add_Command ("status", Status_Commands'Access);
   end Initialize;

   --  ------------------------------
   --  Print the bbox API status.
   --  ------------------------------
   procedure Print_Status (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String) is
   begin
      if Value = "2" then
         Console.Print_Field (Field, "OK");
      elsif Value = "-1" then
         Console.Print_Field (Field, "KO");
      elsif Value = "1" then
         Console.Print_Field (Field, "Starting");
      elsif Value = "0" then
         Console.Print_Field (Field, "Stopped");
      else
         Console.Print_Field (Field, "?");
      end if;
   end Print_Status;

end Druss.Commands;

-----------------------------------------------------------------------
--  druss-commands -- Commands available for Druss
--  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 Druss.Commands.Bboxes;
with Druss.Commands.Get;
with Druss.Commands.Status;
with Druss.Commands.Wifi;
package body Druss.Commands is

   Help_Command    : aliased Druss.Commands.Drivers.Help_Command_Type;
   Bbox_Commands   : aliased Druss.Commands.Bboxes.Command_Type;
   Get_Commands    : aliased Druss.Commands.Get.Command_Type;
   Wifi_Commands   : aliased Druss.Commands.Wifi.Command_Type;
   Status_Commands : aliased Druss.Commands.Status.Command_Type;

   procedure Gateway_Command (Command   : in Drivers.Command_Type'Class;
                              Args      : in Util.Commands.Argument_List'Class;
                              Arg_Pos   : in Positive;
                              Process   : access procedure (Gateway : in out Gateways.Gateway_Type;
                                                            Param   : in String);
                              Context   : in out Context_Type) is

   begin
      if Args.Get_Count < Arg_Pos + 1 then
         Druss.Commands.Driver.Usage (Args);
      end if;
      declare
         Param  : constant String := Args.Get_Argument (Arg_Pos);
         Gw     : Druss.Gateways.Gateway_Ref;

         procedure Operation (Gateway : in out Druss.Gateways.Gateway_Type) is
         begin
            Process (Gateway, Param);
         end Operation;

      begin
         if Args.Get_Count = Arg_Pos then
            Druss.Gateways.Iterate (Context.Gateways, Operation'Access);
         else
            for I in Arg_Pos + 1 .. Args.Get_Count loop
               Gw := Druss.Gateways.Find_IP (Context.Gateways, Args.Get_Argument (I));
               if not Gw.Is_Null then
                  Operation (Gw.Value.all);
               end if;
            end loop;
         end if;
      end;
   end Gateway_Command;

   procedure Initialize is
   begin
      Driver.Set_Description ("Druss - The Bbox master controller");
      Driver.Set_Usage ("[-v] [-o file] [-c config] <command> [<args>]" & ASCII.LF &
                          "where:" & ASCII.LF &
                          "  -v         Verbose execution mode" & ASCII.LF &
                          "  -c config  Use the configuration file" &
                          " (instead of $HOME/.config/druss/druss.properties)" & ASCII.LF &
                          "  -o file    The output file to use");
      Driver.Add_Command ("help", Help_Command'Access);
      Driver.Add_Command ("bbox", Bbox_Commands'Access);
      Driver.Add_Command ("get", Get_Commands'Access);
      Driver.Add_Command ("wifi", Wifi_Commands'Access);
      Driver.Add_Command ("status", Status_Commands'Access);
   end Initialize;

   --  ------------------------------
   --  Print the bbox API status.
   --  ------------------------------
   procedure Print_Status (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String) is
   begin
      if Value = "2" then
         Console.Print_Field (Field, "OK");
      elsif Value = "-1" then
         Console.Print_Field (Field, "KO");
      elsif Value = "1" then
         Console.Print_Field (Field, "Starting");
      elsif Value = "0" then
         Console.Print_Field (Field, "Stopped");
      else
         Console.Print_Field (Field, "?");
      end if;
   end Print_Status;

   --  ------------------------------
   --  Print a ON/OFF status.
   --  ------------------------------
   procedure Print_On_Off (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String) is
   begin
      if Value = "1" then
         Console.Print_Field (Field, "ON");
      elsif Value = "0" then
         Console.Print_Field (Field, "OFF");
      else
         Console.Print_Field (Field, "");
      end if;
   end Print_On_Off;

end Druss.Commands;

Implement the Print_On_Off procedure

Implement the Print_On_Off procedure


-----------------------------------------------------------------------
--  awa-commands-setup -- Setup command to start and configure the application
--  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.
-----------------------------------------------------------------------

with AWA.Applications;
with AWA.Setup.Applications;
with Servlet.Core;

package body AWA.Commands.Setup is

   use AWA.Applications;

   package Command_Drivers renames Start_Command.Command_Drivers;

   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Name);

      procedure Find_Application (Name : in String);
      procedure Enable_Application (URI : in String;
                                    App : in Servlet.Core.Servlet_Registry_Access);

      Count    : Natural := 0;
      Selected : Application_Access;

      procedure Find_Application (Name : in String) is
         procedure Find (URI : in String;
                         App : in Servlet.Core.Servlet_Registry_Access);

         procedure Find (URI : in String;
                         App : in Servlet.Core.Servlet_Registry_Access) is
         begin
            App.Disable;
            if URI (URI'First + 1 .. URI'Last) = Name then
               if App.all in Application'Class then
                  Selected := Application'Class (App.all)'Unchecked_Access;
                  Count := Count + 1;
               end if;
            end if;
         end Find;

      begin
         Command_Drivers.WS.Iterate (Find'Access);
      end Find_Application;

      procedure Enable_Application (URI : in String;
                                    App : in Servlet.Core.Servlet_Registry_Access) is
         pragma Unreferenced (URI);
      begin
         App.Enable;
         App.Start;
      end Enable_Application;

      S : aliased AWA.Setup.Applications.Application;
   begin
      if Args.Get_Count /= 1 then
         Context.Console.Notice (N_ERROR, -("Missing application name"));
         return;
      end if;

      declare
         Name : constant String := Args.Get_Argument (1);
      begin
         Find_Application (Name);
         if Count /= 1 then
            Context.Console.Notice (N_ERROR, -("No application found"));
            return;
         end if;

         Command.Configure_Server (Context);
         Command.Start_Server (Context);
         S.Setup (Name, Command_Drivers.WS);
         Command.Configure_Applications (Context);
         S.Status.Set (AWA.Setup.Applications.READY);
         delay 2.0;
         Command_Drivers.WS.Remove_Application (S'Unchecked_Access);
         Command_Drivers.WS.Iterate (Enable_Application'Access);
         Command.Wait_Server (Context);
      end;
   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
      Start_Command.Command_Type (Command).Setup (Config, Context);
   end Setup;

begin
   Command_Drivers.Driver.Add_Command ("setup",
                                       -("start the web server and setup the application"),
                                       Command'Access);
end AWA.Commands.Setup;

-----------------------------------------------------------------------
--  awa-commands-setup -- Setup command to start and configure the application
--  Copyright (C) 2020, 2021 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 AWA.Applications;
with AWA.Setup.Applications;
with Servlet.Core;

package body AWA.Commands.Setup is

   use AWA.Applications;

   package Command_Drivers renames Start_Command.Command_Drivers;

   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Name);

      procedure Find_Application (Name : in String);
      procedure Enable_Application (URI : in String;
                                    App : in Servlet.Core.Servlet_Registry_Access);

      Count    : Natural := 0;

      procedure Find_Application (Name : in String) is
         procedure Find (URI : in String;
                         App : in Servlet.Core.Servlet_Registry_Access);

         procedure Find (URI : in String;
                         App : in Servlet.Core.Servlet_Registry_Access) is
         begin
            App.Disable;
            if URI (URI'First + 1 .. URI'Last) = Name then
               if App.all in Application'Class then
                  Count := Count + 1;
               end if;
            end if;
         end Find;

      begin
         Command_Drivers.WS.Iterate (Find'Access);
      end Find_Application;

      procedure Enable_Application (URI : in String;
                                    App : in Servlet.Core.Servlet_Registry_Access) is
         pragma Unreferenced (URI);
      begin
         App.Enable;
         App.Start;
      end Enable_Application;

      S : aliased AWA.Setup.Applications.Application;
   begin
      if Args.Get_Count /= 1 then
         Context.Console.Notice (N_ERROR, -("Missing application name"));
         return;
      end if;

      declare
         Name : constant String := Args.Get_Argument (1);
      begin
         Find_Application (Name);
         if Count /= 1 then
            Context.Console.Notice (N_ERROR, -("No application found"));
            return;
         end if;

         Command.Configure_Server (Context);
         Command.Start_Server (Context);
         S.Setup (Name, Command_Drivers.WS);
         Command.Configure_Applications (Context);
         S.Status.Set (AWA.Setup.Applications.READY);
         delay 2.0;
         Command_Drivers.WS.Remove_Application (S'Unchecked_Access);
         Command_Drivers.WS.Iterate (Enable_Application'Access);
         Command.Wait_Server (Context);
      end;
   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
      Start_Command.Command_Type (Command).Setup (Config, Context);
   end Setup;

begin
   Command_Drivers.Driver.Add_Command ("setup",
                                       -("start the web server and setup the application"),
                                       Command'Access);
end AWA.Commands.Setup;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  awa-wikis-previews -- Wiki preview management
--  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 Ada.Strings.Unbounded;

with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Files;
with Util.Processes;
with Util.Streams.Pipes;
with Util.Streams.Texts;

with ADO;

with EL.Contexts.TLS;

with ASF.Servlets;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;

with AWA.Applications;
with AWA.Services.Contexts;
with AWA.Modules.Get;
package body AWA.Wikis.Previews is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Wikis.Preview");

   --  ------------------------------
   --  The worker procedure that performs the preview job.
   --  ------------------------------
   procedure Preview_Worker (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
      Previewer : constant Preview_Module_Access := Get_Preview_Module;
   begin
      Previewer.Do_Preview_Job (Job);
   end Preview_Worker;

   --  ------------------------------
   --  Initialize the wikis module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Preview_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the wiki preview module");

      AWA.Modules.Module (Plugin).Initialize (App, Props);
   end Initialize;

   --  ------------------------------
   --  Configures the module after its initialization and after having read its XML configuration.
   --  ------------------------------
   overriding
   procedure Configure (Plugin : in out Preview_Module;
                        Props  : in ASF.Applications.Config) is
      pragma Unreferenced (Props);
   begin
      Plugin.Template := Plugin.Get_Config (PARAM_PREVIEW_TEMPLATE);
      Plugin.Command := Plugin.Get_Config (PARAM_PREVIEW_COMMAND);
      Plugin.Html := Plugin.Get_Config (PARAM_PREVIEW_HTML);
      Plugin.Add_Listener (AWA.Wikis.Modules.NAME, Plugin'Unchecked_Access);
      Plugin.Job_Module := AWA.Jobs.Modules.Get_Job_Module;
      Plugin.Job_Module.Register (Definition => Preview_Job_Definition.Factory);
   end Configure;

   --  ------------------------------
   --  Execute the preview job and make the thumbnail preview.  The page is first rendered in
   --  an HTML text file and the preview is rendered by using an external command.
   --  ------------------------------
   procedure Do_Preview_Job (Plugin : in Preview_Module;
                             Job    : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
      pragma Unreferenced (Job);
      use Util.Beans.Objects;

      Ctx       : constant EL.Contexts.ELContext_Access := EL.Contexts.TLS.Current;
      Template  : constant String := To_String (Plugin.Template.Get_Value (Ctx.all));
      Command   : constant String := To_String (Plugin.Command.Get_Value (Ctx.all));
      Html_File : constant String := To_String (Plugin.Html.Get_Value (Ctx.all));
   begin
      Log.Info ("Preview {0} with {1}", Template, Command);
      declare
         Req       : ASF.Requests.Mockup.Request;
         Reply     : ASF.Responses.Mockup.Response;
         Dispatcher : constant ASF.Servlets.Request_Dispatcher
           := Plugin.Get_Application.Get_Request_Dispatcher (Template);
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Req.Set_Request_URI (Template);
         Req.Set_Method ("GET");

         ASF.Servlets.Forward (Dispatcher, Req, Reply);
         Reply.Read_Content (Result);
         Util.Files.Write_File (Html_File, Result);
      end;

      declare
         Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
         Input   : Util.Streams.Texts.Reader_Stream;
      begin
         Log.Info ("Running preview command {0}", Command);

         Pipe.Open (Command, Util.Processes.READ_ALL);
         Input.Initialize (null, Pipe'Unchecked_Access, 1024);
         while not Input.Is_Eof loop
            declare
               Line : Ada.Strings.Unbounded.Unbounded_String;
            begin
               Input.Read_Line (Line, False);
               Log.Info ("Received: {0}", Line);
            end;
         end loop;
         Pipe.Close;
         if Pipe.Get_Exit_Status /= 0 then
            Log.Error ("Command {0} exited with status {1}", Command,
                       Integer'Image (Pipe.Get_Exit_Status));
         end if;
      end;
   end Do_Preview_Job;

   --  ------------------------------
   --  Create a preview job and schedule the job to generate a new thumbnail preview for the page.
   --  ------------------------------
   procedure Make_Preview_Job (Plugin : in Preview_Module;
                               Page   : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
      pragma Unreferenced (Plugin);

      J : AWA.Jobs.Services.Job_Type;
   begin
      J.Set_Parameter ("wiki_space_id", Page.Get_Wiki);
      J.Set_Parameter ("wiki_page_id", Page);
      J.Schedule (Preview_Job_Definition.Factory.all);
   end Make_Preview_Job;

   --  ------------------------------
   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the page.
   --  ------------------------------
   overriding
   procedure On_Create (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      Instance.Make_Preview_Job (Item);
   end On_Create;

   --  ------------------------------
   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the page.
   --  ------------------------------
   overriding
   procedure On_Update (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      Instance.Make_Preview_Job (Item);
   end On_Update;

   --  ------------------------------
   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the page.
   --  ------------------------------
   overriding
   procedure On_Delete (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      null;
   end On_Delete;

   --  ------------------------------
   --  Get the preview module instance associated with the current application.
   --  ------------------------------
   function Get_Preview_Module return Preview_Module_Access is
      function Get is new AWA.Modules.Get (Preview_Module, Preview_Module_Access, NAME);
   begin
      return Get;
   end Get_Preview_Module;

end AWA.Wikis.Previews;

-----------------------------------------------------------------------
--  awa-wikis-previews -- Wiki preview management
--  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 Ada.Strings.Unbounded;

with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Files;
with Util.Processes;
with Util.Streams.Pipes;
with Util.Streams.Texts;

with ADO;

with EL.Contexts.TLS;

with ASF.Servlets;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;

with AWA.Applications;
with AWA.Services.Contexts;
with AWA.Modules.Get;
package body AWA.Wikis.Previews is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Wikis.Preview");

   --  ------------------------------
   --  The worker procedure that performs the preview job.
   --  ------------------------------
   procedure Preview_Worker (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
      Previewer : constant Preview_Module_Access := Get_Preview_Module;
   begin
      Previewer.Do_Preview_Job (Job);
   end Preview_Worker;

   --  ------------------------------
   --  Initialize the wikis module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Preview_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the wiki preview module");

      AWA.Modules.Module (Plugin).Initialize (App, Props);
   end Initialize;

   --  ------------------------------
   --  Configures the module after its initialization and after having read its XML configuration.
   --  ------------------------------
   overriding
   procedure Configure (Plugin : in out Preview_Module;
                        Props  : in ASF.Applications.Config) is
      pragma Unreferenced (Props);
   begin
      Plugin.Template := Plugin.Get_Config (PARAM_PREVIEW_TEMPLATE);
      Plugin.Command := Plugin.Get_Config (PARAM_PREVIEW_COMMAND);
      Plugin.Html := Plugin.Get_Config (PARAM_PREVIEW_HTML);
      Plugin.Add_Listener (AWA.Wikis.Modules.NAME, Plugin'Unchecked_Access);
      Plugin.Job_Module := AWA.Jobs.Modules.Get_Job_Module;
      Plugin.Job_Module.Register (Definition => Preview_Job_Definition.Factory);
   end Configure;

   --  ------------------------------
   --  Execute the preview job and make the thumbnail preview.  The page is first rendered in
   --  an HTML text file and the preview is rendered by using an external command.
   --  ------------------------------
   procedure Do_Preview_Job (Plugin : in Preview_Module;
                             Job    : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
      pragma Unreferenced (Job);
      use Util.Beans.Objects;

      Ctx       : constant EL.Contexts.ELContext_Access := EL.Contexts.TLS.Current;
      Template  : constant String := To_String (Plugin.Template.Get_Value (Ctx.all));
      Command   : constant String := To_String (Plugin.Command.Get_Value (Ctx.all));
      Html_File : constant String := To_String (Plugin.Html.Get_Value (Ctx.all));
   begin
      Log.Info ("Preview {0} with {1}", Template, Command);
      declare
         Req       : ASF.Requests.Mockup.Request;
         Reply     : ASF.Responses.Mockup.Response;
         Dispatcher : constant ASF.Servlets.Request_Dispatcher
           := Plugin.Get_Application.Get_Request_Dispatcher (Template);
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Req.Set_Request_URI (Template);
         Req.Set_Method ("GET");

         ASF.Servlets.Forward (Dispatcher, Req, Reply);
         Reply.Read_Content (Result);
         Util.Files.Write_File (Html_File, Result);
      end;

      declare
         Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
         Input   : Util.Streams.Texts.Reader_Stream;
      begin
         Log.Info ("Running preview command {0}", Command);

         Pipe.Open (Command, Util.Processes.READ_ALL);
         Input.Initialize (Pipe'Unchecked_Access, 1024);
         while not Input.Is_Eof loop
            declare
               Line : Ada.Strings.Unbounded.Unbounded_String;
            begin
               Input.Read_Line (Line, False);
               Log.Info ("Received: {0}", Line);
            end;
         end loop;
         Pipe.Close;
         if Pipe.Get_Exit_Status /= 0 then
            Log.Error ("Command {0} exited with status {1}", Command,
                       Integer'Image (Pipe.Get_Exit_Status));
         end if;
      end;
   end Do_Preview_Job;

   --  ------------------------------
   --  Create a preview job and schedule the job to generate a new thumbnail preview for the page.
   --  ------------------------------
   procedure Make_Preview_Job (Plugin : in Preview_Module;
                               Page   : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
      pragma Unreferenced (Plugin);

      J : AWA.Jobs.Services.Job_Type;
   begin
      J.Set_Parameter ("wiki_space_id", Page.Get_Wiki);
      J.Set_Parameter ("wiki_page_id", Page);
      J.Schedule (Preview_Job_Definition.Factory.all);
   end Make_Preview_Job;

   --  ------------------------------
   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the page.
   --  ------------------------------
   overriding
   procedure On_Create (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      Instance.Make_Preview_Job (Item);
   end On_Create;

   --  ------------------------------
   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the page.
   --  ------------------------------
   overriding
   procedure On_Update (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      Instance.Make_Preview_Job (Item);
   end On_Update;

   --  ------------------------------
   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the page.
   --  ------------------------------
   overriding
   procedure On_Delete (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      null;
   end On_Delete;

   --  ------------------------------
   --  Get the preview module instance associated with the current application.
   --  ------------------------------
   function Get_Preview_Module return Preview_Module_Access is
      function Get is new AWA.Modules.Get (Preview_Module, Preview_Module_Access, NAME);
   begin
      return Get;
   end Get_Preview_Module;

end AWA.Wikis.Previews;

Update initialization of input reader stream


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

with ADO.Drivers;

with ASF.Server.Web;
with ASF.Navigations;
with ASF.Server.Tests;

with ASF.Tests;

with AWA.Users.Module;
with AWA.Mail.Module;
with AWA.Applications;
package body AWA.Tests is

   App      : AWA.Applications.Application_Access := null;

   Users    : aliased AWA.Users.Module.User_Module;

   --  ------------------------------
   --  Initialize the awa test framework mockup.
   --  ------------------------------
   procedure Initialize (Props : in Util.Properties.Manager) is
      use AWA.Applications;
   begin
      ADO.Drivers.Initialize (Props);

      App := new AWA.Applications.Application;

      ASF.Tests.Initialize (Props, App.all'Access);
      declare
         Nav : constant ASF.Navigations.Navigation_Handler_Access := App.Get_Navigation_Handler;
         Users : AWA.Users.Module.User_Module_Access := AWA.Tests.Users'Access;
      begin
         Register (App    => App.all'Access,
                   Name   =>  AWA.Users.Module.NAME, URI => "user",
                   Module => Users.all'Access);

         Register (App    => App.all'Access,
                   Name   => "mail", URI => "mail",
                   Module => AWA.Mail.Module.Instance.all'Access);

         Nav.Add_Navigation_Case (From    => "/users/login.xhtml",
                                  To      => "/users/main.xhtml",
                                  Outcome => "success");
         Nav.Add_Navigation_Case (From    => "/users/register.xhtml",
                                  To      => "/users/registration-sent.xhtml",
                                  Outcome => "success");

         --           if Props.Exists ("test.server") then
         --              declare
         --                 WS : ASF.Server.Web.AWS_Container;
         --              begin
         --                 WS.Register_Application ("/awa", App.all'Access);
         --
         --                 WS.Start;
         --                 delay 600.0;
         --              end;
         --           end if;
         ASF.Server.Tests.Set_Context (App.all'Access);
      end;
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return App;
   end Get_Application;

end AWA.Tests;

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

with ADO.Drivers;

with ASF.Server.Web;
with ASF.Navigations;
with ASF.Server.Tests;

with ASF.Tests;

with AWA.Users.Module;
with AWA.Mail.Module;
with AWA.Applications;
with AWA.Services.Filters;
package body AWA.Tests is

   App      : AWA.Applications.Application_Access := null;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   Users          : aliased AWA.Users.Module.User_Module;

   --  ------------------------------
   --  Initialize the awa test framework mockup.
   --  ------------------------------
   procedure Initialize (Props : in Util.Properties.Manager) is
      use AWA.Applications;
   begin
      ADO.Drivers.Initialize (Props);

      App := new AWA.Applications.Application;

      ASF.Tests.Initialize (Props, App.all'Access);
      App.Add_Filter ("service", Service_Filter'Access);
      App.Add_Filter_Mapping (Name => "service", Pattern => "*.html");

      declare
         Nav : constant ASF.Navigations.Navigation_Handler_Access := App.Get_Navigation_Handler;
         Users : AWA.Users.Module.User_Module_Access := AWA.Tests.Users'Access;
      begin
         Register (App    => App.all'Access,
                   Name   =>  AWA.Users.Module.NAME, URI => "user",
                   Module => Users.all'Access);

         Register (App    => App.all'Access,
                   Name   => "mail", URI => "mail",
                   Module => AWA.Mail.Module.Instance.all'Access);

         Nav.Add_Navigation_Case (From    => "/users/login.xhtml",
                                  To      => "/users/main.xhtml",
                                  Outcome => "success");
         Nav.Add_Navigation_Case (From    => "/users/register.xhtml",
                                  To      => "/users/registration-sent.xhtml",
                                  Outcome => "success");

         --           if Props.Exists ("test.server") then
         --              declare
         --                 WS : ASF.Server.Web.AWS_Container;
         --              begin
         --                 WS.Register_Application ("/awa", App.all'Access);
         --
         --                 WS.Start;
         --                 delay 600.0;
         --              end;
         --           end if;
         ASF.Server.Tests.Set_Context (App.all'Access);
      end;
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return App;
   end Get_Application;

end AWA.Tests;

Add the service filter to setup the service context when simulating a web request


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

with ASF.Applications.Main;
with ASF.Applications.Views;
with ASF.Components.Root;
with ASF.Contexts.Writer;

package body ASF.Components.Ajax.Includes is

   --  ------------------------------
   --  Get the HTML layout that must be used for the include container.
   --  The default layout is a "div".
   --  Returns "div", "span", "pre", "b".
   --  ------------------------------
   function Get_Layout (UI      : in UIInclude;
                        Context : in ASF.Contexts.Faces.Faces_Context'Class) return String is
      Layout : constant String := UI.Get_Attribute (Name    => LAYOUT_ATTR_NAME,
                                                    Context => Context,
                                                    Default => "div");
   begin
      if Layout = "div" or Layout = "span" or Layout = "pre" or Layout = "b" then
         return Layout;
      else
         return "div";
      end if;
   end Get_Layout;

   --  ------------------------------
   --  The included XHTML file is rendered according to the async attribute:
   --
   --  When async is false, render the specified XHTML file in such a way that inner
   --  forms will be posted on the included view.
   --
   --  When async is true, trigger an AJAX call to include the specified
   --  XHTML view when the page is loaded.
   --
   --
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIInclude;
                              Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         App    : constant ASF.Contexts.Faces.Application_Access := Context.Get_Application;
         View_Handler : constant access ASF.Applications.Views.View_Handler'Class
           := App.Get_View_Handler;
         Id     : constant Ada.Strings.Unbounded.Unbounded_String := UI.Get_Client_Id;
         Layout : constant String := UIInclude'Class (UI).Get_Layout (Context);
         Async  : constant Boolean := UI.Get_Attribute (Name    => ASYNC_ATTR_NAME,
                                                        Context => Context,
                                                        Default => False);
         Page   : constant String := UI.Get_Attribute (Name    => SRC_ATTR_NAME,
                                                       Context => Context,
                                                       Default => "");
         Writer : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      begin
         Writer.Start_Element (Layout);
         UI.Render_Attributes (Context, Writer);

         --  In Async mode, generate the javascript code to trigger the async update of
         --  the generated div/span.
         if Async then
            Writer.Queue_Script ("ASF.Update(""");
            Writer.Queue_Script (Id);
            Writer.Queue_Script (""", """);
            Writer.Queue_Script (View_Handler.Get_Action_URL (Context, Page));
            Writer.Queue_Script (""");");
         else
            --  Include the view content as if the user fetched the patch.  This has almost the
            --  same final result except that the inner content is returned now and not by
            --  another async http GET request.
            declare
               View         : constant ASF.Components.Root.UIViewRoot := Context.Get_View_Root;
               Include_View : ASF.Components.Root.UIViewRoot;
               Is_Ajax      : constant Boolean := Context.Is_Ajax_Request;
               Content_Type : constant String := Context.Get_Response.Get_Content_Type;
            begin
               Context.Set_Ajax_Request (True);
               View_Handler.Restore_View (Page, Context, Include_View);
               Context.Set_View_Root (Include_View);
               View_Handler.Render_View (Context, Include_View);
               Context.Get_Response.Set_Content_Type (Content_Type);
               Context.Set_View_Root (View);
               Context.Set_Ajax_Request (Is_Ajax);

            exception
               when others =>
                  Context.Get_Response.Set_Content_Type (Content_Type);
                  Context.Set_View_Root (View);
                  Context.Set_Ajax_Request (Is_Ajax);
                  raise;
            end;
         end if;
         Writer.End_Element (Layout);
      end;
   end Encode_Children;

end ASF.Components.Ajax.Includes;

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

with ASF.Applications.Main;
with ASF.Applications.Views;
with ASF.Components.Root;
with ASF.Contexts.Writer;

package body ASF.Components.Ajax.Includes is

   --  ------------------------------
   --  Get the HTML layout that must be used for the include container.
   --  The default layout is a "div".
   --  Returns "div", "span", "pre", "b".
   --  ------------------------------
   function Get_Layout (UI      : in UIInclude;
                        Context : in ASF.Contexts.Faces.Faces_Context'Class) return String is
      Layout : constant String := UI.Get_Attribute (Name    => LAYOUT_ATTR_NAME,
                                                    Context => Context,
                                                    Default => "div");
   begin
      if Layout = "div" or Layout = "span" or Layout = "pre" or Layout = "b" then
         return Layout;
      else
         return "div";
      end if;
   end Get_Layout;

   --  ------------------------------
   --  The included XHTML file is rendered according to the async attribute:
   --
   --  When async is false, render the specified XHTML file in such a way that inner
   --  forms will be posted on the included view.
   --
   --  When async is true, trigger an AJAX call to include the specified
   --  XHTML view when the page is loaded.
   --
   --
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIInclude;
                              Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         App    : constant ASF.Contexts.Faces.Application_Access := Context.Get_Application;
         View_Handler : constant access ASF.Applications.Views.View_Handler'Class
           := App.Get_View_Handler;
         Id     : constant Ada.Strings.Unbounded.Unbounded_String := UI.Get_Client_Id;
         Layout : constant String := UIInclude'Class (UI).Get_Layout (Context);
         Async  : constant Boolean := UI.Get_Attribute (Name    => ASYNC_ATTR_NAME,
                                                        Context => Context,
                                                        Default => False);
         Page   : constant String := UI.Get_Attribute (Name    => SRC_ATTR_NAME,
                                                       Context => Context,
                                                       Default => "");
         Writer : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      begin
         Writer.Start_Element (Layout);
         UI.Render_Attributes (Context, Writer);

         --  In Async mode, generate the javascript code to trigger the async update of
         --  the generated div/span.
         if Async then
            Writer.Write_Attribute ("id", Id);
            Writer.Queue_Script ("ASF.Update(null,""");
            Writer.Queue_Script (View_Handler.Get_Action_URL (Context, Page));
            Writer.Queue_Script (""", ""#");
            Writer.Queue_Script (Id);
            Writer.Queue_Script (""");");
         else
            --  Include the view content as if the user fetched the patch.  This has almost the
            --  same final result except that the inner content is returned now and not by
            --  another async http GET request.
            declare
               View         : constant ASF.Components.Root.UIViewRoot := Context.Get_View_Root;
               Include_View : ASF.Components.Root.UIViewRoot;
               Is_Ajax      : constant Boolean := Context.Is_Ajax_Request;
               Content_Type : constant String := Context.Get_Response.Get_Content_Type;
            begin
               Context.Set_Ajax_Request (True);
               View_Handler.Restore_View (Page, Context, Include_View);
               Context.Set_View_Root (Include_View);
               View_Handler.Render_View (Context, Include_View);
               Context.Get_Response.Set_Content_Type (Content_Type);
               Context.Set_View_Root (View);
               Context.Set_Ajax_Request (Is_Ajax);

            exception
               when others =>
                  Context.Get_Response.Set_Content_Type (Content_Type);
                  Context.Set_View_Root (View);
                  Context.Set_Ajax_Request (Is_Ajax);
                  raise;
            end;
         end if;
         Writer.End_Element (Layout);
      end;
   end Encode_Children;

end ASF.Components.Ajax.Includes;

Fix generation of javascript when rendering an ajax include in async mode


-----------------------------------------------------------------------
--  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 + 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 Encoder_Stream) is
      Last_Pos : Ada.Streams.Stream_Element_Offset := Stream.Write_Pos - 1;
   begin
      if not Stream.Flushed then
         Stream.Transform.Finish (Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
                                  Last_Pos);
         Stream.Write_Pos := Last_Pos + 1;
         Output_Buffer_Stream (Stream).Flush;
         Stream.Flushed := True;
      end if;
   end Flush;

   overriding
   procedure Finalize (Stream : in out Encoder_Stream) is
   begin
      if not Stream.Flushed then
         Stream.Flush;
      end if;
      Output_Buffer_Stream (Stream).Finalize;
   end Finalize;

end Util.Streams.Buffered.Encoders;

-----------------------------------------------------------------------
--  util-streams-encoders -- Streams with encoding and decoding capabilities
--  Copyright (C) 2017, 2018, 2019, 2021 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 with a buffer of <b>Size</b> bytes.
   --  -----------------------
   procedure Initialize (Stream  : in out Encoder_Stream;
                         Size    : in Positive) is
   begin
      Buffer_Stream (Stream).Initialize (Size);
      Stream.No_Flush := True;
   end Initialize;

   --  -----------------------
   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   --  -----------------------
--   overriding
   procedure Produces (Stream  : in out Encoder_Stream;
                       Output  : access Output_Stream'Class;
                       Size    : in Positive) is
   begin
      Stream.Initialize (Size);
      Stream.Output := Output;
      Stream.No_Flush := False;
   end Produces;

   --  -----------------------
   --  Initialize the stream to read the given streams.
   --  -----------------------
   procedure Consumes (Stream  : in out Encoder_Stream;
                       Input   : access Input_Stream'Class;
                       Size    : in Positive) is
   begin
      Stream.Initialize (Size);
      Stream.Input := Input;
   end Consumes;

   --  -----------------------
   --  Close the sink.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Encoder_Stream) is
   begin
      Stream.Flush;
      if Stream.Output /= null then
         Stream.Output.Close;
      end if;
   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 or else Last_Pos = Stream.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;

   --  ------------------------------
   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   --  ------------------------------
   procedure Fill (Stream : in out Encoder_Stream) is
   begin
      if Stream.Input = null then
         Stream.Eof := True;
      else
         Stream.Input.Read (Stream.Buffer (1 .. Stream.Last), Stream.Write_Pos);
         Stream.Eof := Stream.Write_Pos < 1;
         if not Stream.Eof then
            Stream.Write_Pos := Stream.Write_Pos + 1;
         end if;
         Stream.Read_Pos := 1;
      end if;
   end Fill;

   --  -----------------------
   --  Read into the buffer as many bytes as possible and return in
   --  `last` the position of the last byte read.
   --  -----------------------
   overriding
   procedure Read (Stream : in out Encoder_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is
      Start : Stream_Element_Offset := Into'First;
      Pos   : Stream_Element_Offset := Stream.Read_Pos;
      Avail : Stream_Element_Offset;
      Last_Decoded  : Ada.Streams.Stream_Element_Offset;
      Last_Pos      : Ada.Streams.Stream_Element_Offset;
   begin
      while Start <= Into'Last loop
         Avail := Stream.Write_Pos - Pos;
         if Avail = 0 then
            Stream.Fill;
            Pos := Stream.Read_Pos;
            Avail := Stream.Write_Pos - Pos;
            if Avail <= 0 then
               Last := Start - 1;
               Stream.Transform.Finish
                 (Into    => Into (Start .. Into'Last),
                  Last    => Last);
               return;
            end if;
         end if;
         Stream.Transform.Transform
           (Data    => Stream.Buffer (Pos .. Pos + Avail - 1),
            Into    => Into (Start .. Into'Last),
            Last    => Last_Pos,
            Encoded => Last_Decoded);
         Stream.Read_Pos := Last_Decoded + 1;
         Start := Last_Pos + 1;
         exit when Stream.Read_Pos = Pos;
         Pos := Stream.Read_Pos;
      end loop;
      Last := Start - 1;
   end Read;

   --  -----------------------
   --  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
      if not Stream.Flushed
        and then Stream.Buffer /= null
        and then Stream.Write_Pos >= Stream.Buffer'First
      then
         Stream.Transform.Finish (Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
                                  Last_Pos);
         Stream.Write_Pos := Last_Pos + 1;
         if not Stream.No_Flush then
            if Stream.Write_Pos > 1 then
               if Stream.Output /= null then
                  Stream.Output.Write (Stream.Buffer (1 .. Stream.Write_Pos - 1));
               end if;
               Stream.Write_Pos := 1;
            end if;
            if Stream.Output /= null then
               Stream.Output.Flush;
            end if;
         end if;
         Stream.Flushed := True;
      end if;
   end Flush;

   overriding
   procedure Finalize (Stream : in out Encoder_Stream) is
   begin
      if not Stream.Flushed and then Stream.Buffer /= null then
         Stream.Flush;
      end if;
      Buffer_Stream (Stream).Finalize;
   end Finalize;

end Util.Streams.Buffered.Encoders;

Refactor the Util.Stream.Buffered stream - allow to use the target stream with Read (pull model) and Write (push model)