-----------------------------------------------------------------------
--  util-log -- Utility Log Package
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2017, 2018 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.
-----------------------------------------------------------------------

--  = Logging =
--  The `Util.Log` package and children provide a simple logging framework inspired
--  from the Java Log4j library.  It is intended to provide a subset of logging features
--  available in other languages, be flexible, extensible, small and efficient.  Having
--  log messages in large applications is very helpful to understand, track and fix complex
--  issues, some of them being related to configuration issues or interaction with other
--  systems.  The overhead of calling a log operation is negligeable when the log is disabled
--  as it is in the order of 30ns and reasonable for a file appender has it is in the order
--  of 5us.
--
--  == Using the log framework ==
--  A bit of terminology:
--
--  * A *logger* is the abstraction that provides operations to emit a message.  The message
--    is composed of a text, optional formatting parameters, a log level and a timestamp.
--  * A *formatter* is the abstraction that takes the information about the log to format
--    the final message.
--  * An *appender* is the abstraction that writes the message either to a console, a file
--    or some other final mechanism.
--
--  == Logger Declaration ==
--  Similar to other logging framework such as Log4j and Log4cxx, it is necessary to have
--  and instance of a logger to write a log message.  The logger instance holds the configuration
--  for the log to enable, disable and control the format and the appender that will receive
--  the message.  The logger instance is associated with a name that is used for the
--  configuration.  A good practice is to declare a `Log` instance in the package body or
--  the package private part to make available the log instance to all the package operations.
--  The instance is created by using the `Create` function.  The name used for the configuration
--  is free but using the full package name is helpful to control precisely the logs.
--
--    with Util.Log.Loggers;
--    package body X.Y is
--      Log : constant Util.Log.Loggers := Util.Log.Loggers.Create ("X.Y");
--    end X.Y;
--
--  == Logger Messages ==
--  A log message is associated with a log level which is used by the logger instance to
--  decide to emit or drop the log message.  To keep the logging API simple and make it easily
--  usable in the application, several operations are provided to write a message with different
--  log level.
--
--  A log message is a string that contains optional formatting markers that follow more or
--  less the Java `MessageFormat` class.  A parameter is represented by a number enclosed by `{}`.
--  The first parameter is represented by `{0}`, the second by `{1}` and so on.  Parameters are
--  replaced in the final message only when the message is enabled by the log configuration.
--  The use of parameters allows to avoid formatting the log message when the log is not used.
--
--  The example below shows several calls to emit a log message with different levels:
--
--     Log.Error ("Cannot open file {0}: {1}", Path, "File does not exist");
--     Log.Warn ("The file {0} is empty", Path);
--     Log.Info ("Opening file {0}", Path);
--     Log.Debug ("Reading line {0}", Line);
--
--  The logger also provides a special `Error` procedure that accepts an Ada exception
--  occurence as parameter.  The exception name and message are printed together with
--  the error message.  It is also possible to activate a complete traceback of the
--  exception and report it in the error message.  With this mechanism, an exception
--  can be handled and reported easily:
--
--     begin
--        ...
--     exception
--        when E : others =>
--           Log.Error ("Something bad occurred", E, Trace => True);
--     end;
--
--  == Log Configuration ==
--  The log configuration uses property files close to the Apache Log4j and to the
--  Apache Log4cxx configuration files.
--  The configuration file contains several parts to configure the logging framework:
--
--  * First, the *appender* configuration indicates the appender that exists and can receive
--    a log message.
--  * Second, a root configuration allows to control the default behavior of the logging
--    framework.  The root configuration controls the default log level as well as the
--    appenders that can be used.
--  * Last, a logger configuration is defined to control the logging level more precisely
--    for each logger.
--
--  Here is a simple log configuration that creates a file appender where log messages are
--  written.  The file appender is given the name `result` and is configured to write the
--  messages in the file `my-log-file.log`.  The file appender will use the `level-message`
--  format for the layout of messages.  Last is the configuration of the `X.Y` logger
--  that will enable only messages starting from the `WARN` level.
--
--    log4j.rootCategory=DEBUG,result
--    log4j.appender.result=File
--    log4j.appender.result.File=my-log-file.log
--    log4j.appender.result.layout=level-message
--    log4j.logger.X.Y=WARN
--
--
package Util.Log is

   pragma Preelaborate;

   subtype Level_Type is Natural;

   FATAL_LEVEL : constant Level_Type := 0;
   ERROR_LEVEL : constant Level_Type := 5;
   WARN_LEVEL  : constant Level_Type := 7;
   INFO_LEVEL  : constant Level_Type := 10;
   DEBUG_LEVEL : constant Level_Type := 20;

   --  Get the log level name.
   function Get_Level_Name (Level : Level_Type) return String;

   --  Get the log level from the property value
   function Get_Level (Value   : in String;
                       Default : in Level_Type := INFO_LEVEL) return Level_Type;

   --  The <tt>Logging</tt> interface defines operations that can be implemented for a
   --  type to report errors or messages.
   type Logging is limited interface;

   procedure Error (Log     : in out Logging;
                    Message : in String) is abstract;

end Util.Log;

-----------------------------------------------------------------------
--  util-log -- Utility Log Package
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2017, 2018 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.
-----------------------------------------------------------------------

