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

with GNAT.Regpat;

with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;

with Util.Files;

with ASF.Streams;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Servlets.Ajax;
with ASF.Servlets.Measures;
with ASF.Responses;
with ASF.Responses.Tools;

with ASF.Filters.Dump;
with ASF.Contexts.Faces;
with EL.Variables.Default;

package body ASF.Tests is

   use Ada.Strings.Unbounded;
   use Util.Tests;

   CONTEXT_PATH : constant String := "/asfunit";

   Server   : access ASF.Server.Container;

   App      : ASF.Applications.Main.Application_Access := null;
   Faces    : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files    : aliased ASF.Servlets.Files.File_Servlet;
   Ajax     : aliased ASF.Servlets.Ajax.Ajax_Servlet;
   Dump     : aliased ASF.Filters.Dump.Dump_Filter;
   Measures : aliased ASF.Servlets.Measures.Measure_Servlet;

   --  Save the response headers and content in a file
   procedure Save_Response (Name     : in String;
                            Response : in out ASF.Responses.Mockup.Response);

   --  ------------------------------
   --  Initialize the awa test framework mockup.
   --  ------------------------------
   procedure Initialize (Props       : in Util.Properties.Manager;
                         Application : in ASF.Applications.Main.Application_Access := null;
                         Factory     : in out ASF.Applications.Main.Application_Factory'Class) is
      use type ASF.Applications.Main.Application_Access;

      C        : ASF.Applications.Config;
   begin
      if Application /= null then
         App := Application;
      else
         App := new ASF.Applications.Main.Application;
      end if;

      Server := new ASF.Server.Container;
      Server.Register_Application (CONTEXT_PATH, App.all'Access);

      C.Copy (Props);
      App.Initialize (C, Factory);
      App.Register ("layoutMsg", "layout");
      App.Set_Global ("contextPath", CONTEXT_PATH);

      --  Register the servlets and filters
      App.Add_Servlet (Name => "faces", Server => Faces'Access);
      App.Add_Servlet (Name => "files", Server => Files'Access);
      App.Add_Servlet (Name => "ajax", Server => Ajax'Access);
      App.Add_Servlet (Name => "measures", Server => Measures'Access);
      App.Add_Filter (Name => "dump", Filter => Dump'Access);
      App.Add_Filter (Name => "measures", Filter => ASF.Filters.Filter'Class (Measures)'Access);

      --  Define servlet mappings
      App.Add_Mapping (Name => "faces", Pattern => "*.html");
      App.Add_Mapping (Name => "files", Pattern => "*.css");
      App.Add_Mapping (Name => "files", Pattern => "*.js");
      App.Add_Mapping (Name => "files", Pattern => "*.properties");
      App.Add_Mapping (Name => "files", Pattern => "*.xhtml");
      App.Add_Mapping (Name => "ajax", Pattern => "/ajax/*");
      App.Add_Mapping (Name => "measures", Pattern => "stats.xml");

      App.Add_Filter_Mapping (Name => "measures", Pattern => "*");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "/ajax/*");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "*.html");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "*.xhtml");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "*.css");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "/ajax/*");
   end Initialize;

   --  ------------------------------
   --  Get the server
   --  ------------------------------
   function Get_Server return access ASF.Server.Container is
   begin
      return Server;
   end Get_Server;

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

   --  ------------------------------
   --  Save the response headers and content in a file
   --  ------------------------------
   procedure Save_Response (Name     : in String;
                            Response : in out ASF.Responses.Mockup.Response) is
      use ASF.Responses;

      Info        : constant String := Tools.To_String (Reply         => Response,
                                                        Html          => False,
                                                        Print_Headers => True);
      Result_Path : constant String := Util.Tests.Get_Test_Path ("regtests/result");
      Content     : Unbounded_String;
      Stream      : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
   begin
      Response.Read_Content (Content);
      Stream.Write (Content);

      Insert (Content, 1, Info);
      Util.Files.Write_File (Result_Path & "/" & Name, Content);

   end Save_Response;

   --  ------------------------------
   --  Simulate a raw request.  The URI and method must have been set on the Request object.
   --  ------------------------------
   procedure Do_Req (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response) is
   begin
      --  For the purpose of writing tests, clear the buffer before invoking the service.
      Response.Clear;
      Server.Service (Request  => Request,
                      Response => Response);
   end Do_Req;

   --  ------------------------------
   --  Simulate a GET request on the given URI with the request parameters.
   --  Get the result in the response object.
   --  ------------------------------
   procedure Do_Get (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response;
                     URI      : in String;
                     Save     : in String := "") is
   begin
      Request.Set_Method (Method => "GET");
      Request.Set_Request_URI (URI => CONTEXT_PATH & URI);
      Request.Set_Protocol (Protocol => "HTTP/1.1");
      Do_Req (Request, Response);

      if Save'Length > 0 then
         Save_Response (Save, Response);
      end if;
   end Do_Get;

   --  ------------------------------
   --  Simulate a POST request on the given URI with the request parameters.
   --  Get the result in the response object.
   --  ------------------------------
   procedure Do_Post (Request  : in out ASF.Requests.Mockup.Request;
                      Response : in out ASF.Responses.Mockup.Response;
                      URI      : in String;
                      Save     : in String := "") is
   begin
      Request.Set_Method (Method => "POST");
      Request.Set_Request_URI (URI => CONTEXT_PATH & URI);
      Request.Set_Protocol (Protocol => "HTTP/1.1");
      Do_Req (Request, Response);

      if Save'Length > 0 then
         Save_Response (Save, Response);
      end if;
   end Do_Post;

   --  ------------------------------
   --  Check that the response body contains the string
   --  ------------------------------
   procedure Assert_Contains (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line) is
      Stream  : ASF.Streams.Print_Stream := Reply.Get_Output_Stream;
      Content : Unbounded_String;
   begin
      Reply.Read_Content (Content);
      Stream.Write (Content);

      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response", Source, Line);

      T.Assert (Condition => Index (Content, Value) > 0,
                Message   => Message & ": value '" & Value & "' not found",
                Source    => Source,
                Line      => Line);
   end Assert_Contains;

   --  ------------------------------
   --  Check that the response body matches the regular expression
   --  ------------------------------
   procedure Assert_Matches (T       : in Util.Tests.Test'Class;
                             Pattern : in String;
                             Reply   : in out ASF.Responses.Mockup.Response;
                             Message : in String := "Test failed";
                             Status  : in Natural := ASF.Responses.SC_OK;
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line) is
      use GNAT.Regpat;

      Stream  : ASF.Streams.Print_Stream := Reply.Get_Output_Stream;
      Content : Unbounded_String;
      Regexp  : constant Pattern_Matcher := Compile (Expression => Pattern,
                                                     Flags      => Multiple_Lines);
   begin
      Reply.Read_Content (Content);
      Stream.Write (Content);

      Assert_Equals (T, Status, Reply.Get_Status, "Invalid response", Source, Line);

      T.Assert (Condition => Match (Regexp, To_String (Content)),
                Message   => Message & ": does not match '" & Pattern & "'",
                Source    => Source,
                Line      => Line);
   end Assert_Matches;

   --  ------------------------------
   --  Check that the response body is a redirect to the given URI.
   --  ------------------------------
   procedure Assert_Redirect (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line) is
   begin
      Assert_Equals (T, ASF.Responses.SC_MOVED_TEMPORARILY, Reply.Get_Status,
                     "Invalid response", Source, Line);

      Util.Tests.Assert_Equals (T, Value, Reply.Get_Header ("Location"),
                                Message & ": missing Location",
                                Source, Line);
   end Assert_Redirect;

   --  ------------------------------
   --  Cleanup the test instance.
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out EL_Test) is
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Contexts.Default.Default_Context'Class,
                                        EL.Contexts.Default.Default_Context_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Variables.Variable_Mapper'Class,
                                        EL.Variables.Variable_Mapper_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Contexts.Default.Default_ELResolver'Class,
                                        EL.Contexts.Default.Default_ELResolver_Access);
   begin
      ASF.Contexts.Faces.Restore (null);
      Free (T.ELContext);
      Free (T.Variables);
      Free (T.Root_Resolver);
   end Tear_Down;

   --  ------------------------------
   --  Setup the test instance.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out EL_Test) is
   begin
      T.ELContext     := new EL.Contexts.Default.Default_Context;
      T.Root_Resolver := new EL.Contexts.Default.Default_ELResolver;
      T.Variables     := new EL.Variables.Default.Default_Variable_Mapper;
      T.ELContext.Set_Resolver (T.Root_Resolver.all'Access);
      T.ELContext.Set_Variable_Mapper (T.Variables.all'Access);
   end Set_Up;

end ASF.Tests;

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

with GNAT.Regpat;

with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;

with Util.Files;

with ASF.Streams;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Servlets.Ajax;
with ASF.Servlets.Measures;
with ASF.Responses;
with ASF.Responses.Tools;

with ASF.Filters.Dump;
with ASF.Contexts.Faces;
with EL.Variables.Default;

package body ASF.Tests is

   use Ada.Strings.Unbounded;
   use Util.Tests;

   CONTEXT_PATH : constant String := "/asfunit";

   Server   : access ASF.Server.Container;

   App      : ASF.Applications.Main.Application_Access := null;
   Faces    : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files    : aliased ASF.Servlets.Files.File_Servlet;
   Ajax     : aliased ASF.Servlets.Ajax.Ajax_Servlet;
   Dump     : aliased ASF.Filters.Dump.Dump_Filter;
   Measures : aliased ASF.Servlets.Measures.Measure_Servlet;

   --  Save the response headers and content in a file
   procedure Save_Response (Name     : in String;
                            Response : in out ASF.Responses.Mockup.Response);

   --  ------------------------------
   --  Initialize the awa test framework mockup.
   --  ------------------------------
   procedure Initialize (Props       : in Util.Properties.Manager;
                         Application : in ASF.Applications.Main.Application_Access := null;
                         Factory     : in out ASF.Applications.Main.Application_Factory'Class) is
      use type ASF.Applications.Main.Application_Access;

      C        : ASF.Applications.Config;
   begin
      if Application /= null then
         App := Application;
      else
         App := new ASF.Applications.Main.Application;
      end if;

      Server := new ASF.Server.Container;
      Server.Register_Application (CONTEXT_PATH, App.all'Access);

      C.Copy (Props);
      App.Initialize (C, Factory);
      App.Register ("layoutMsg", "layout");
      App.Set_Global ("contextPath", CONTEXT_PATH);

      --  Register the servlets and filters
      App.Add_Servlet (Name => "faces", Server => Faces'Access);
      App.Add_Servlet (Name => "files", Server => Files'Access);
      App.Add_Servlet (Name => "ajax", Server => Ajax'Access);
      App.Add_Servlet (Name => "measures", Server => Measures'Access);
      App.Add_Filter (Name => "dump", Filter => Dump'Access);
      App.Add_Filter (Name => "measures", Filter => ASF.Filters.Filter'Class (Measures)'Access);

      --  Define servlet mappings
      App.Add_Mapping (Name => "faces", Pattern => "*.html");
      App.Add_Mapping (Name => "files", Pattern => "*.css");
      App.Add_Mapping (Name => "files", Pattern => "*.js");
      App.Add_Mapping (Name => "files", Pattern => "*.properties");
      App.Add_Mapping (Name => "files", Pattern => "*.xhtml");
      App.Add_Mapping (Name => "ajax", Pattern => "/ajax/*");
      App.Add_Mapping (Name => "measures", Pattern => "stats.xml");

      App.Add_Filter_Mapping (Name => "measures", Pattern => "*");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "/ajax/*");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "*.html");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "*.xhtml");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "*.css");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "/ajax/*");
   end Initialize;

   --  ------------------------------
   --  Get the server
   --  ------------------------------
   function Get_Server return access ASF.Server.Container is
   begin
      return Server;
   end Get_Server;

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

   --  ------------------------------
   --  Save the response headers and content in a file
   --  ------------------------------
   procedure Save_Response (Name     : in String;
                            Response : in out ASF.Responses.Mockup.Response) is
      use ASF.Responses;

      Info        : constant String := Tools.To_String (Reply         => Response,
                                                        Html          => False,
                                                        Print_Headers => True);
      Result_Path : constant String := Util.Tests.Get_Test_Path ("regtests/result");
      Content     : Unbounded_String;
      Stream      : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
   begin
      Response.Read_Content (Content);
      Stream.Write (Content);

      Insert (Content, 1, Info);
      Util.Files.Write_File (Result_Path & "/" & Name, Content);

   end Save_Response;

   --  ------------------------------
   --  Simulate a raw request.  The URI and method must have been set on the Request object.
   --  ------------------------------
   procedure Do_Req (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response) is
   begin
      --  For the purpose of writing tests, clear the buffer before invoking the service.
      Response.Clear;
      Server.Service (Request  => Request,
                      Response => Response);
   end Do_Req;

   --  ------------------------------
   --  Simulate a GET request on the given URI with the request parameters.
   --  Get the result in the response object.
   --  ------------------------------
   procedure Do_Get (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response;
                     URI      : in String;
                     Save     : in String := "") is
   begin
      Request.Set_Method (Method => "GET");
      Request.Set_Request_URI (URI => CONTEXT_PATH & URI);
      Request.Set_Protocol (Protocol => "HTTP/1.1");
      Do_Req (Request, Response);

      if Save'Length > 0 then
         Save_Response (Save, Response);
      end if;
   end Do_Get;

   --  ------------------------------
   --  Simulate a POST request on the given URI with the request parameters.
   --  Get the result in the response object.
   --  ------------------------------
   procedure Do_Post (Request  : in out ASF.Requests.Mockup.Request;
                      Response : in out ASF.Responses.Mockup.Response;
                      URI      : in String;
                      Save     : in String := "") is
   begin
      Request.Set_Method (Method => "POST");
      Request.Set_Request_URI (URI => CONTEXT_PATH & URI);
      Request.Set_Protocol (Protocol => "HTTP/1.1");
      Do_Req (Request, Response);

      if Save'Length > 0 then
         Save_Response (Save, Response);
      end if;
   end Do_Post;

   --  ------------------------------
   --  Check that the response body contains the string
   --  ------------------------------
   procedure Assert_Contains (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line) is
      Stream  : ASF.Streams.Print_Stream := Reply.Get_Output_Stream;
      Content : Unbounded_String;
   begin
      Reply.Read_Content (Content);
      Stream.Write (Content);

      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response", Source, Line);

      T.Assert (Condition => Index (Content, Value) > 0,
                Message   => Message & ": value '" & Value & "' not found",
                Source    => Source,
                Line      => Line);
   end Assert_Contains;

   --  ------------------------------
   --  Check that the response body matches the regular expression
   --  ------------------------------
   procedure Assert_Matches (T       : in Util.Tests.Test'Class;
                             Pattern : in String;
                             Reply   : in out ASF.Responses.Mockup.Response;
                             Message : in String := "Test failed";
                             Status  : in Natural := ASF.Responses.SC_OK;
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line) is
      use GNAT.Regpat;

      Stream  : ASF.Streams.Print_Stream := Reply.Get_Output_Stream;
      Content : Unbounded_String;
      Regexp  : constant Pattern_Matcher := Compile (Expression => Pattern,
                                                     Flags      => Multiple_Lines);
   begin
      Reply.Read_Content (Content);
      Stream.Write (Content);

      Assert_Equals (T, Status, Reply.Get_Status, "Invalid response", Source, Line);

      T.Assert (Condition => Match (Regexp, To_String (Content)),
                Message   => Message & ": does not match '" & Pattern & "'",
                Source    => Source,
                Line      => Line);
   end Assert_Matches;

   --  ------------------------------
   --  Check that the response contains the given header.
   --  ------------------------------
   procedure Assert_Header (T       : in Util.Tests.Test'Class;
                            Header  : in String;
                            Value   : in String;
                            Reply   : in out ASF.Responses.Mockup.Response;
                            Message : in String := "Test failed";
                            Status  : in Natural := ASF.Responses.SC_OK;
                            Source  : String := GNAT.Source_Info.File;
                            Line    : Natural := GNAT.Source_Info.Line) is
   begin
      T.Assert (Condition => Reply.Contains_Header (Header),
                Message   => Message & ": missing header '" & Header & "'",
                Source    => Source,
                Line      => Line);
      Assert_Equals (T, Value, Reply.Get_Header (Header), Message, Source, Line);
   end Assert_Header;

   --  ------------------------------
   --  Check that the response body is a redirect to the given URI.
   --  ------------------------------
   procedure Assert_Redirect (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line) is
   begin
      Assert_Equals (T, ASF.Responses.SC_MOVED_TEMPORARILY, Reply.Get_Status,
                     "Invalid response", Source, Line);

      Util.Tests.Assert_Equals (T, Value, Reply.Get_Header ("Location"),
                                Message & ": missing Location",
                                Source, Line);
   end Assert_Redirect;

   --  ------------------------------
   --  Cleanup the test instance.
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out EL_Test) is
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Contexts.Default.Default_Context'Class,
                                        EL.Contexts.Default.Default_Context_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Variables.Variable_Mapper'Class,
                                        EL.Variables.Variable_Mapper_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Contexts.Default.Default_ELResolver'Class,
                                        EL.Contexts.Default.Default_ELResolver_Access);
   begin
      ASF.Contexts.Faces.Restore (null);
      Free (T.ELContext);
      Free (T.Variables);
      Free (T.Root_Resolver);
   end Tear_Down;

   --  ------------------------------
   --  Setup the test instance.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out EL_Test) is
   begin
      T.ELContext     := new EL.Contexts.Default.Default_Context;
      T.Root_Resolver := new EL.Contexts.Default.Default_ELResolver;
      T.Variables     := new EL.Variables.Default.Default_Variable_Mapper;
      T.ELContext.Set_Resolver (T.Root_Resolver.all'Access);
      T.ELContext.Set_Variable_Mapper (T.Variables.all'Access);
   end Set_Up;

end ASF.Tests;

Implement the Assert_Header procedure

Implement the Assert_Header procedure


-----------------------------------------------------------------------
--  awa-wikis-modules -- Module wikis
--  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 ASF.Applications;

with ADO;
with AWA.Modules;
with AWA.Wikis.Models;
with Security.Permissions;
with Awa.Wikis.Models;
package AWA.Wikis.Modules is

   --  The name under which the module is registered.
   NAME : constant String := "wikis";

   package ACL_Create_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-create");
   package ACL_Delete_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-delete");
   package ACL_Update_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-update");

   --  Define the permissions.
   package ACL_Create_Wiki_Space is new Security.Permissions.Definition ("wiki-space-create");
   package ACL_Delete_Wiki_Space is new Security.Permissions.Definition ("wiki-space-delete");
   package ACL_Update_Wiki_Space is new Security.Permissions.Definition ("wiki-space-update");

   --  ------------------------------
   --  Module wikis
   --  ------------------------------
   type Wiki_Module is new AWA.Modules.Module with private;
   type Wiki_Module_Access is access all Wiki_Module'Class;

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

   --  Get the wikis module.
   function Get_Wiki_Module return Wiki_Module_Access;

   --  Create the wiki space.
   procedure Create_Wiki_Space (Module : in Wiki_Module;
                                Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class);

   --  Save the wiki space.
   procedure Save_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class);

   --  Load the wiki space.
   procedure Load_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class;
                              Id     : in ADO.Identifier);

   --  Create the wiki page into the wiki space.
   procedure Create_Wiki_Page (Model  : in Wiki_Module;
                               Into   : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                               Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class);

   --  Save the wiki page.
   procedure Save (Model  : in Wiki_Module;
                   Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class);

private

   type Wiki_Module is new AWA.Modules.Module with null record;

end AWA.Wikis.Modules;

-----------------------------------------------------------------------
--  awa-wikis-modules -- Module wikis
--  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 ASF.Applications;

with ADO;
with AWA.Modules;
with AWA.Wikis.Models;
with Security.Permissions;
with Awa.Wikis.Models;
package AWA.Wikis.Modules is

   --  The name under which the module is registered.
   NAME : constant String := "wikis";

   package ACL_Create_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-create");
   package ACL_Delete_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-delete");
   package ACL_Update_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-update");

   --  Define the permissions.
   package ACL_Create_Wiki_Space is new Security.Permissions.Definition ("wiki-space-create");
   package ACL_Delete_Wiki_Space is new Security.Permissions.Definition ("wiki-space-delete");
   package ACL_Update_Wiki_Space is new Security.Permissions.Definition ("wiki-space-update");

   --  ------------------------------
   --  Module wikis
   --  ------------------------------
   type Wiki_Module is new AWA.Modules.Module with private;
   type Wiki_Module_Access is access all Wiki_Module'Class;

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

   --  Get the wikis module.
   function Get_Wiki_Module return Wiki_Module_Access;

   --  Create the wiki space.
   procedure Create_Wiki_Space (Module : in Wiki_Module;
                                Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class);

   --  Save the wiki space.
   procedure Save_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class);

   --  Load the wiki space.
   procedure Load_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class;
                              Id     : in ADO.Identifier);

   --  Create the wiki page into the wiki space.
   procedure Create_Wiki_Page (Model  : in Wiki_Module;
                               Into   : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                               Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class);

   --  Save the wiki page.
   procedure Save (Model  : in Wiki_Module;
                   Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class);

   --  Create a new wiki content for the wiki page.
   procedure Create_Wiki_Content (Model   : in Wiki_Module;
                                  Page    : in out Awa.Wikis.Models.Wiki_Page_Ref'Class;
                                  Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class);