--  = Logging =
--  The `Util.Log` package and children provide a simple logging framework inspired
--  from the Java Log4j library.  It is intended to provide a subset of logging features
--  available in other languages, be flexible, extensible, small and efficient.  Having
--  log messages in large applications is very helpful to understand, track and fix complex
--  issues, some of them being related to configuration issues or interaction with other
--  systems.  The overhead of calling a log operation is negligeable when the log is disabled
--  as it is in the order of 30ns and reasonable for a file appender has it is in the order
--  of 5us.
--
--  == Using the log framework ==
--  A bit of terminology:
--
--  * A *logger* is the abstraction that provides operations to emit a message.  The message
--    is composed of a text, optional formatting parameters, a log level and a timestamp.
--  * A *formatter* is the abstraction that takes the information about the log to format
--    the final message.
--  * An *appender* is the abstraction that writes the message either to a console, a file
--    or some other final mechanism.
--
--  == Logger Declaration ==
--  Similar to other logging framework such as Java Log4j and Log4cxx, it is necessary to have
--  and instance of a logger to write a log message.  The logger instance holds the configuration
--  for the log to enable, disable and control the format and the appender that will receive
--  the message.  The logger instance is associated with a name that is used for the
--  configuration.  A good practice is to declare a `Log` instance in the package body or
--  the package private part to make available the log instance to all the package operations.
--  The instance is created by using the `Create` function.  The name used for the configuration
--  is free but using the full package name is helpful to control precisely the logs.
--
--    with Util.Log.Loggers;
--    package body X.Y is
--      Log : constant Util.Log.Loggers := Util.Log.Loggers.Create ("X.Y");
--    end X.Y;
--
--  == Logger Messages ==
--  A log message is associated with a log level which is used by the logger instance to
--  decide to emit or drop the log message.  To keep the logging API simple and make it easily
--  usable in the application, several operations are provided to write a message with different
--  log level.
--
--  A log message is a string that contains optional formatting markers that follow more or
--  less the Java `MessageFormat` class.  A parameter is represented by a number enclosed by `{}`.
--  The first parameter is represented by `{0}`, the second by `{1}` and so on.  Parameters are
--  replaced in the final message only when the message is enabled by the log configuration.
--  The use of parameters allows to avoid formatting the log message when the log is not used.
--
--  The example below shows several calls to emit a log message with different levels:
--
--     Log.Error ("Cannot open file {0}: {1}", Path, "File does not exist");
--     Log.Warn ("The file {0} is empty", Path);
--     Log.Info ("Opening file {0}", Path);
--     Log.Debug ("Reading line {0}", Line);
--
--  The logger also provides a special `Error` procedure that accepts an Ada exception
--  occurence as parameter.  The exception name and message are printed together with
--  the error message.  It is also possible to activate a complete traceback of the
--  exception and report it in the error message.  With this mechanism, an exception
--  can be handled and reported easily:
--
--     begin
--        ...
--     exception
--        when E : others =>
--           Log.Error ("Something bad occurred", E, Trace => True);
--     end;
--
--  == Log Configuration ==
--  The log configuration uses property files close to the Apache Log4j and to the
--  Apache Log4cxx configuration files.
--  The configuration file contains several parts to configure the logging framework:
--
--  * First, the *appender* configuration indicates the appender that exists and can receive
--    a log message.
--  * Second, a root configuration allows to control the default behavior of the logging
--    framework.  The root configuration controls the default log level as well as the
--    appenders that can be used.
--  * Last, a logger configuration is defined to control the logging level more precisely
--    for each logger.
--
--  Here is a simple log configuration that creates a file appender where log messages are
--  written.  The file appender is given the name `result` and is configured to write the
--  messages in the file `my-log-file.log`.  The file appender will use the `level-message`
--  format for the layout of messages.  Last is the configuration of the `X.Y` logger
--  that will enable only messages starting from the `WARN` level.
--
--    log4j.rootCategory=DEBUG,result
--    log4j.appender.result=File
--    log4j.appender.result.File=my-log-file.log
--    log4j.appender.result.layout=level-message
--    log4j.logger.X.Y=WARN
--
--  By default when the `layout` is not set or has an invalid value, the full message is
--  reported and the generated log messages will look as follows:
--
--    [2018-02-07 20:39:51] ERROR - X.Y - Cannot open file test.txt: File does not exist
--    [2018-02-07 20:39:51] WARN  - X.Y - The file test.txt is empty
--    [2018-02-07 20:39:51] INFO  - X.Y - Opening file test.txt
--    [2018-02-07 20:39:51] DEBUG - X.Y - Reading line ......
--
--  When the `layout` configuration is set to `data-level-message`, the message is printed
--  with the date and message level.
--
--    [2018-02-07 20:39:51] ERROR: Cannot open file test.txt: File does not exist
--    [2018-02-07 20:39:51] WARN : The file test.txt is empty
--    [2018-02-07 20:39:51] INFO : X.Y - Opening file test.txt
--    [2018-02-07 20:39:51] DEBUG: X.Y - Reading line ......
--
--  When the `layout` configuration is set to `level-message`, only the message and its
--  level are reported.
--
--    ERROR: Cannot open file test.txt: File does not exist
--    WARN : The file test.txt is empty
--    INFO : X.Y - Opening file test.txt
--    DEBUG: X.Y - Reading line ......
--
--  The last possible configuration for `layout` is `message` which only prints the message.
--
--    Cannot open file test.txt: File does not exist
--    The file test.txt is empty
--    Opening file test.txt
--    Reading line ......
--
package Util.Log is

   pragma Preelaborate;

   subtype Level_Type is Natural;

   FATAL_LEVEL : constant Level_Type := 0;
   ERROR_LEVEL : constant Level_Type := 5;
   WARN_LEVEL  : constant Level_Type := 7;
   INFO_LEVEL  : constant Level_Type := 10;
   DEBUG_LEVEL : constant Level_Type := 20;

   --  Get the log level name.
   function Get_Level_Name (Level : Level_Type) return String;

   --  Get the log level from the property value
   function Get_Level (Value   : in String;
                       Default : in Level_Type := INFO_LEVEL) return Level_Type;

   --  The <tt>Logging</tt> interface defines operations that can be implemented for a
   --  type to report errors or messages.
   type Logging is limited interface;

   procedure Error (Log     : in out Logging;
                    Message : in String) is abstract;

end Util.Log;

Add more documentation about the layout formats


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