private

   type Wiki_Module is new AWA.Modules.Module with null record;

end AWA.Wikis.Modules;

Declare the Create_Wiki_Content procedure


-----------------------------------------------------------------------
--  mat-consoles - Console interface
--  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 Ada.Strings.Unbounded;

with MAT.Types;
package MAT.Consoles is

   type Field_Type is (F_ADDR,
                       F_SIZE,
                       F_TOTAL_SIZE,
                       F_MIN_SIZE,
                       F_MAX_SIZE,
                       F_MIN_ADDR,
                       F_MAX_ADDR,
                       F_THREAD,
                       F_COUNT,
                       F_FILE_NAME,
                       F_FUNCTION_NAME,
                       F_LINE_NUMBER,
                       F_ID,
                       F_OLD_ADDR,
                       F_TIME,
                       F_EVENT,
                       F_MODE,
                       F_FRAME_ID,
                       F_RANGE_ADDR,
                       F_FRAME_ADDR);

   type Notice_Type is (N_HELP,
                        N_PID_INFO,
                        N_DURATION,
                        N_PATH_INFO);

   type Justify_Type is (J_LEFT,           --  Justify left   |item    |
                         J_RIGHT,          --  Justify right  |    item|
                         J_CENTER,         --  Justify center |  item  |
                         J_RIGHT_NO_FILL   --  Justify right  |item|
                        );

   type Console_Type is abstract tagged limited private;
   type Console_Access is access all Console_Type'Class;

   --  Report an error message.
   procedure Error (Console : in out Console_Type;
                    Message : in String) is abstract;

   --  Report a notice message.
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is abstract;

   --  Print the field value for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String;
                          Justify : in Justify_Type := J_LEFT) is abstract;

   --  Print the title for the given field.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is abstract;

   --  Start a new title in a report.
   procedure Start_Title (Console : in out Console_Type) is abstract;

   --  Finish a new title in a report.
   procedure End_Title (Console : in out Console_Type) is abstract;

   --  Start a new row in a report.
   procedure Start_Row (Console : in out Console_Type) is abstract;

   --  Finish a new row in a report.
   procedure End_Row (Console : in out Console_Type) is abstract;

   --  Print the title for the given field and setup the associated field size.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String;
                          Length  : in Positive);

   --  Format the address and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr);

   --  Format the address range and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          From    : in MAT.Types.Target_Addr;
                          To      : in MAT.Types.Target_Addr);

   --  Format the size and print it for the given field.
   procedure Print_Size (Console : in out Console_Type;
                         Field   : in Field_Type;
                         Size    : in MAT.Types.Target_Size);

   --  Format the thread information and print it for the given field.
   procedure Print_Thread (Console : in out Console_Type;
                           Field   : in Field_Type;
                           Thread  : in MAT.Types.Target_Thread_Ref);

   --  Format the time tick as a duration and print it for the given field.
   procedure Print_Duration (Console  : in out Console_Type;
                             Field    : in Field_Type;
                             Duration : in MAT.Types.Target_Tick_Ref);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Integer;
                          Justify : in Justify_Type := J_LEFT);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Ada.Strings.Unbounded.Unbounded_String;
                          Justify : in Justify_Type := J_LEFT);

private

   type Field_Size_Array is array (Field_Type) of Natural;

   type Field_List_Array is array (1 .. Field_Type'Pos (Field_Type'Last)) of Field_Type;

   type Console_Type is abstract tagged limited record
      Sizes       : Field_Size_Array := (others => 1);
      Cols        : Field_Size_Array := (others => 1);
      Fields      : Field_List_Array;
      Field_Count : Natural := 0;
   end record;

end MAT.Consoles;

-----------------------------------------------------------------------
--  mat-consoles - Console interface
--  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 Ada.Strings.Unbounded;

with MAT.Types;
package MAT.Consoles is

   type Field_Type is (F_ADDR,
                       F_SIZE,
                       F_TOTAL_SIZE,
                       F_MIN_SIZE,
                       F_MAX_SIZE,
                       F_MIN_ADDR,
                       F_MAX_ADDR,
                       F_THREAD,
                       F_COUNT,
                       F_FILE_NAME,
                       F_FUNCTION_NAME,
                       F_LINE_NUMBER,
                       F_ID,
                       F_OLD_ADDR,
                       F_TIME,
                       F_EVENT,
                       F_MODE,
                       F_FRAME_ID,
                       F_RANGE_ADDR,
                       F_FRAME_ADDR);

   type Notice_Type is (N_HELP,
                        N_EVENT_ID,
                        N_PID_INFO,
                        N_DURATION,
                        N_PATH_INFO);

   type Justify_Type is (J_LEFT,           --  Justify left   |item    |
                         J_RIGHT,          --  Justify right  |    item|
                         J_CENTER,         --  Justify center |  item  |
                         J_RIGHT_NO_FILL   --  Justify right  |item|
                        );

   type Console_Type is abstract tagged limited private;
   type Console_Access is access all Console_Type'Class;

   --  Report an error message.
   procedure Error (Console : in out Console_Type;
                    Message : in String) is abstract;

   --  Report a notice message.
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is abstract;

   --  Print the field value for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String;
                          Justify : in Justify_Type := J_LEFT) is abstract;

   --  Print the title for the given field.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is abstract;

   --  Start a new title in a report.
   procedure Start_Title (Console : in out Console_Type) is abstract;

   --  Finish a new title in a report.
   procedure End_Title (Console : in out Console_Type) is abstract;

   --  Start a new row in a report.
   procedure Start_Row (Console : in out Console_Type) is abstract;

   --  Finish a new row in a report.
   procedure End_Row (Console : in out Console_Type) is abstract;

   --  Print the title for the given field and setup the associated field size.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String;
                          Length  : in Positive);

   --  Format the address and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr);

   --  Format the address range and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          From    : in MAT.Types.Target_Addr;
                          To      : in MAT.Types.Target_Addr);

   --  Format the size and print it for the given field.
   procedure Print_Size (Console : in out Console_Type;
                         Field   : in Field_Type;
                         Size    : in MAT.Types.Target_Size);

   --  Format the thread information and print it for the given field.
   procedure Print_Thread (Console : in out Console_Type;
                           Field   : in Field_Type;
                           Thread  : in MAT.Types.Target_Thread_Ref);

   --  Format the time tick as a duration and print it for the given field.
   procedure Print_Duration (Console  : in out Console_Type;
                             Field    : in Field_Type;
                             Duration : in MAT.Types.Target_Tick_Ref);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Integer;
                          Justify : in Justify_Type := J_LEFT);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Ada.Strings.Unbounded.Unbounded_String;
                          Justify : in Justify_Type := J_LEFT);