package body Babel.Files.Maps is

   --  ------------------------------
   --  Find the file with the given name in the file map.
   --  ------------------------------
   function Find (From : in File_Map;
                  Name : in String) return File_Cursor is
   begin
      return From.Find (Key => Name'Unrestricted_Access);
   end Find;

   --  ------------------------------
   --  Find the file with the given name in the file map.
   --  ------------------------------
   function Find (From : in File_Map;
                  Name : in String) return File_Type is
      Pos : constant File_Cursor := From.Find (Key => Name'Unrestricted_Access);
   begin
      if File_Maps.Has_Element (Pos) then
         return File_Maps.Element (Pos);
      else
         return NO_FILE;
      end if;
   end Find;

   --  ------------------------------
   --  Insert the file in the file map.
   --  ------------------------------
   procedure Insert (Into : in out File_Map;
                     File : in File_Type) is
   begin
      Into.Insert (Key => File.Name'Unrestricted_Access, New_Item => File);
   end Insert;

   --  ------------------------------
   --  Find the directory with the given name in the directory map.
   --  ------------------------------
   function Find (From : in Directory_Map;
                  Name : in String) return Directory_Cursor is
   begin
      return From.Find (Key => Name'Unrestricted_Access);
   end Find;

   --  ------------------------------
   --  Find the directory with the given name in the directory map.
   --  ------------------------------
   function Find (From : in Directory_Map;
                  Name : in String) return Directory_Type is
      Pos : constant Directory_Cursor := From.Find (Key => Name'Unrestricted_Access);
   begin
      if Directory_Maps.Has_Element (Pos) then
         return Directory_Maps.Element (Pos);
      else
         return NO_DIRECTORY;
      end if;
   end Find;

   --  ------------------------------
   --  Add the file with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_File (Into    : in out Differential_Container;
                       Element : in File_Type) is
      use type ADO.Identifier;
   begin
      if Element.Id = ADO.NO_IDENTIFIER then
         Into.Known_Files.Insert (Element.Name'Unrestricted_Access, Element);
      end if;
   end Add_File;

   --  ------------------------------
   --  Add the directory with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_Directory (Into    : in out Differential_Container;
                            Element : in Directory_Type) is
      use type ADO.Identifier;
   begin
      if Element.Id = ADO.NO_IDENTIFIER then
         Into.Known_Dirs.Insert (Element.Name'Unrestricted_Access, Element);
      end if;
   end Add_Directory;

   --  ------------------------------
   --  Create a new file instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Differential_Container;
                    Name : in String) return File_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Create a new directory instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Differential_Container;
                    Name : in String) return Directory_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   --  ------------------------------
   overriding
   function Find (From : in Differential_Container;
                  Name : in String) return File_Type is
   begin
      return Find (From.Known_Files, Name);
   end Find;

   --  ------------------------------
   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   --  ------------------------------
   overriding
   function Find (From : in Differential_Container;
                  Name : in String) return Directory_Type is
   begin
      return Find (From.Known_Dirs, Name);
   end Find;

   --  ------------------------------
   --  Set the directory object associated with the container.
   --  ------------------------------
   overriding
   procedure Set_Directory (Into      : in out Differential_Container;
                            Directory : in Directory_Type) is
   begin
      Default_Container (Into).Set_Directory (Directory);
      Into.Known_Files.Clear;
      Into.Known_Dirs.Clear;
   end Set_Directory;

   --  ------------------------------
   --  Prepare the differential container by setting up the known files and known
   --  directories.  The <tt>Update</tt> procedure is called to give access to the
   --  maps that can be updated.
   --  ------------------------------
   procedure Prepare (Container : in out Differential_Container;
                      Update    : access procedure (Files : in out File_Map;
                                                    Dirs  : in out Directory_Map)) is
   begin
      Update (Container.Known_Files, Container.Known_Dirs);
   end Prepare;

end Babel.Files.Maps;

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

package body Babel.Files.Maps is

   --  ------------------------------
   --  Find the file with the given name in the file map.
   --  ------------------------------
   function Find (From : in File_Map;
                  Name : in String) return File_Cursor is
   begin
      return From.Find (Key => Name'Unrestricted_Access);
   end Find;

   --  ------------------------------
   --  Find the file with the given name in the file map.
   --  ------------------------------
   function Find (From : in File_Map;
                  Name : in String) return File_Type is
      Pos : constant File_Cursor := From.Find (Key => Name'Unrestricted_Access);
   begin
      if File_Maps.Has_Element (Pos) then
         return File_Maps.Element (Pos);
      else
         return NO_FILE;
      end if;
   end Find;

   --  ------------------------------
   --  Insert the file in the file map.
   --  ------------------------------
   procedure Insert (Into : in out File_Map;
                     File : in File_Type) is
   begin
      Into.Insert (Key => File.Name'Unrestricted_Access, New_Item => File);
   end Insert;

   --  ------------------------------
   --  Find the directory with the given name in the directory map.
   --  ------------------------------
   function Find (From : in Directory_Map;
                  Name : in String) return Directory_Cursor is
   begin
      return From.Find (Key => Name'Unrestricted_Access);
   end Find;

   --  ------------------------------
   --  Find the directory with the given name in the directory map.
   --  ------------------------------
   function Find (From : in Directory_Map;
                  Name : in String) return Directory_Type is
      Pos : constant Directory_Cursor := From.Find (Key => Name'Unrestricted_Access);
   begin
      if Directory_Maps.Has_Element (Pos) then
         return Directory_Maps.Element (Pos);
      else
         return NO_DIRECTORY;
      end if;
   end Find;

   procedure Add_File (Dirs  : in out Directory_Map;
                       Files : in out File_Map;
                       Path  : in String;
                       File  : out File_Type) is
      Pos      : constant Natural := Util.Strings.Rindex (Path, '/');
      File_Pos : File_Cursor;
      Dir      : Directory_Type := NO_DIRECTORY;
   begin
      if Pos = 0 then
         File := Find (Files, Path);
         Dir := Find (Dirs, ".");
      else
         File := Find (Files, Path (Pos + 1 .. Path'Last));
         Dir := Find (Dirs, Path (Path'First .. Pos - 1));
      end if;
      if Dir = NO_DIRECTORY then
         if Pos = 0 then
            Dir := Allocate (".", NO_DIRECTORY);
         else
            Dir := Allocate (Path (Path'First .. Pos - 1), NO_DIRECTORY);
         end if;
         Dirs.Insert (Dir.Name.all'Access, Dir);
      end if;
      if File = NO_FILE then
         if Pos = 0 then
            File := Allocate (Path, Dir);
         else
            File := Allocate (Path (Pos + 1 .. Path'Last), Dir);
         end if;
         Files.Insert (File.Name'Unrestricted_Access, File);
      end if;
   end Add_File;

   --  ------------------------------
   --  Add the file with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_File (Into    : in out Differential_Container;
                       Element : in File_Type) is
      use type ADO.Identifier;
   begin
      if Element.Id = ADO.NO_IDENTIFIER then
         Into.Known_Files.Insert (Element.Name'Unrestricted_Access, Element);
      end if;
   end Add_File;

   --  ------------------------------
   --  Add the directory with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_Directory (Into    : in out Differential_Container;
                            Element : in Directory_Type) is
      use type ADO.Identifier;
   begin
      if Element.Id = ADO.NO_IDENTIFIER then
         Into.Known_Dirs.Insert (Element.Name.all'Access, Element);
      end if;
   end Add_Directory;

   --  ------------------------------
   --  Create a new file instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Differential_Container;
                    Name : in String) return File_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Create a new directory instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Differential_Container;
                    Name : in String) return Directory_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   --  ------------------------------
   overriding
   function Find (From : in Differential_Container;
                  Name : in String) return File_Type is
   begin
      return Find (From.Known_Files, Name);
   end Find;

   --  ------------------------------
   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   --  ------------------------------
   overriding
   function Find (From : in Differential_Container;
                  Name : in String) return Directory_Type is
   begin
      return Find (From.Known_Dirs, Name);
   end Find;

   --  ------------------------------
   --  Set the directory object associated with the container.
   --  ------------------------------
   overriding
   procedure Set_Directory (Into      : in out Differential_Container;
                            Directory : in Directory_Type) is
   begin
      Default_Container (Into).Set_Directory (Directory);
      Into.Known_Files.Clear;
      Into.Known_Dirs.Clear;
   end Set_Directory;

   --  ------------------------------
   --  Prepare the differential container by setting up the known files and known
   --  directories.  The <tt>Update</tt> procedure is called to give access to the
   --  maps that can be updated.
   --  ------------------------------
   procedure Prepare (Container : in out Differential_Container;
                      Update    : access procedure (Files : in out File_Map;
                                                    Dirs  : in out Directory_Map)) is
   begin
      Update (Container.Known_Files, Container.Known_Dirs);
   end Prepare;

end Babel.Files.Maps;

Implement the Add_File procedure

Implement the Add_File procedure


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

with ADO.Sessions.Factory;

package body Regtests is

   Factory    : aliased ADO.Sessions.Factory.Session_Factory;
   Controller : aliased ADO.Databases.DataSource;

   --  ------------------------------
   --  Get the database manager to be used for the unit tests
   --  ------------------------------
   function Get_Controller return ADO.Databases.DataSource'Class is
   begin
      return Controller;
   end Get_Controller;

   --  ------------------------------
   --  Get the readonly connection database to be used for the unit tests
   --  ------------------------------
   function Get_Database return ADO.Sessions.Session is
   begin
      return Factory.Get_Session;
   end Get_Database;

   --  ------------------------------
   --  Get the writeable connection database to be used for the unit tests
   --  ------------------------------
   function Get_Master_Database return ADO.Sessions.Master_Session is
   begin
      return Factory.Get_Master_Session;
   end Get_Master_Database;

   --  ------------------------------
   --  Initialize the test database
   --  ------------------------------
   procedure Initialize (Name : in String) is
   begin
      Controller.Set_Connection (Name);
      Factory.Create (Controller);
   end Initialize;

end Regtests;

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

with ADO.Sessions.Sources;
with ADO.Sessions.Factory;

package body Regtests is

   Factory    : aliased ADO.Sessions.Factory.Session_Factory;
   Controller : aliased ADO.Sessions.Sources.Data_Source;

   --  ------------------------------
   --  Get the database manager to be used for the unit tests
   --  ------------------------------
   function Get_Controller return ADO.Sessions.Sources.Data_Source'Class is
   begin
      return Controller;
   end Get_Controller;

   --  ------------------------------
   --  Get the readonly connection database to be used for the unit tests
   --  ------------------------------
   function Get_Database return ADO.Sessions.Session is
   begin
      return Factory.Get_Session;
   end Get_Database;

   --  ------------------------------
   --  Get the writeable connection database to be used for the unit tests
   --  ------------------------------
   function Get_Master_Database return ADO.Sessions.Master_Session is
   begin
      return Factory.Get_Master_Session;
   end Get_Master_Database;

   --  ------------------------------
   --  Initialize the test database
   --  ------------------------------
   procedure Initialize (Name : in String) is
   begin
      Controller.Set_Connection (Name);
      Factory.Create (Controller);
   end Initialize;

end Regtests;

Use the ADO.Sessions.Sources package

Use the ADO.Sessions.Sources package


with Ada.Text_IO; use Ada.Text_IO;

with YAML;

procedure Parser is

   procedure Process_String (S : String);
   procedure Process_File (Filename : String);
   procedure Process (P : in out YAML.Parser_Type);
   procedure Put (N : YAML.Node_Ref; Indent : Natural);

   procedure Process_String (S : String) is
      P : YAML.Parser_Type;
   begin
      P.Set_Input_String (S, YAML.UTF8_Encoding);
      Process (P);
   end Process_String;

   procedure Process_File (Filename : String) is
      P : YAML.Parser_Type;
   begin
      P.Set_Input_File (Filename, YAML.UTF8_Encoding);
      Process (P);
   end Process_File;

   procedure Process (P : in out YAML.Parser_Type) is
      D : YAML.Document_Type;
   begin
      P.Load (D);
      Put (D.Root_Node, 0);
      New_Line;
   end Process;

   procedure Put (N : YAML.Node_Ref; Indent : Natural) is
      Prefix : constant String := (1 .. Indent => ' ');
   begin
      case YAML.Kind (N) is
         when YAML.No_Node =>
            Put_Line (Prefix & "<null>");

         when YAML.Scalar_Node =>
            Put_Line (Prefix & String (N.Value));

         when YAML.Sequence_Node =>
            for I in 1 .. N.Length loop
               Put_Line (Prefix & "- ");
               Put (N.Item (I), Indent + 2);
            end loop;

         when YAML.Mapping_Node =>
            Put_Line ("Pairs:");
            for I in 1 .. N.Length loop
               declare
                  Pair : constant YAML.Node_Pair := N.Item (I);
               begin
                  Put (Prefix & "Key:");
                  Put (Pair.Key, Indent + 2);
                  Put (Prefix & "Value:");
                  Put (Pair.Value, Indent + 2);
               end;
            end loop;
      end case;
   end Put;

begin
   Process_String ("1");
   Process_String ("[1, 2, 3, a, null]");
   Process_String ("foo: 1");

   Process_File ("parser-valid.yaml");
end Parser;

with Ada.Text_IO; use Ada.Text_IO;

with YAML;

procedure Parser is

   procedure Process (P : in out YAML.Parser_Type);
   procedure Put (N : YAML.Node_Ref; Indent : Natural);

   procedure Process (P : in out YAML.Parser_Type) is
      D : YAML.Document_Type;
   begin
      P.Load (D);
      Put (D.Root_Node, 0);
      P.Discard_Input;
      New_Line;
   end Process;

   procedure Put (N : YAML.Node_Ref; Indent : Natural) is
      Prefix : constant String := (1 .. Indent => ' ');
   begin
      case YAML.Kind (N) is
         when YAML.No_Node =>
            Put_Line (Prefix & "<null>");

         when YAML.Scalar_Node =>
            Put_Line (Prefix & String (N.Value));

         when YAML.Sequence_Node =>
            for I in 1 .. N.Length loop
               Put_Line (Prefix & "- ");
               Put (N.Item (I), Indent + 2);
            end loop;

         when YAML.Mapping_Node =>
            Put_Line ("Pairs:");
            for I in 1 .. N.Length loop
               declare
                  Pair : constant YAML.Node_Pair := N.Item (I);
               begin
                  Put (Prefix & "Key:");
                  Put (Pair.Key, Indent + 2);
                  Put (Prefix & "Value:");
                  Put (Pair.Value, Indent + 2);
               end;
            end loop;
      end case;
   end Put;

   P : YAML.Parser_Type;

begin
   P.Set_Input_String ("1", YAML.UTF8_Encoding);
   Process (P);

   P.Set_Input_String ("[1, 2, 3, a, null]", YAML.UTF8_Encoding);
   Process (P);

   P.Set_Input_String ("foo: 1", YAML.UTF8_Encoding);
   Process (P);

   P.Set_Input_File ("parser-valid.yaml", YAML.UTF8_Encoding);
   Process (P);
end Parser;

Update the "parser" testcase to test the Discard_Input procedure


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

with Wiki.Attributes;
with Wiki.Documents;
with Wiki.Nodes;
with Wiki.Strings;

--  == Filters ==
--  The <b>Wiki.Filters</b> package provides a simple filter framework that allows to plug
--  specific filters when a wiki document is parsed and processed.  The <tt>Filter_Type</tt>
--  implements the <tt>Document_Reader</tt> interface to catch all the wiki document operations
--  and it forwards the different calls to a next wiki document instance.  A filter can do some
--  operations while calls are made so that it can:
--
--  * Get the text content and filter it by looking at forbidden words in some dictionary,
--  * Ignore some formatting construct (for example to forbid the use of links),
--  * Verify and do some corrections on HTML content embedded in wiki text,
--  * Expand some plugins, specific links to complex content.
--
--  To implement a new filter, the <tt>Filter_Type</tt> type must be used as a base type
--  and some of the operations have to be overriden.  The default <tt>Filter_Type</tt> operations
--  just propagate the call to the attached wiki document instance (ie, a kind of pass
--  through filter).
--
--  @include wiki-filters-toc.ads
--  @include wiki-filters-html.ads
--  @include wiki-filters-collectors.ads
package Wiki.Filters is

   pragma Preelaborate;

   --  ------------------------------
   --  Filter type
   --  ------------------------------
   type Filter_Type is limited new Ada.Finalization.Limited_Controlled with private;
   type Filter_Type_Access is access all Filter_Type'Class;

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

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

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

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

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

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Filter   : in out Filter_Type;
                             Document : in out Wiki.Documents.Document;
                             Level    : in Natural);

   --  Add a list item (<li>).  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.
   procedure Add_List_Item (Filter   : in out Filter_Type;
                            Document : in out Wiki.Documents.Document;
                            Level    : in Positive;
                            Ordered  : in Boolean);

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

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

   --  Add a quote.
   procedure Add_Quote (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Filter   : in out Filter_Type;
                               Document : in out Wiki.Documents.Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString);

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

   type Filter_Chain is new Filter_Type with private;

   --  Add the filter at beginning of the filter chain.
   procedure Add_Filter (Chain  : in out Filter_Chain;
                         Filter : in Filter_Type_Access);

   --  Internal operation to copy the filter chain.
   procedure Set_Chain (Chain : in out Filter_Chain;
                        From  : in Filter_Chain'Class);

private

   type Filter_Type is limited new Ada.Finalization.Limited_Controlled with record
      Next     : Filter_Type_Access;
   end record;

   type Filter_Chain is new Filter_Type with null record;

end Wiki.Filters;

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

with Wiki.Attributes;
with Wiki.Documents;
with Wiki.Nodes;
with Wiki.Strings;

--  == Filters ==
--  The <b>Wiki.Filters</b> package provides a simple filter framework that allows to plug
--  specific filters when a wiki document is parsed and processed.  The <tt>Filter_Type</tt>
--  implements the <tt>Document_Reader</tt> interface to catch all the wiki document operations
--  and it forwards the different calls to a next wiki document instance.  A filter can do some
--  operations while calls are made so that it can:
--
--  * Get the text content and filter it by looking at forbidden words in some dictionary,
--  * Ignore some formatting construct (for example to forbid the use of links),
--  * Verify and do some corrections on HTML content embedded in wiki text,
--  * Expand some plugins, specific links to complex content.
--
--  To implement a new filter, the <tt>Filter_Type</tt> type must be used as a base type
--  and some of the operations have to be overriden.  The default <tt>Filter_Type</tt> operations
--  just propagate the call to the attached wiki document instance (ie, a kind of pass
--  through filter).
--
--  @include wiki-filters-toc.ads
--  @include wiki-filters-html.ads
--  @include wiki-filters-collectors.ads
--  @include wiki-filters-autolink.ads
package Wiki.Filters is

   pragma Preelaborate;

   --  ------------------------------
   --  Filter type
   --  ------------------------------
   type Filter_Type is limited new Ada.Finalization.Limited_Controlled with private;
   type Filter_Type_Access is access all Filter_Type'Class;

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

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

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

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

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

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Filter   : in out Filter_Type;
                             Document : in out Wiki.Documents.Document;
                             Level    : in Natural);

   --  Add a list item (<li>).  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.
   procedure Add_List_Item (Filter   : in out Filter_Type;
                            Document : in out Wiki.Documents.Document;
                            Level    : in Positive;
                            Ordered  : in Boolean);

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

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

   --  Add a quote.
   procedure Add_Quote (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Filter   : in out Filter_Type;
                               Document : in out Wiki.Documents.Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString);

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

   type Filter_Chain is new Filter_Type with private;

   --  Add the filter at beginning of the filter chain.
   procedure Add_Filter (Chain  : in out Filter_Chain;
                         Filter : in Filter_Type_Access);

   --  Internal operation to copy the filter chain.
   procedure Set_Chain (Chain : in out Filter_Chain;
                        From  : in Filter_Chain'Class);

private

   type Filter_Type is limited new Ada.Finalization.Limited_Controlled with record
      Next     : Filter_Type_Access;
   end record;

   type Filter_Chain is new Filter_Type with null record;

end Wiki.Filters;

Add some documentation

Add some documentation


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

with Ada.Calendar;

with AWA.Users.Models;
with AWA.Modules.Beans;
with AWA.Permissions.Services;

with ADO.SQL;
with Util.Log.Loggers;
with AWA.Users.Modules;
with AWA.Workspaces.Beans;
package body AWA.Workspaces.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Workspaces.Module");

   package Register is new AWA.Modules.Beans (Module => Workspace_Module,
                                              Module_Access => Workspace_Module_Access);

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

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Workspaces_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Workspaces_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Member_List_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Member_List_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Invitation_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Invitation_Bean'Access);

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

      Plugin.User_Manager := AWA.Users.Modules.Get_User_Manager;
      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   --  ------------------------------
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref) is
      User    : constant AWA.Users.Models.User_Ref := Context.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
   begin
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         Workspace := AWA.Workspaces.Models.Null_Workspace;
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (Session, Query, Found);
      if Found then
         Workspace := WS;
         return;
      end if;

      --  Create a workspace for this user.
      WS.Set_Owner (User);
      WS.Set_Create_Date (Ada.Calendar.Clock);
      WS.Save (Session);

      --  And give full control of the workspace for this user
      AWA.Permissions.Services.Add_Permission (Session => Session,
                                               User    => User.Get_Id,
                                               Entity  => WS);

      Workspace := WS;
   end Get_Workspace;

   --  ------------------------------
   --  Load the invitation from the access key and verify that the key is still valid.
   --  ------------------------------
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      use type Ada.Calendar.Time;

      Ctx    : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB     : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query  : ADO.SQL.Query;
      DB_Key : AWA.Users.Models.Access_Key_Ref;
      Found  : Boolean;
   begin
      Log.Debug ("Loading invitation from key {0}", Key);

      Query.Set_Filter ("o.access_key = :key");
      Query.Bind_Param ("key", Key);
      DB_Key.Find (DB, Query, Found);
      if not Found then
         Log.Info ("Invitation key {0} does not exist");
         raise Not_Found;
      end if;
      if DB_Key.Get_Expire_Date < Ada.Calendar.Clock then
         Log.Info ("Invitation key {0} has expired");
         raise Not_Found;
      end if;
      Query.Set_Filter ("o.id = :user");
      Query.Bind_Param ("user", DB_Key.Get_User.Get_Id);
      Invitation.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;
   end Load_Invitation;

   --  ------------------------------
   --  Send the invitation to the user.
   --  ------------------------------
   procedure Send_Invitation (Module     : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      WS    : AWA.Workspaces.Models.Workspace_Ref;
      Query : ADO.SQL.Query;
      Found : Boolean;
      Key   : AWA.Users.Models.Access_Key_Ref;
   begin
      Log.Info ("Sending invitation to {0}", String '(Invitation.Get_Email));

      Ctx.Start;
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (DB, Query, Found);
      if not Found then
         return;
      end if;
      Key := AWA.Users.Models.Access_Key_Ref (Invitation.Get_Access_Key);
      Module.User_Manager.Create_Access_Key (User, Key, 365 * 86400.0, DB);
      Key.Save (DB);
      Invitation.Set_Access_Key (Key);
      Invitation.Set_Inviter (User);
      Invitation.Set_Workspace (WS);
      Invitation.Set_Create_Date (Ada.Calendar.Clock);
      Invitation.Save (DB);
      Ctx.Commit;
   end Send_Invitation;

end AWA.Workspaces.Modules;

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

with Ada.Calendar;

with AWA.Users.Models;
with AWA.Modules.Beans;
with AWA.Permissions.Services;

with ADO.SQL;
with Util.Log.Loggers;
with AWA.Users.Modules;
with AWA.Workspaces.Beans;
package body AWA.Workspaces.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Workspaces.Module");

   package Register is new AWA.Modules.Beans (Module => Workspace_Module,
                                              Module_Access => Workspace_Module_Access);

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

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Workspaces_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Workspaces_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Member_List_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Member_List_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Invitation_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Invitation_Bean'Access);

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

      Plugin.User_Manager := AWA.Users.Modules.Get_User_Manager;
      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   --  ------------------------------
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref) is
      User    : constant AWA.Users.Models.User_Ref := Context.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
   begin
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         Workspace := AWA.Workspaces.Models.Null_Workspace;
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (Session, Query, Found);
      if Found then
         Workspace := WS;
         return;
      end if;

      --  Create a workspace for this user.
      WS.Set_Owner (User);
      WS.Set_Create_Date (Ada.Calendar.Clock);
      WS.Save (Session);

      --  And give full control of the workspace for this user
      AWA.Permissions.Services.Add_Permission (Session => Session,
                                               User    => User.Get_Id,
                                               Entity  => WS);

      Workspace := WS;
   end Get_Workspace;

   --  ------------------------------
   --  Load the invitation from the access key and verify that the key is still valid.
   --  ------------------------------
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      use type Ada.Calendar.Time;

      Ctx    : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB     : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query  : ADO.SQL.Query;
      DB_Key : AWA.Users.Models.Access_Key_Ref;
      Found  : Boolean;
   begin
      Log.Debug ("Loading invitation from key {0}", Key);

      Query.Set_Filter ("o.access_key = :key");
      Query.Bind_Param ("key", Key);
      DB_Key.Find (DB, Query, Found);
      if not Found then
         Log.Info ("Invitation key {0} does not exist");
         raise Not_Found;
      end if;
      if DB_Key.Get_Expire_Date < Ada.Calendar.Clock then
         Log.Info ("Invitation key {0} has expired");
         raise Not_Found;
      end if;
      Query.Set_Filter ("o.invitee_id = :user");
      Query.Bind_Param ("user", DB_Key.Get_User.Get_Id);
      Invitation.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;
   end Load_Invitation;

   --  ------------------------------
   --  Send the invitation to the user.
   --  ------------------------------
   procedure Send_Invitation (Module     : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      Ctx     : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User    : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
      Key     : AWA.Users.Models.Access_Key_Ref;
      Email   : AWA.Users.Models.Email_Ref;
      Invitee : AWA.Users.Models.User_Ref;
   begin
      Log.Info ("Sending invitation to {0}", String '(Invitation.Get_Email));

      Ctx.Start;
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (DB, Query, Found);
      if not Found then
         return;
      end if;

      Query.Clear;
      Query.Set_Filter ("o.email = ?");
      Query.Add_Param (String '(Invitation.Get_Email));
      Email.Find (DB, Query, Found);
      if not Found then
         Email.Set_User_Id (0);
         Email.Set_Email (String '(Invitation.Get_Email));
         Email.Save (DB);
         Invitee.Set_Email (Email);
         Invitee.Set_Name (String '(Invitation.Get_Email));
         Invitee.Save (DB);
      else
         Invitee.Load (DB, Email.Get_User_Id);
      end if;
      Key := AWA.Users.Models.Access_Key_Ref (Invitation.Get_Access_Key);
      Module.User_Manager.Create_Access_Key (Invitee, Key, 365 * 86400.0, DB);
      Key.Save (DB);
      Invitation.Set_Access_Key (Key);
      Invitation.Set_Inviter (User);
      Invitation.Set_Invitee (Invitee);
      Invitation.Set_Workspace (WS);
      Invitation.Set_Create_Date (Ada.Calendar.Clock);
      Invitation.Save (DB);
      Ctx.Commit;
   end Send_Invitation;

end AWA.Workspaces.Modules;

Fix the creation of the invitation, the invitee and user email address Make sure the invitation access key is linked to the invitee


------------------------------------------------------------------------------
-- Copyright (c) 2017-2019, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.File_Readers;
with Natools.S_Expressions.Interpreter_Loop;

package body Natools.Web.ACL.Sx_Backends is

   type User_Builder is record
      Tokens, Groups : Containers.Unsafe_Atom_Lists.List;
   end record;

   type Backend_Builder is record
      Map : Token_Maps.Unsafe_Maps.Map;
   end record;

   Cookie_Name : constant String := "User-Token";
   Hash_Mark : constant Character := '$';

   procedure Process_User
     (Builder : in out Backend_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class);

   procedure Process_User_Element
     (Builder : in out User_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class);

   procedure Read_DB is new S_Expressions.Interpreter_Loop
     (Backend_Builder, Meaningless_Type, Process_User);

   procedure Read_User is new S_Expressions.Interpreter_Loop
     (User_Builder, Meaningless_Type, Process_User_Element);

   --------------------------
   -- Constructor Elements --
   --------------------------

   procedure Process_User
     (Builder : in out Backend_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      User : User_Builder;
      Identity : Containers.Identity;
   begin
      Read_User (Arguments, User, Meaningless_Value);

      Identity :=
        (User => S_Expressions.Atom_Ref_Constructors.Create (Name),
         Groups => Containers.Create (User.Groups));

      for Token of User.Tokens loop
         Builder.Map.Include (Token, Identity);
      end loop;
   end Process_User;

   procedure Process_User_Element
     (Builder : in out User_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      S_Name : constant String := S_Expressions.To_String (Name);
   begin
      if S_Name = "tokens" or else S_Name = "token" then
         Containers.Append_Atoms (Builder.Tokens, Arguments);
      elsif S_Name = "groups" or else S_Name = "group" then
         Containers.Append_Atoms (Builder.Groups, Arguments);
      else
         Log (Severities.Error, "Unknown user element """ & S_Name & '"');
      end if;
   end Process_User_Element;

   ----------------------
   -- Public Interface --
   ----------------------

   overriding procedure Authenticate
     (Self : in Backend;
      Exchange : in out Exchanges.Exchange)
   is
      Cookie : constant String := Exchange.Cookie (Cookie_Name);
      Identity : Containers.Identity;
   begin
      if Cookie'Length > 3
        and then Cookie (Cookie'First) = Hash_Mark
        and then Cookie (Cookie'First + 2) = Hash_Mark
        and then not Self.Hashed.Is_Empty
        and then Cookie (Cookie'First + 1) in Self.Hashed.Query.Data.all'Range
      then
         declare
            Token : constant S_Expressions.Atom
              := S_Expressions.To_Atom
                 (Cookie (Cookie'First + 3 .. Cookie'Last));
            Hash : constant S_Expressions.Atom
              := Hash_Function_DB.Query.Data (Cookie (Cookie'First + 1)).all
                 (Token);
            Cursor : constant Token_Maps.Cursor
              := Self.Hashed.Query.Data (Cookie (Cookie'First + 1)).Find
                 (Hash);
         begin
            if Token_Maps.Has_Element (Cursor) then
               Identity := Token_Maps.Element (Cursor);
            end if;
         end;
      else
         declare
            Cursor : constant Token_Maps.Cursor
              := Self.Map.Find (S_Expressions.To_Atom (Cookie));
         begin
            if Token_Maps.Has_Element (Cursor) then
               Identity := Token_Maps.Element (Cursor);
            end if;
         end;
      end if;

      Exchange.Set_Identity (Identity);
   end Authenticate;

   function Create
     (Arguments : in out S_Expressions.Lockable.Descriptor'Class)
     return ACL.Backend'Class
   is
      Builder : Backend_Builder;
   begin
      case Arguments.Current_Event is
         when S_Expressions.Events.Open_List =>
            Read_DB (Arguments, Builder, Meaningless_Value);

         when S_Expressions.Events.Add_Atom =>
            declare
               Reader : S_Expressions.File_Readers.S_Reader
                 := S_Expressions.File_Readers.Reader
                    (S_Expressions.To_String (Arguments.Current_Atom));
            begin
               Read_DB (Reader, Builder, Meaningless_Value);
            end;

         when others =>
            Log (Severities.Error, "Unable to create ACL from S-expression"
              & " starting with " & Arguments.Current_Event'Img);
      end case;

      return Backend'(Map => Token_Maps.Create (Builder.Map),
                      Hashed => <>);
   end Create;

   procedure Register
     (Id : in Character;
      Fn : in Hash_Function) is
   begin
      if Fn = null then
         null;
      elsif Hash_Function_DB.Is_Empty then
         Hash_Function_DB.Replace (new Hash_Function_Array'(Id => Fn));
      elsif Id in Hash_Function_DB.Query.Data.all'Range then
         Hash_Function_DB.Update.Data.all (Id) := Fn;
      else
         declare
            New_First : constant Hash_Id
              := Hash_Id'Min (Id, Hash_Function_DB.Query.Data.all'First);
            New_Last : constant Hash_Id
              := Hash_Id'Max (Id, Hash_Function_DB.Query.Data.all'Last);
            New_Data : constant Hash_Function_Array_Refs.Data_Access
              := new Hash_Function_Array'(New_First .. New_Last => null);
         begin
            New_Data (Hash_Function_DB.Query.Data.all'First
                  ..  Hash_Function_DB.Query.Data.all'Last)
              := Hash_Function_DB.Query.Data.all;
            Hash_Function_DB.Replace (New_Data);
         end;
      end if;
   end Register;

end Natools.Web.ACL.Sx_Backends;

------------------------------------------------------------------------------
-- Copyright (c) 2017-2019, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.File_Readers;
with Natools.S_Expressions.Interpreter_Loop;

package body Natools.Web.ACL.Sx_Backends is

   type User_Builder (Hash_Id_First, Hash_Id_Last : Hash_Id) is record
      Tokens, Groups : Containers.Unsafe_Atom_Lists.List;
   end record;

   type Backend_Builder (Hash_Id_First, Hash_Id_Last : Hash_Id) is record
      Map : Token_Maps.Unsafe_Maps.Map;
   end record;

   Cookie_Name : constant String := "User-Token";
   Hash_Mark : constant Character := '$';

   procedure Process_User
     (Builder : in out Backend_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class);

   procedure Process_User_Element
     (Builder : in out User_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class);

   procedure Read_DB is new S_Expressions.Interpreter_Loop
     (Backend_Builder, Meaningless_Type, Process_User);

   procedure Read_User is new S_Expressions.Interpreter_Loop
     (User_Builder, Meaningless_Type, Process_User_Element);

   --------------------------
   -- Constructor Elements --
   --------------------------

   procedure Process_User
     (Builder : in out Backend_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      User : User_Builder (Builder.Hash_Id_First, Builder.Hash_Id_Last);
      Identity : Containers.Identity;
   begin
      Read_User (Arguments, User, Meaningless_Value);

      Identity :=
        (User => S_Expressions.Atom_Ref_Constructors.Create (Name),
         Groups => Containers.Create (User.Groups));

      for Token of User.Tokens loop
         Builder.Map.Include (Token, Identity);
      end loop;
   end Process_User;

   procedure Process_User_Element
     (Builder : in out User_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      S_Name : constant String := S_Expressions.To_String (Name);
   begin
      if S_Name = "tokens" or else S_Name = "token" then
         Containers.Append_Atoms (Builder.Tokens, Arguments);
      elsif S_Name = "groups" or else S_Name = "group" then
         Containers.Append_Atoms (Builder.Groups, Arguments);
      else
         Log (Severities.Error, "Unknown user element """ & S_Name & '"');
      end if;
   end Process_User_Element;

   ----------------------
   -- Public Interface --
   ----------------------

   overriding procedure Authenticate
     (Self : in Backend;
      Exchange : in out Exchanges.Exchange)
   is
      Cookie : constant String := Exchange.Cookie (Cookie_Name);
      Identity : Containers.Identity;
   begin
      if Cookie'Length > 3
        and then Cookie (Cookie'First) = Hash_Mark
        and then Cookie (Cookie'First + 2) = Hash_Mark
        and then not Self.Hashed.Is_Empty
        and then Cookie (Cookie'First + 1) in Self.Hashed.Query.Data.all'Range
      then
         declare
            Token : constant S_Expressions.Atom
              := S_Expressions.To_Atom
                 (Cookie (Cookie'First + 3 .. Cookie'Last));
            Hash : constant S_Expressions.Atom
              := Hash_Function_DB.Query.Data (Cookie (Cookie'First + 1)).all
                 (Token);
            Cursor : constant Token_Maps.Cursor
              := Self.Hashed.Query.Data (Cookie (Cookie'First + 1)).Find
                 (Hash);
         begin
            if Token_Maps.Has_Element (Cursor) then
               Identity := Token_Maps.Element (Cursor);
            end if;
         end;
      else
         declare
            Cursor : constant Token_Maps.Cursor
              := Self.Map.Find (S_Expressions.To_Atom (Cookie));
         begin
            if Token_Maps.Has_Element (Cursor) then
               Identity := Token_Maps.Element (Cursor);
            end if;
         end;
      end if;

      Exchange.Set_Identity (Identity);
   end Authenticate;

   function Create
     (Arguments : in out S_Expressions.Lockable.Descriptor'Class)
     return ACL.Backend'Class
   is
      Hash_Id_First : constant Hash_Id
        := (if Hash_Function_DB.Is_Empty
            then Hash_Id'Last
            else Hash_Function_DB.Query.Data.all'First);
      Hash_Id_Last : constant Hash_Id
        := (if Hash_Function_DB.Is_Empty
            then Hash_Id'First
            else Hash_Function_DB.Query.Data.all'Last);
      Builder : Backend_Builder (Hash_Id_First, Hash_Id_Last);
   begin
      case Arguments.Current_Event is
         when S_Expressions.Events.Open_List =>
            Read_DB (Arguments, Builder, Meaningless_Value);

         when S_Expressions.Events.Add_Atom =>
            declare
               Reader : S_Expressions.File_Readers.S_Reader
                 := S_Expressions.File_Readers.Reader
                    (S_Expressions.To_String (Arguments.Current_Atom));
            begin
               Read_DB (Reader, Builder, Meaningless_Value);
            end;

         when others =>
            Log (Severities.Error, "Unable to create ACL from S-expression"
              & " starting with " & Arguments.Current_Event'Img);
      end case;

      return Backend'(Map => Token_Maps.Create (Builder.Map),
                      Hashed => <>);
   end Create;

   procedure Register
     (Id : in Character;
      Fn : in Hash_Function) is
   begin
      if Fn = null then
         null;
      elsif Hash_Function_DB.Is_Empty then
         Hash_Function_DB.Replace (new Hash_Function_Array'(Id => Fn));
      elsif Id in Hash_Function_DB.Query.Data.all'Range then
         Hash_Function_DB.Update.Data.all (Id) := Fn;
      else
         declare
            New_First : constant Hash_Id
              := Hash_Id'Min (Id, Hash_Function_DB.Query.Data.all'First);
            New_Last : constant Hash_Id
              := Hash_Id'Max (Id, Hash_Function_DB.Query.Data.all'Last);
            New_Data : constant Hash_Function_Array_Refs.Data_Access
              := new Hash_Function_Array'(New_First .. New_Last => null);
         begin
            New_Data (Hash_Function_DB.Query.Data.all'First
                  ..  Hash_Function_DB.Query.Data.all'Last)
              := Hash_Function_DB.Query.Data.all;
            Hash_Function_DB.Replace (New_Data);
         end;
      end if;
   end Register;

end Natools.Web.ACL.Sx_Backends;

prepare sizing for hashed tokens

acl-sx_backends: prepare sizing for hashed tokens


-----------------------------------------------------------------------
--  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 Util.Commands.Drivers;
with Util.Properties;
with Druss.Commands.Bboxes;
with Druss.Commands.Get;
with Druss.Commands.Status;
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;

   procedure Initialize is
   begin
      Driver.Set_Description ("Druss - The Bbox master controller");
      Driver.Set_Usage ("[-o file] <command> [<args>]" & ASCII.LF &
                          "where:" & 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 ("status", Druss.Commands.Status.Wan_Status'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 Util.Commands.Drivers;
with Util.Properties;
with Druss.Commands.Bboxes;
with Druss.Commands.Get;
with Druss.Commands.Status;
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;

   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 ("status", Druss.Commands.Status.Wan_Status'Access);
   end Initialize;

end Druss.Commands;

Update the usage for the druss tool

Update the usage for the druss tool


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

with Ada.Strings.Unbounded;
with Util.Tests;
with ADO;
with AWA.Tests;

package AWA.Workspaces.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new AWA.Tests.Test with record
      Member_Id : ADO.Identifier;
      Key       : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   --  Verify the anonymous access for the invitation page.
   procedure Verify_Anonymous (T    : in out Test;
                               Key  : in String);

   --  Test sending an invitation.
   procedure Test_Invite_User (T : in out Test);

   --  Test deleting the member.
   procedure Test_Delete_Member (T : in out Test);

   --  Test accepting the invitation.
   procedure Test_Accept_Invitation (T : in out Test);

end AWA.Workspaces.Tests;

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

with Ada.Strings.Unbounded;
with Util.Tests;
with ADO;
with AWA.Tests;

package AWA.Workspaces.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new AWA.Tests.Test with record
      Member_Id : ADO.Identifier;
      Key       : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   --  Verify the anonymous access for the invitation page.
   procedure Verify_Anonymous (T    : in out Test;
                               Key  : in String);

   --  Test sending an invitation.
   procedure Test_Invite_User (T : in out Test);

   --  Test deleting the member.
   procedure Test_Delete_Member (T : in out Test);

   --  Test accepting the invitation.
   procedure Test_Accept_Invitation (T : in out Test);

   --  Test listing the members of the workspace.
   procedure Test_List_Members (T : in out Test);

end AWA.Workspaces.Tests;

Declare the Test_List_Members procedure

Declare the Test_List_Members procedure