private

   type Field_Size_Array is array (Field_Type) of Natural;

   type Field_List_Array is array (1 .. Field_Type'Pos (Field_Type'Last)) of Field_Type;

   type Console_Type is abstract tagged limited record
      Sizes       : Field_Size_Array := (others => 1);
      Cols        : Field_Size_Array := (others => 1);
      Fields      : Field_List_Array;
      Field_Count : Natural := 0;
   end record;

end MAT.Consoles;

Add N_EVENT_ID notice

Add N_EVENT_ID notice


-----------------------------------------------------------------------
--  awa-images-beans -- Image Ada Beans
--  Copyright (C) 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 ADO.Queries;
with ADO.Sessions;
with ADO.Objects;
with ADO.Sessions.Entities;

with AWA.Workspaces.Models;
with AWA.Services.Contexts;
with AWA.Storages.Modules;
package body AWA.Images.Beans is

   --  ------------------------------
   --  Load the list of images associated with the current folder.
   --  ------------------------------
   overriding
   procedure Load_Files (Storage : in Image_List_Bean) is
      use AWA.Services;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User      : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session   : ADO.Sessions.Session := Storage.Module.Get_Session;
      Query     : ADO.Queries.Context;
   begin
      if not Storage.Init_Flags (AWA.Storages.Beans.INIT_FOLDER) then
         Load_Folder (Storage);
      end if;
      Query.Set_Query (AWA.Images.Models.Query_Image_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      if Storage.Folder_Bean.Is_Null then
         Query.Bind_Null_Param ("folder_id");
      else
         Query.Bind_Param ("folder_id", Storage.Folder_Bean.Get_Id);
      end if;
      AWA.Images.Models.List (Storage.Image_List_Bean.all, Session, Query);
      Storage.Flags (AWA.Storages.Beans.INIT_FILE_LIST) := True;
   end Load_Files;

   overriding
   function Get_Value (List : in Image_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "images" then
         return Util.Beans.Objects.To_Object (Value   => List.Image_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folders" then
         return Util.Beans.Objects.To_Object (Value   => List.Folder_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folder" then
--           if not List.Init_Flags (INIT_FOLDER) then
--              Load_Folder (List);
--           end if;
         if List.Folder_Bean.Is_Null then
            return Util.Beans.Objects.Null_Object;
         end if;
         return Util.Beans.Objects.To_Object (Value   => List.Folder_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Create the Image_List_Bean bean instance.
   --  ------------------------------
   function Create_Image_List_Bean (Module : in AWA.Images.Modules.Image_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      pragma Unreferenced (Module);

      Object    : constant Image_List_Bean_Access := new Image_List_Bean;
   begin
      Object.Module           := AWA.Storages.Modules.Get_Storage_Module;
      Object.Folder_Bean      := Object.Folder'Access;
      Object.Folder_List_Bean := Object.Folder_List'Access;
      Object.Files_List_Bean  := Object.Files_List'Access;
      Object.Image_List_Bean  := Object.Image_List'Access;
      Object.Flags            := Object.Init_Flags'Access;
      return Object.all'Access;
   end Create_Image_List_Bean;

end AWA.Images.Beans;

-----------------------------------------------------------------------
--  awa-images-beans -- Image Ada Beans
--  Copyright (C) 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 ADO.Queries;
with ADO.Sessions;
with ADO.Objects;
with ADO.Sessions.Entities;

with AWA.Workspaces.Models;
with AWA.Services.Contexts;
with AWA.Storages.Modules;
package body AWA.Images.Beans is

   package ASC renames AWA.Services.Contexts;

   --  ------------------------------
   --  Load the list of images associated with the current folder.
   --  ------------------------------
   overriding
   procedure Load_Files (Storage : in Image_List_Bean) is
      use AWA.Services;

      Ctx       : constant ASC.Service_Context_Access := ASC.Current;
      User      : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session   : ADO.Sessions.Session := Storage.Module.Get_Session;
      Query     : ADO.Queries.Context;
   begin
      if not Storage.Init_Flags (AWA.Storages.Beans.INIT_FOLDER) then
         Load_Folder (Storage);
      end if;
      Query.Set_Query (AWA.Images.Models.Query_Image_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      if Storage.Folder_Bean.Is_Null then
         Query.Bind_Null_Param ("folder_id");
      else
         Query.Bind_Param ("folder_id", Storage.Folder_Bean.Get_Id);
      end if;
      AWA.Images.Models.List (Storage.Image_List_Bean.all, Session, Query);
      Storage.Flags (AWA.Storages.Beans.INIT_FILE_LIST) := True;
   end Load_Files;

   overriding
   function Get_Value (List : in Image_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "images" then
         return Util.Beans.Objects.To_Object (Value   => List.Image_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folders" then
         return Util.Beans.Objects.To_Object (Value   => List.Folder_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folder" then
--           if not List.Init_Flags (INIT_FOLDER) then
--              Load_Folder (List);
--           end if;
         if List.Folder_Bean.Is_Null then
            return Util.Beans.Objects.Null_Object;
         end if;
         return Util.Beans.Objects.To_Object (Value   => List.Folder_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Create the Image_List_Bean bean instance.
   --  ------------------------------
   function Create_Image_List_Bean (Module : in AWA.Images.Modules.Image_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      pragma Unreferenced (Module);

      Object    : constant Image_List_Bean_Access := new Image_List_Bean;
   begin
      Object.Module           := AWA.Storages.Modules.Get_Storage_Module;
      Object.Folder_Bean      := Object.Folder'Access;
      Object.Folder_List_Bean := Object.Folder_List'Access;
      Object.Files_List_Bean  := Object.Files_List'Access;
      Object.Image_List_Bean  := Object.Image_List'Access;
      Object.Flags            := Object.Init_Flags'Access;
      return Object.all'Access;
   end Create_Image_List_Bean;

   overriding
   procedure Load (Into    : in out Image_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      use type ADO.Identifier;
      use type Ada.Containers.Count_Type;
      use type Ada.Strings.Unbounded.Unbounded_String;

      Ctx     : constant ASC.Service_Context_Access := ASC.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session : ADO.Sessions.Session := ASC.Get_Session (Ctx);
      Query   : ADO.Queries.Context;
   begin
      if Into.Id = ADO.NO_IDENTIFIER then
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
         return;
      end if;

      --  Get the list of versions associated with the wiki page.
      Query.Set_Query (AWA.Images.Models.Query_Image_Info);
      Query.Bind_Param (Name => "user_id", Value => User);
      Query.Bind_Param (Name => "file_id", Value => Into.Id);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      Into.Load (Session, Query);
   end Load;

   --  Create the Image_Bean bean instance.
   function Create_Image_Bean (Module : in AWA.Images.Modules.Image_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Object    : constant Image_Bean_Access := new Image_Bean;
   begin
      Object.Module           := Module;
      return Object.all'Access;
   end Create_Image_Bean;

end AWA.Images.Beans;

Implement the Load and Create_Image_Bean operation


-----------------------------------------------------------------------
--  wiki-render-wiki -- Wiki to Wiki renderer
--  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.
-----------------------------------------------------------------------

with Wiki.Documents;
with Wiki.Attributes;
with Wiki.Writers;
with Wiki.Parsers;

--  == Wiki Renderer ==
--  The <tt>Wiki_Renderer</tt> allows to render a wiki document into another wiki content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Wiki is

   use Standard.Wiki.Attributes;

   --  ------------------------------
   --  Wiki to HTML writer
   --  ------------------------------
   type Wiki_Renderer is new Standard.Wiki.Documents.Document_Reader with private;

   --  Set the output writer.
   procedure Set_Writer (Document : in out Wiki_Renderer;
                         Writer   : in Writers.Writer_Type_Access;
                         Format   : in Parsers.Wiki_Syntax_Type);

   --  Add a section header in the document.
   overriding
   procedure Add_Header (Document : in out Wiki_Renderer;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive);

   --  Add a line break (
).
   overriding
   procedure Add_Line_Break (Document : in out Wiki_Renderer);

   --  Add a paragraph (
).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   overriding
   procedure Add_Paragraph (Document : in out Wiki_Renderer);

   --  Add a blockquote (
).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   overriding
   procedure Add_Blockquote (Document : in out Wiki_Renderer;
                             Level    : in Natural);

   --  Add a list item (
).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   overriding
   procedure Add_List_Item (Document : in out Wiki_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Add an horizontal rule (
).
   overriding
   procedure Add_Horizontal_Rule (Document : in out Wiki_Renderer);

   --  Add a link.
   overriding
   procedure Add_Link (Document : in out Wiki_Renderer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String);

   --  Add an image.
   overriding
   procedure Add_Image (Document    : in out Wiki_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String);

   --  Add a quote.
   overriding
   procedure Add_Quote (Document : in out Wiki_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String);

   --  Add a text block with the given format.
   overriding
   procedure Add_Text (Document : in out Wiki_Renderer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Documents.Format_Map);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Document : in out Wiki_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String);

   overriding
   procedure Start_Element (Document   : in out Wiki_Renderer;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Attribute_List_Type);

   overriding
   procedure End_Element (Document : in out Wiki_Renderer;
                          Name     : in Unbounded_Wide_Wide_String);

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

   --  Set the text style format.
   procedure Set_Format (Document : in out Wiki_Renderer;
                         Format   : in Documents.Format_Map);

private

   type Wide_String_Access is access constant Wide_Wide_String;

   type Wiki_Tag_Type is (Bold_Start, Bold_End, Italic_Start, Italic_End,
                          Underline_Start, Underline_End,
                          Header_Start, Header_End,
                          Img_Start, Img_End,
                          Link_Start, Link_End, Link_Separator,
                          Preformat_Start, Preformat_End,
                          List_Start, List_Item, List_Ordered_Item,
                          Line_Break,
                          Horizontal_Rule,
                          Blockquote_Start, Blockquote_End);

   type Wiki_Tag_Array is array (Wiki_Tag_Type) of Wide_String_Access;

   type Wiki_Format_Array is array (Documents.Format_Type) of Wide_String_Access;

   --  Emit a new line.
   procedure New_Line (Document : in out Wiki_Renderer);

   procedure Close_Paragraph (Document : in out Wiki_Renderer);
   procedure Open_Paragraph (Document : in out Wiki_Renderer);
   procedure Start_Keep_Content (Document : in out Wiki_Renderer);

   type List_Style_Array is array (1 .. 32) of Boolean;

   EMPTY_TAG : aliased constant Wide_Wide_String := "";

   type Wiki_Renderer is new Documents.Document_Reader with record
      Writer              : Writers.Writer_Type_Access := null;
      Syntax              : Parsers.Wiki_Syntax_Type := Parsers.SYNTAX_CREOLE;
      Format              : Documents.Format_Map := (others => False);
      Tags                : Wiki_Tag_Array := (others => EMPTY_TAG'Access);
      Style_Start_Tags    : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Style_End_Tags      : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Has_Paragraph       : Boolean := False;
      Has_Item            : Boolean := False;
      Need_Paragraph      : Boolean := False;
      Empty_Line          : Boolean := True;
      Keep_Content        : Boolean := False;
      In_List             : Boolean := False;
      Invert_Header_Level : Boolean := False;
      Allow_Link_Language : Boolean := False;
      Current_Level       : Natural := 0;
      Quote_Level         : Natural := 0;
      UL_List_Level       : Natural := 0;
      OL_List_Level       : Natural := 0;
      Current_Style       : Documents.Format_Map := (others => False);
      Content             : Unbounded_Wide_Wide_String;
      Link_Href           : Unbounded_Wide_Wide_String;
      Link_Title          : Unbounded_Wide_Wide_String;
      Link_Lang           : Unbounded_Wide_Wide_String;
   end record;

end Wiki.Render.Wiki;

-----------------------------------------------------------------------
--  wiki-render-wiki -- Wiki to Wiki renderer
--  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.
-----------------------------------------------------------------------

with Wiki.Documents;
with Wiki.Attributes;
with Wiki.Writers;
with Wiki.Parsers;

--  == Wiki Renderer ==
--  The <tt>Wiki_Renderer</tt> allows to render a wiki document into another wiki content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Wiki is

   use Standard.Wiki.Attributes;

   --  ------------------------------
   --  Wiki to HTML writer
   --  ------------------------------
   type Wiki_Renderer is new Standard.Wiki.Documents.Document_Reader with private;

   --  Set the output writer.
   procedure Set_Writer (Document : in out Wiki_Renderer;
                         Writer   : in Writers.Writer_Type_Access;
                         Format   : in Parsers.Wiki_Syntax_Type);

   --  Add a section header in the document.
   overriding
   procedure Add_Header (Document : in out Wiki_Renderer;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive);

   --  Add a line break (
).
   overriding
   procedure Add_Line_Break (Document : in out Wiki_Renderer);

   --  Add a paragraph (
).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   overriding
   procedure Add_Paragraph (Document : in out Wiki_Renderer);

   --  Add a blockquote (
).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   overriding
   procedure Add_Blockquote (Document : in out Wiki_Renderer;
                             Level    : in Natural);

   --  Add a list item (
).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   overriding
   procedure Add_List_Item (Document : in out Wiki_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Add an horizontal rule (
).
   overriding
   procedure Add_Horizontal_Rule (Document : in out Wiki_Renderer);

   --  Add a link.
   overriding
   procedure Add_Link (Document : in out Wiki_Renderer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String);

   --  Add an image.
   overriding
   procedure Add_Image (Document    : in out Wiki_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String);

   --  Add a quote.
   overriding
   procedure Add_Quote (Document : in out Wiki_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String);

   --  Add a text block with the given format.
   overriding
   procedure Add_Text (Document : in out Wiki_Renderer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Documents.Format_Map);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Document : in out Wiki_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String);

   overriding
   procedure Start_Element (Document   : in out Wiki_Renderer;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Attribute_List_Type);

   overriding
   procedure End_Element (Document : in out Wiki_Renderer;
                          Name     : in Unbounded_Wide_Wide_String);

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

   --  Set the text style format.
   procedure Set_Format (Document : in out Wiki_Renderer;
                         Format   : in Documents.Format_Map);

private

   type Wide_String_Access is access constant Wide_Wide_String;

   type Wiki_Tag_Type is (Header_Start, Header_End,
                          Img_Start, Img_End,
                          Link_Start, Link_End, Link_Separator,
                          Preformat_Start, Preformat_End,
                          List_Start, List_Item, List_Ordered_Item,
                          Line_Break,
                          Horizontal_Rule,
                          Blockquote_Start, Blockquote_End);

   type Wiki_Tag_Array is array (Wiki_Tag_Type) of Wide_String_Access;

   type Wiki_Format_Array is array (Documents.Format_Type) of Wide_String_Access;

   --  Emit a new line.
   procedure New_Line (Document : in out Wiki_Renderer);

   procedure Close_Paragraph (Document : in out Wiki_Renderer);
   procedure Open_Paragraph (Document : in out Wiki_Renderer);
   procedure Start_Keep_Content (Document : in out Wiki_Renderer);

   type List_Style_Array is array (1 .. 32) of Boolean;

   EMPTY_TAG : aliased constant Wide_Wide_String := "";

   type Wiki_Renderer is new Documents.Document_Reader with record
      Writer              : Writers.Writer_Type_Access := null;
      Syntax              : Parsers.Wiki_Syntax_Type := Parsers.SYNTAX_CREOLE;
      Format              : Documents.Format_Map := (others => False);
      Tags                : Wiki_Tag_Array := (others => EMPTY_TAG'Access);
      Style_Start_Tags    : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Style_End_Tags      : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Has_Paragraph       : Boolean := False;
      Has_Item            : Boolean := False;
      Need_Paragraph      : Boolean := False;
      Empty_Line          : Boolean := True;
      Keep_Content        : Boolean := False;
      In_List             : Boolean := False;
      Invert_Header_Level : Boolean := False;
      Allow_Link_Language : Boolean := False;
      Current_Level       : Natural := 0;
      Quote_Level         : Natural := 0;
      UL_List_Level       : Natural := 0;
      OL_List_Level       : Natural := 0;
      Current_Style       : Documents.Format_Map := (others => False);
      Content             : Unbounded_Wide_Wide_String;
      Link_Href           : Unbounded_Wide_Wide_String;
      Link_Title          : Unbounded_Wide_Wide_String;
      Link_Lang           : Unbounded_Wide_Wide_String;
   end record;

end Wiki.Render.Wiki;

Remove Bold_Start, Bold_End, Italic_Start, Italic_End definition


-----------------------------------------------------------------------
--  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 Ada.IO_Exceptions;
with Util.Strings;
with Util.Log.Loggers;
with Readline;
with Druss.Commands.Bboxes;
with Druss.Commands.Get;
with Druss.Commands.Status;
with Druss.Commands.Wifi;
with Druss.Commands.Devices;
with Druss.Commands.Ping;
package body Druss.Commands is

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

   function Uptime_Image (Value : in Natural) return String;
   procedure Quit (Name    : in String;
                   Args    : in Argument_List'Class;
                   Context : in out Context_Type);

   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;
   Device_Commands : aliased Druss.Commands.Devices.Command_Type;
   Ping_Commands   : aliased Druss.Commands.Ping.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
      pragma Unreferenced (Command);
   begin
      if Args.Get_Count < Arg_Pos then
         Context.Console.Notice (N_USAGE, "Missing argument for command");
         Druss.Commands.Driver.Usage (Args);
      end if;
      declare
         procedure Operation (Gateway : in out Druss.Gateways.Gateway_Type);

         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, Gateways.ITER_ENABLE, 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] [-d] [-o file] [-c config] <command> [<args>]" & ASCII.LF &
                          "where:" & ASCII.LF &
                          "  -v         Verbose execution mode" & ASCII.LF &
                          "  -d         Debug 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);
      Driver.Add_Command ("devices", Device_Commands'Access);
      Driver.Add_Command ("ping", Ping_Commands'Access);
   end Initialize;

   --  ------------------------------
   --  Quit the interactive loop.
   --  ------------------------------
   procedure Quit (Name    : in String;
                   Args    : in Argument_List'Class;
                   Context : in out Context_Type) is
      pragma Unreferenced (Name, Args, Context);
   begin
      raise Stop_Interactive;
   end Quit;

   --  ------------------------------
   --  Enter in the interactive main loop waiting for user commands and executing them.
   --  ------------------------------
   procedure Interactive (Context : in out Context_Type) is
      Args : Util.Commands.String_Argument_List (Max_Length => 1000,
                                                 Max_Args   => 100);
   begin
      Log.Debug ("Entering in interactive mode");
      Driver.Add_Command (Name => "quit", Handler => Quit'Access);
      loop
         declare
            Line : constant String := Readline.Get_Line ("druss>");
         begin
            Log.Debug ("Execute: {0}", Line);
            Args.Initialize (Line);
            Driver.Execute (Args.Get_Command_Name, Args, Context);

         exception
            when Stop_Interactive =>
               Log.Debug ("Leaving interactive mode");
               exit;

            when others =>
               Context.Console.Notice (N_INFO, "Command failed");
         end;
      end loop;

   exception
      when Ada.IO_Exceptions.End_Error =>
         Log.Debug ("End_Error exception received");

   end Interactive;

   --  ------------------------------
   --  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;

   function Uptime_Image (Value : in Natural) return String is
      D : constant Natural := Value / 86400;
      R : constant Natural := Value mod 86400;
      H : constant Natural := R / 3600;
      M : constant Natural := (R mod 3600) / 60;
      S : constant Natural := (R mod 3600) mod 60;
   begin
      if D > 0 then
         return Util.Strings.Image (D) & "d"
           & (if H > 0 then Natural'Image (H) & "h" else "")
           & (if M > 0 then Natural'Image (M) & "m" else "");
      elsif H > 0 then
         return Util.Strings.Image (H) & "h"
           & (if M > 0 then Natural'Image (M) & "m" else "");
      else
         return Util.Strings.Image (M) & "m"
           & Natural'Image (S) & "s";
      end if;
   end Uptime_Image;

   --  ------------------------------
   --  Print a uptime.
   --  ------------------------------
   procedure Print_Uptime (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String) is
   begin
      if Value = "" then
         Console.Print_Field (Field, Value);
      else
         Console.Print_Field (Field, Uptime_Image (Natural'Value (Value)));
      end if;

   exception
      when others =>
            Console.Print_Field (Field, Value);
   end Print_Uptime;

   --  ------------------------------
   --  Print a performance measure in us or ms.
   --  ------------------------------
   procedure Print_Perf (Console : in Consoles.Console_Access;
                         Field   : in Field_Type;
                         Value   : in String) is
      use Commands.Consoles;
   begin
      if Value = "" then
         Console.Print_Field (Field, Value);
      elsif Value'Length <= 3 then
         Console.Print_Field (Field, Value & " us", J_RIGHT);
      elsif Value'Length <= 6 then
         Console.Print_Field (Field, Value (Value'First .. Value'Last - 3) & "."
                              & Value (Value'Last - 2 .. Value'Last) & " ms", J_RIGHT);
      else
         Console.Print_Field (Field, Value (Value'First .. Value'Last - 6) & "."
                              & Value (Value'Last - 5 .. Value'Last - 3) & " s", J_RIGHT);
      end if;
   end Print_Perf;

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 Ada.IO_Exceptions;
with Util.Strings;
with Util.Log.Loggers;
with Readline;
with Druss.Commands.Bboxes;
with Druss.Commands.Get;
with Druss.Commands.Status;
with Druss.Commands.Wifi;
with Druss.Commands.Devices;
with Druss.Commands.Ping;
package body Druss.Commands is

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

   function Uptime_Image (Value : in Natural) return String;
   procedure Quit (Name    : in String;
                   Args    : in Argument_List'Class;
                   Context : in out Context_Type);

   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;
   Device_Commands : aliased Druss.Commands.Devices.Command_Type;
   Ping_Commands   : aliased Druss.Commands.Ping.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
      pragma Unreferenced (Command);
   begin
      if Args.Get_Count < Arg_Pos then
         Context.Console.Notice (N_USAGE, "Missing argument for command");
         Druss.Commands.Driver.Usage (Args);
      end if;
      declare
         procedure Operation (Gateway : in out Druss.Gateways.Gateway_Type);

         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, Gateways.ITER_ENABLE, 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] [-d] [-i] [-o file] [-c config] <command> [<args>]" & ASCII.LF &
                          "where:" & ASCII.LF &
                          "  -v         Verbose execution mode" & ASCII.LF &
                          "  -d         Debug execution mode" & ASCII.LF &
                          "  -i         Enter the interactive 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);
      Driver.Add_Command ("devices", Device_Commands'Access);
      Driver.Add_Command ("ping", Ping_Commands'Access);
   end Initialize;

   --  ------------------------------
   --  Quit the interactive loop.
   --  ------------------------------
   procedure Quit (Name    : in String;
                   Args    : in Argument_List'Class;
                   Context : in out Context_Type) is
      pragma Unreferenced (Name, Args, Context);
   begin
      raise Stop_Interactive;
   end Quit;

   --  ------------------------------
   --  Enter in the interactive main loop waiting for user commands and executing them.
   --  ------------------------------
   procedure Interactive (Context : in out Context_Type) is
      Args : Util.Commands.String_Argument_List (Max_Length => 1000,
                                                 Max_Args   => 100);
   begin
      Log.Debug ("Entering in interactive mode");
      Driver.Add_Command (Name => "quit", Handler => Quit'Access);
      loop
         declare
            Line : constant String := Readline.Get_Line ("druss>");
         begin
            Log.Debug ("Execute: {0}", Line);
            Args.Initialize (Line);
            Driver.Execute (Args.Get_Command_Name, Args, Context);

         exception
            when Stop_Interactive =>
               Log.Debug ("Leaving interactive mode");
               exit;

            when others =>
               Context.Console.Notice (N_INFO, "Command failed");
         end;
      end loop;

   exception
      when Ada.IO_Exceptions.End_Error =>
         Log.Debug ("End_Error exception received");

   end Interactive;

   --  ------------------------------
   --  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;

   function Uptime_Image (Value : in Natural) return String is
      D : constant Natural := Value / 86400;
      R : constant Natural := Value mod 86400;
      H : constant Natural := R / 3600;
      M : constant Natural := (R mod 3600) / 60;
      S : constant Natural := (R mod 3600) mod 60;
   begin
      if D > 0 then
         return Util.Strings.Image (D) & "d"
           & (if H > 0 then Natural'Image (H) & "h" else "")
           & (if M > 0 then Natural'Image (M) & "m" else "");
      elsif H > 0 then
         return Util.Strings.Image (H) & "h"
           & (if M > 0 then Natural'Image (M) & "m" else "");
      else
         return Util.Strings.Image (M) & "m"
           & Natural'Image (S) & "s";
      end if;
   end Uptime_Image;

   --  ------------------------------
   --  Print a uptime.
   --  ------------------------------
   procedure Print_Uptime (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String) is
   begin
      if Value = "" then
         Console.Print_Field (Field, Value);
      else
         Console.Print_Field (Field, Uptime_Image (Natural'Value (Value)));
      end if;

   exception
      when others =>
            Console.Print_Field (Field, Value);
   end Print_Uptime;

   --  ------------------------------
   --  Print a performance measure in us or ms.
   --  ------------------------------
   procedure Print_Perf (Console : in Consoles.Console_Access;
                         Field   : in Field_Type;
                         Value   : in String) is
      use Commands.Consoles;
   begin
      if Value = "" then
         Console.Print_Field (Field, Value);
      elsif Value'Length <= 3 then
         Console.Print_Field (Field, Value & " us", J_RIGHT);
      elsif Value'Length <= 6 then
         Console.Print_Field (Field, Value (Value'First .. Value'Last - 3) & "."
                              & Value (Value'Last - 2 .. Value'Last) & " ms", J_RIGHT);
      else
         Console.Print_Field (Field, Value (Value'First .. Value'Last - 6) & "."
                              & Value (Value'Last - 5 .. Value'Last - 3) & " s", J_RIGHT);
      end if;
   end Print_Perf;

end Druss.Commands;

Add the -i option to the usage

Add the -i option to the usage


-----------------------------------------------------------------------
--  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;

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;

end Druss.Commands;

Implement the Print_Status operation

Implement the Print_Status operation