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

   use type AWA.Modules.Module_Access;

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

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

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

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

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

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

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

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

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

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

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

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Users Module");
      Context.Console.Notice (N_INFO, "------------");
      Command.Print (Application, "openid.realm", "", Context);
      Command.Print (Application, "openid.callback_url", "", Context);
      Command.Print (Application, "openid.success_url", "", Context);
      Command.Print (Application, "auth.url.orange", "", Context);
      Command.Print (Application, "auth.provider.orange", "", Context);
      Command.Print (Application, "auth.url.yahoo", "", Context);
      Command.Print (Application, "auth.provider.yahoo", "", Context);
      Command.Print (Application, "auth.url.google", "", Context);
      Command.Print (Application, "auth.provider.google", "", Context);
      Command.Print (Application, "auth.url.facebook", "", Context);
      Command.Print (Application, "auth.provider.facebook", "", Context);
      Command.Print (Application, "auth.url.google-plus", "", Context);
      Command.Print (Application, "auth.provider.google-plus", "", Context);
      Command.Print (Application, "facebook.callback_url", "", Context);
      Command.Print (Application, "facebook.request_url", "", Context);
      Command.Print (Application, "facebook.scope", "", Context);
      Command.Print (Application, "facebook.client_id", "", Context);
      Command.Print (Application, "facebook.secret", "", Context);
      Command.Print (Application, "google-plus.issuer", "", Context);
      Command.Print (Application, "google-plus.callback_url", "", Context);
      Command.Print (Application, "google-plus.request_url", "", Context);
      Command.Print (Application, "google-plus.scope", "", Context);
      Command.Print (Application, "google-plus.client_id", "", Context);
      Command.Print (Application, "google-plus.secret", "", Context);
      Command.Print (Application, "auth-filter.redirect", "", Context);
      Command.Print (Application, "verify-filter.redirect", "", Context);

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

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

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

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

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

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

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

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

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

   use type AWA.Modules.Module_Access;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Update the info command to avoid printing the mail, user configurations if these modules are not active


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

--  == Introduction ==
--  The <tt>Security</tt> package provides a security framework that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  The security framework uses the following abstractions:
--
--  === Policy and policy manager ===
--  The <tt>Policy</tt> defines and implements the set of security rules that specify how to
--  protect the system or resources.  The <tt>Policy_Manager</tt> maintains the security policies.
--
--  === Principal ===
--  The <tt>Principal</tt> is the entity that can be authenticated.  A principal is obtained
--  after successful authentication of a user or of a system through an authorization process.
--  The OpenID or OAuth authentication processes generate such security principal.
--
--  === Permission ===
--  The <tt>Permission</tt> represents an access to a system or application resource.
--  A permission is checked by using the security policy manager.  The policy manager uses a
--  security controller to enforce the permission.
--
--  === Security Context ===
--  The <tt>Security_Context</tt> holds the contextual information that the security controller
--  can use to verify the permission.  The security context is associated with a principal and
--  a set of policy context.
--
--  == Overview ==
--  An application will create a security policy manager and register one or several security
--  policies.  The framework defines a simple role based security policy and an URL security
--  policy intended to provide security in web applications.  The security policy manager reads
--  some security policy configuration file which allows the security policies to configure
--  and create the security controllers.  These controllers will enforce the security according
--  to the application security rules.  All these components (yellow) are built only once when
--  an application starts.
--
--  A user is authenticated through an authentication system which creates a <tt>Principal</tt>
--  instance that identifies the user (green).  The security framework provides two authentication
--  systems: OpenID and OAuth.
--
--  [http://ada-security.googlecode.com/svn/wiki/ModelOverview.png]
--
--  When a permission must be enforced, a security context is created and linked to the
--  <tt>Principal</tt> instance.  Additional security policy context can be added depending on
--  the application context.  To check the permission, the security policy manager is called
--  and it will ask a security controller to verify the permission.
--
--  @include security-permissions.ads
--  @include security-openid.ads
--  @include security-oauth.ads
--  @include security-contexts.ads
--  @include security-controllers.ads
package Security is

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

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

--  == Introduction ==
--  The <tt>Security</tt> package provides a security framework that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  The security framework uses the following abstractions:
--
--  === Policy and policy manager ===
--  The <tt>Policy</tt> defines and implements the set of security rules that specify how to
--  protect the system or resources.  The <tt>Policy_Manager</tt> maintains the security policies.
--
--  === Principal ===
--  The <tt>Principal</tt> is the entity that can be authenticated.  A principal is obtained
--  after successful authentication of a user or of a system through an authorization process.
--  The OpenID or OAuth authentication processes generate such security principal.
--
--  === Permission ===
--  The <tt>Permission</tt> represents an access to a system or application resource.
--  A permission is checked by using the security policy manager.  The policy manager uses a
--  security controller to enforce the permission.
--
--  === Security Context ===
--  The <tt>Security_Context</tt> holds the contextual information that the security controller
--  can use to verify the permission.  The security context is associated with a principal and
--  a set of policy context.
--
--  == Overview ==
--  An application will create a security policy manager and register one or several security
--  policies.  The framework defines a simple role based security policy and an URL security
--  policy intended to provide security in web applications.  The security policy manager reads
--  some security policy configuration file which allows the security policies to configure
--  and create the security controllers.  These controllers will enforce the security according
--  to the application security rules.  All these components (yellow) are built only once when
--  an application starts.
--
--  A user is authenticated through an authentication system which creates a <tt>Principal</tt>
--  instance that identifies the user (green).  The security framework provides two authentication
--  systems: OpenID and OAuth.
--
--  [http://ada-security.googlecode.com/svn/wiki/ModelOverview.png]
--
--  When a permission must be enforced, a security context is created and linked to the
--  <tt>Principal</tt> instance.  Additional security policy context can be added depending on
--  the application context.  To check the permission, the security policy manager is called
--  and it will ask a security controller to verify the permission.
--
--  The framework allows an application to plug its own security policy, its own policy context,
--  its own principal and authentication mechanism.
--
--  @include security-permissions.ads
--  @include security-openid.ads
--  @include security-oauth.ads
--  @include security-contexts.ads
--  @include security-controllers.ads
package Security is

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

Update the documentation

Update the documentation


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

with Ada.Calendar.Formatting;
with Util.Test_Caller;
with Util.Assertions;
with Util.Properties.Bundles;
with Util.Log.Loggers;
package body Util.Dates.Formats.Tests is
   use Util.Tests;
   use Ada.Strings.Unbounded;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Dates.Formats.Tests");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Dates.Split",
                       Test_Split'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Formats.Format",
                       Test_Format'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Day_Start",
                       Test_Get_Day_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Week_Start",
                       Test_Get_Week_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Month_Start",
                       Test_Get_Month_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Day_End",
                       Test_Get_Day_End'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Week_End",
                       Test_Get_Week_End'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Month_End",
                       Test_Get_Month_End'Access);
   end Add_Tests;

   procedure Test_Format (T : in out Test) is
      Bundle  : Util.Properties.Bundles.Manager;
      procedure Check (Pattern : in String;
                       Date    : in Ada.Calendar.Time;
                       Expect  : in String);

      procedure Check (Pattern : in String;
                       Date    : in Ada.Calendar.Time;
                       Expect  : in String) is
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Util.Dates.Formats.Format (Pattern => Pattern,
                                    Date    => Date,
                                    Bundle  => Bundle,
                                    Into    => Result);
         Util.Tests.Assert_Equals (T, Expect, To_String (Result),
                                   "Invalid result for: " & Pattern);
      end Check;

      T1 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (1980, 1, 2, 10, 30, 23);
      T2 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 0, 0, 0);
      T3 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 23, 0, 0);
   begin
      Check ("%H", T1, "10");
      Check ("%H", T2, "00");
      Check ("%I", T3, "11");
      Check ("%k", T2, " 0");
      Check ("%k", T3, "23");
      Check ("%l", T2, " 0");
      Check ("%l", T3, "11");

      Check ("%r", T3, "11:00:00 PM");
      Check ("%r", T2, "00:00:00 AM");
      Check ("%R:%S", T3, "23:00:00");

      Check ("%y-%Y %m/%d %T", T1, "80-1980 01/02 10:30:23");
      Check ("%C %d %D", T1, "19 02 01/02/80");
      Check ("%e", T1, " 1");
      Check ("%F", T1, "1980-01-02");
      Check ("%G", T1, "1980W01");
      Check ("%g", T1, "80W01");

   end Test_Format;

   procedure Check (T          : in out Test'Class;
                    Year       : in Ada.Calendar.Year_Number;
                    Month      : in Ada.Calendar.Month_Number;
                    Day        : in Ada.Calendar.Day_Number;
                    Expect_Day : in Ada.Calendar.Day_Number;
                    Message    : in String;
                    Is_End     : in Boolean;
                    Operation  : access function (D : in Ada.Calendar.Time)
                    return Ada.Calendar.Time) is
      use type Ada.Calendar.Time;

      Date : Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (Year, Month, Day,
                                                                   0, 0, 0);
   begin
      for I in 1 .. 47 loop
         declare
            R : constant Ada.Calendar.Time := Operation (Date);
            D : Date_Record;
         begin
            Split (D, R);
            Log.Info ("{0} ({1}) => {2}",
                      Ada.Calendar.Formatting.Image (Date),
                      Message, Ada.Calendar.Formatting.Image (R));
            Util.Tests.Assert_Equals (T, Natural (Year), Natural (D.Year),
                                      "Invalid year " & Message);
            Util.Tests.Assert_Equals (T, Natural (Month), Natural (D.Month),
                                      "Invalid month " & Message);
            Util.Tests.Assert_Equals (T, Natural (Expect_Day), Natural (D.Month_Day),
                                      "Invalid day " & Message);
            if Is_End then
               Util.Tests.Assert_Equals (T, 23, Natural (D.Hour),
                                         "Invalid hour " & Message);
               Util.Tests.Assert_Equals (T, 59, Natural (D.Minute),
                                         "Invalid minute " & Message);
               Util.Tests.Assert_Equals (T, 59, Natural (D.Second),
                                         "Invalid second " & Message);
            else
               Util.Tests.Assert_Equals (T, 0, Natural (D.Hour),
                                         "Invalid hour " & Message);
               Util.Tests.Assert_Equals (T, 0, Natural (D.Minute),
                                         "Invalid minute " & Message);
               Util.Tests.Assert_Equals (T, 0, Natural (D.Second),
                                         "Invalid second " & Message);
            end if;
         end;
         Date := Date + 1800.0;
      end loop;
   end Check;

   --  ------------------------------
   --  Test the Get_Day_Start operation.
   --  ------------------------------
   procedure Test_Get_Day_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 04, "Get_Day_Start", False, Get_Day_Start'Access);
      Check (T, 2010, 2, 14, 14, "Get_Day_Start", False, Get_Day_Start'Access);
   end Test_Get_Day_Start;

   --  ------------------------------
   --  Test the Get_Week_Start operation.
   --  ------------------------------
   procedure Test_Get_Week_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 03, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 05, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 08, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 14, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 13, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 10, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 15, 15, "Get_Week_Start", False, Get_Week_Start'Access);
   end Test_Get_Week_Start;

   --  ------------------------------
   --  Test the Get_Month_Start operation.
   --  ------------------------------
   procedure Test_Get_Month_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 01, "Get_Month_Start", False, Get_Month_Start'Access);
      Check (T, 2010, 2, 14, 01, "Get_Month_Start", False, Get_Month_Start'Access);
   end Test_Get_Month_Start;

   --  ------------------------------
   --  Test the Get_Day_End operation.
   --  ------------------------------
   procedure Test_Get_Day_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 04, "Get_Day_Start", True, Get_Day_End'Access);
      Check (T, 2010, 2, 14, 14, "Get_Day_Start", True, Get_Day_End'Access);
   end Test_Get_Day_End;

   --  ------------------------------
   --  Test the Get_Week_End operation.
   --  ------------------------------
   procedure Test_Get_Week_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 03, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 05, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 08, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 14, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 13, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 10, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 15, 21, "Get_Week_End", True, Get_Week_End'Access);
   end Test_Get_Week_End;

   --  ------------------------------
   --  Test the Get_Month_End operation.
   --  ------------------------------
   procedure Test_Get_Month_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 30, "Get_Month_End", True, Get_Month_End'Access);
      Check (T, 2010, 2, 14, 28, "Get_Month_End", True, Get_Month_End'Access);
      Check (T, 2000, 2, 14, 29, "Get_Month_End", True, Get_Month_End'Access);
   end Test_Get_Month_End;

   --  ------------------------------
   --  Test the Split operation.
   --  ------------------------------
   procedure Test_Split (T : in out Test) is
      procedure Assert_Equals is
         new Util.Assertions.Assert_Equals_T (Ada.Calendar.Formatting.Day_Name);

      Date : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2014, 11, 12,
                                                                            23, 30, 0);
      D    : Date_Record;
   begin
      Split (D, Date);
      Util.Tests.Assert_Equals (T, 2014, Natural (D.Year), "Invalid year ");
      Util.Tests.Assert_Equals (T, 11, Natural (D.Month), "Invalid month ");
      Util.Tests.Assert_Equals (T, 12, Natural (D.Month_Day), "Invalid day ");
      Util.Tests.Assert_Equals (T, 23, Natural (D.Hour), "Invalid hour ");
      Util.Tests.Assert_Equals (T, 30, Natural (D.Minute), "Invalid minute ");
      Assert_Equals (T, Ada.Calendar.Formatting.Wednesday, D.Day, "Invalid day ");
   end Test_Split;

end Util.Dates.Formats.Tests;

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

with Ada.Calendar.Formatting;
with Util.Test_Caller;
with Util.Assertions;
with Util.Properties.Bundles;
with Util.Log.Loggers;
with Util.Dates.RFC7231;
package body Util.Dates.Formats.Tests is
   use Util.Tests;
   use Ada.Strings.Unbounded;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Dates.Formats.Tests");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Dates.Split",
                       Test_Split'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Formats.Format",
                       Test_Format'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Day_Start",
                       Test_Get_Day_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Week_Start",
                       Test_Get_Week_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Month_Start",
                       Test_Get_Month_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Day_End",
                       Test_Get_Day_End'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Week_End",
                       Test_Get_Week_End'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Month_End",
                       Test_Get_Month_End'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.RFC7231.Append_Date",
                       Test_Append_Date'Access);
   end Add_Tests;

   procedure Test_Format (T : in out Test) is
      Bundle  : Util.Properties.Bundles.Manager;
      procedure Check (Pattern : in String;
                       Date    : in Ada.Calendar.Time;
                       Expect  : in String);

      procedure Check (Pattern : in String;
                       Date    : in Ada.Calendar.Time;
                       Expect  : in String) is
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Util.Dates.Formats.Format (Pattern => Pattern,
                                    Date    => Date,
                                    Bundle  => Bundle,
                                    Into    => Result);
         Util.Tests.Assert_Equals (T, Expect, To_String (Result),
                                   "Invalid result for: " & Pattern);
      end Check;

      T1 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (1980, 1, 2, 10, 30, 23);
      T2 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 0, 0, 0);
      T3 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 23, 0, 0);
   begin
      Check ("%H", T1, "10");
      Check ("%H", T2, "00");
      Check ("%I", T3, "11");
      Check ("%k", T2, " 0");
      Check ("%k", T3, "23");
      Check ("%l", T2, " 0");
      Check ("%l", T3, "11");

      Check ("%r", T3, "11:00:00 PM");
      Check ("%r", T2, "00:00:00 AM");
      Check ("%R:%S", T3, "23:00:00");

      Check ("%y-%Y %m/%d %T", T1, "80-1980 01/02 10:30:23");
      Check ("%C %d %D", T1, "19 02 01/02/80");
      Check ("%e", T1, " 1");
      Check ("%F", T1, "1980-01-02");
      Check ("%G", T1, "1980W01");
      Check ("%g", T1, "80W01");

   end Test_Format;

   procedure Check (T          : in out Test'Class;
                    Year       : in Ada.Calendar.Year_Number;
                    Month      : in Ada.Calendar.Month_Number;
                    Day        : in Ada.Calendar.Day_Number;
                    Expect_Day : in Ada.Calendar.Day_Number;
                    Message    : in String;
                    Is_End     : in Boolean;
                    Operation  : access function (D : in Ada.Calendar.Time)
                    return Ada.Calendar.Time) is
      use type Ada.Calendar.Time;

      Date : Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (Year, Month, Day,
                                                                   0, 0, 0);
   begin
      for I in 1 .. 47 loop
         declare
            R : constant Ada.Calendar.Time := Operation (Date);
            D : Date_Record;
         begin
            Split (D, R);
            Log.Info ("{0} ({1}) => {2}",
                      Ada.Calendar.Formatting.Image (Date),
                      Message, Ada.Calendar.Formatting.Image (R));
            Util.Tests.Assert_Equals (T, Natural (Year), Natural (D.Year),
                                      "Invalid year " & Message);
            Util.Tests.Assert_Equals (T, Natural (Month), Natural (D.Month),
                                      "Invalid month " & Message);
            Util.Tests.Assert_Equals (T, Natural (Expect_Day), Natural (D.Month_Day),
                                      "Invalid day " & Message);
            if Is_End then
               Util.Tests.Assert_Equals (T, 23, Natural (D.Hour),
                                         "Invalid hour " & Message);
               Util.Tests.Assert_Equals (T, 59, Natural (D.Minute),
                                         "Invalid minute " & Message);
               Util.Tests.Assert_Equals (T, 59, Natural (D.Second),
                                         "Invalid second " & Message);
            else
               Util.Tests.Assert_Equals (T, 0, Natural (D.Hour),
                                         "Invalid hour " & Message);
               Util.Tests.Assert_Equals (T, 0, Natural (D.Minute),
                                         "Invalid minute " & Message);
               Util.Tests.Assert_Equals (T, 0, Natural (D.Second),
                                         "Invalid second " & Message);
            end if;
         end;
         Date := Date + 1800.0;
      end loop;
   end Check;

   --  ------------------------------
   --  Test the Get_Day_Start operation.
   --  ------------------------------
   procedure Test_Get_Day_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 04, "Get_Day_Start", False, Get_Day_Start'Access);
      Check (T, 2010, 2, 14, 14, "Get_Day_Start", False, Get_Day_Start'Access);
   end Test_Get_Day_Start;

   --  ------------------------------
   --  Test the Get_Week_Start operation.
   --  ------------------------------
   procedure Test_Get_Week_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 03, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 05, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 08, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 14, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 13, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 10, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 15, 15, "Get_Week_Start", False, Get_Week_Start'Access);
   end Test_Get_Week_Start;

   --  ------------------------------
   --  Test the Get_Month_Start operation.
   --  ------------------------------
   procedure Test_Get_Month_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 01, "Get_Month_Start", False, Get_Month_Start'Access);
      Check (T, 2010, 2, 14, 01, "Get_Month_Start", False, Get_Month_Start'Access);
   end Test_Get_Month_Start;

   --  ------------------------------
   --  Test the Get_Day_End operation.
   --  ------------------------------
   procedure Test_Get_Day_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 04, "Get_Day_Start", True, Get_Day_End'Access);
      Check (T, 2010, 2, 14, 14, "Get_Day_Start", True, Get_Day_End'Access);
   end Test_Get_Day_End;

   --  ------------------------------
   --  Test the Get_Week_End operation.
   --  ------------------------------
   procedure Test_Get_Week_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 03, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 05, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 08, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 14, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 13, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 10, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 15, 21, "Get_Week_End", True, Get_Week_End'Access);
   end Test_Get_Week_End;

   --  ------------------------------
   --  Test the Get_Month_End operation.
   --  ------------------------------
   procedure Test_Get_Month_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 30, "Get_Month_End", True, Get_Month_End'Access);
      Check (T, 2010, 2, 14, 28, "Get_Month_End", True, Get_Month_End'Access);
      Check (T, 2000, 2, 14, 29, "Get_Month_End", True, Get_Month_End'Access);
   end Test_Get_Month_End;

   --  ------------------------------
   --  Test the Split operation.
   --  ------------------------------
   procedure Test_Split (T : in out Test) is
      procedure Assert_Equals is
         new Util.Assertions.Assert_Equals_T (Ada.Calendar.Formatting.Day_Name);

      Date : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2014, 11, 12,
                                                                            23, 30, 0);
      D    : Date_Record;
   begin
      Split (D, Date);
      Util.Tests.Assert_Equals (T, 2014, Natural (D.Year), "Invalid year ");
      Util.Tests.Assert_Equals (T, 11, Natural (D.Month), "Invalid month ");
      Util.Tests.Assert_Equals (T, 12, Natural (D.Month_Day), "Invalid day ");
      Util.Tests.Assert_Equals (T, 23, Natural (D.Hour), "Invalid hour ");
      Util.Tests.Assert_Equals (T, 30, Natural (D.Minute), "Invalid minute ");
      Assert_Equals (T, Ada.Calendar.Formatting.Wednesday, D.Day, "Invalid day ");
   end Test_Split;

   procedure Check (T    : in out Test;
                    Date : in String) is
      D : constant Ada.Calendar.Time := Util.Dates.RFC7231.Value (Date);
      F : constant String := Util.Dates.RFC7231.Image (D);
   begin
      Util.Tests.Assert_Equals (T, Date, F, "Invalid date conversion");
   end Check;

   --  ------------------------------
   --  Test the Append_Date as well as the Image operation
   --  ------------------------------
   procedure Test_Append_Date (T : in out Test) is
   begin
      Check (T, "Mon, 26 Mar 2012 19:43:47 GMT");
      Check (T, "Tue, 02 Feb 2016 15:18:35 GMT");
      Check (T, "Wed, 07 Oct 2015 03:41:11 GMT");
      Check (T, "Thu, 17 Sep 2015 10:07:02 GMT");
      Check (T, "Sat, 03 Oct 2015 17:09:58 GMT");
      Check (T, "Fri, 17 Jul 2015 16:07:54 GMT");
      Check (T, "Sun, 04 Oct 2015 15:10:44 GMT");
   end Test_Append_Date;

end Util.Dates.Formats.Tests;

Add a new test Test_Append_Date to verify several HTTP date parsing and formatting


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

with Util.Measures;
with Util.Test_Caller;
with AWA.Tests.Helpers;
with AWA.Tests.Helpers.Users;
with AWA.Services.Contexts;
with AWA.Counters.Definition;
with AWA.Users.Models;
with Security.Contexts;

package body AWA.Counters.Modules.Tests is

   package User_Counter is
      new AWA.Counters.Definition (AWA.Users.Models.USER_TABLE);

   package Session_Counter is
      new AWA.Counters.Definition (AWA.Users.Models.SESSION_TABLE);

   package Global_Counter is
     new AWA.Counters.Definition (null, "count");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Counters.Modules.Increment",
                       Test_Increment'Access);
      Caller.Add_Test (Suite, "Test AWA.Counters.Modules.Increment (global counter)",
                       Test_Global_Counter'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test incrementing counters and flushing.
   --  ------------------------------
   procedure Test_Increment (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Before    : Integer;
      After     : Integer;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Counters.Modules.Get_Counter_Module;
      T.Assert (T.Manager /= null, "There is no counter plugin");

      T.Manager.Get_Counter (User_Counter.Index, Context.Get_User, Before);
      AWA.Counters.Increment (User_Counter.Index, Context.Get_User);
      T.Manager.Flush;

      T.Manager.Get_Counter (User_Counter.Index, Context.Get_User, After);
      Util.Tests.Assert_Equals (T, Before + 1, After, "The counter must have been incremented");

      declare
         S : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            AWA.Counters.Increment (User_Counter.Index, Context.Get_User);
         end loop;
         Util.Measures.Report (S, "AWA.Counters.Increment", 1000);
      end;
      AWA.Counters.Increment (User_Counter.Index, Context.Get_User);
      declare
         S : Util.Measures.Stamp;
      begin
         T.Manager.Flush;
         Util.Measures.Report (S, "AWA.Counters.Flush");
      end;
      T.Manager.Get_Counter (User_Counter.Index, Context.Get_User, After);
      Util.Tests.Assert_Equals (T, Before + 2 + 1_000, After,
                                "The counter must have been incremented");
   end Test_Increment;

   --  ------------------------------
   --  Test creation of a wiki page.
   --  ------------------------------
   --  Test incrementing a global counter.
   procedure Test_Global_Counter (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Counters.Modules.Get_Counter_Module;
      T.Assert (T.Manager /= null, "There is no counter plugin");

      --  T.Manager.Get_Counter (Global_Counter.Index, Before);
      AWA.Counters.Increment (Global_Counter.Index);
      T.Manager.Flush;

   end Test_Global_Counter;

end AWA.Counters.Modules.Tests;

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

with Util.Measures;
with Util.Test_Caller;
with AWA.Tests.Helpers;
with AWA.Tests.Helpers.Users;
with AWA.Services.Contexts;
with AWA.Counters.Definition;
with AWA.Users.Models;
with Security.Contexts;

package body AWA.Counters.Modules.Tests is

   package User_Counter is
      new AWA.Counters.Definition (AWA.Users.Models.USER_TABLE);

   package Session_Counter is
      new AWA.Counters.Definition (AWA.Users.Models.SESSION_TABLE);

   package Global_Counter is
     new AWA.Counters.Definition (null, "count");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Counters.Modules.Increment",
                       Test_Increment'Access);
      Caller.Add_Test (Suite, "Test AWA.Counters.Modules.Increment (global counter)",
                       Test_Global_Counter'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test incrementing counters and flushing.
   --  ------------------------------
   procedure Test_Increment (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Before    : Integer;
      After     : Integer;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Counters.Modules.Get_Counter_Module;
      T.Assert (T.Manager /= null, "There is no counter plugin");

      T.Manager.Get_Counter (User_Counter.Index, Context.Get_User, Before);
      AWA.Counters.Increment (User_Counter.Index, Context.Get_User);
      T.Manager.Flush;

      T.Manager.Get_Counter (User_Counter.Index, Context.Get_User, After);
      Util.Tests.Assert_Equals (T, Before + 1, After, "The counter must have been incremented");

      declare
         S : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            AWA.Counters.Increment (User_Counter.Index, Context.Get_User);
         end loop;
         Util.Measures.Report (S, "AWA.Counters.Increment", 1000);
      end;
      declare
         S : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            AWA.Counters.Increment (Session_Counter.Index, Context.Get_User_Session);
         end loop;
         Util.Measures.Report (S, "AWA.Counters.Increment", 1000);
      end;
      AWA.Counters.Increment (User_Counter.Index, Context.Get_User);
      declare
         S : Util.Measures.Stamp;
      begin
         T.Manager.Flush;
         Util.Measures.Report (S, "AWA.Counters.Flush");
      end;
      T.Manager.Get_Counter (User_Counter.Index, Context.Get_User, After);
      Util.Tests.Assert_Equals (T, Before + 2 + 1_000, After,
                                "The counter must have been incremented");
   end Test_Increment;

   --  ------------------------------
   --  Test creation of a wiki page.
   --  ------------------------------
   --  Test incrementing a global counter.
   procedure Test_Global_Counter (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Counters.Modules.Get_Counter_Module;
      T.Assert (T.Manager /= null, "There is no counter plugin");

      --  T.Manager.Get_Counter (Global_Counter.Index, Before);
      AWA.Counters.Increment (Global_Counter.Index);
      T.Manager.Flush;

   end Test_Global_Counter;

end AWA.Counters.Modules.Tests;

Fix compilation warning

Fix compilation warning


--  bkp-files -- File 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.
-----------------------------------------------------------------------

with Util.Log.Loggers;
with Util.Files;
with Util.Encoders.Base16;
package body Babel.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bkp.Files");

   Hex_Encoder : Util.Encoders.Base16.Encoder;

   --  ------------------------------
   --  Compare two files on their name and directory.
   --  ------------------------------
   function "<" (Left, Right : in File_Type) return Boolean is
      use type Ada.Strings.Unbounded.Unbounded_String;
   begin
      if Left = NO_FILE then
         return False;
      elsif Right = NO_FILE then
         return True;
      elsif Left.Dir = Right.Dir then
         return Left.Name < Right.Name;
      elsif Left.Dir = NO_DIRECTORY then
         return True;
      elsif Right.Dir = NO_DIRECTORY then
         return False;
      else
         return Left.Dir.Path < Right.Dir.Path;
      end if;
   end "<";

   --  ------------------------------
   --  Allocate a File_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type is
      use Ada.Strings.Unbounded;
      Result : constant File_Type := new File '(Len    => Name'Length,
                                                Id     => NO_IDENTIFIER,
                                                Dir    => Dir,
                                                Name   => Name,
                                                others => <>);
   begin
      return Result;
   end Allocate;

   --  ------------------------------
   --  Allocate a Directory_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return Directory_Type is
      use Ada.Strings.Unbounded;

      Result : constant Directory_Type := new Directory '(Len    => Name'Length,
                                                          Id     => NO_IDENTIFIER,
                                                          Parent => Dir,
                                                          Name   => Name,
                                                          others => <>);
   begin
      if Dir /= null then
         Result.Path := To_Unbounded_String
           (Util.Files.Compose (To_String (Dir.Path), Name));
      else
         Result.Path := To_Unbounded_String (Name);
      end if;
      return Result;
   end Allocate;

   --  ------------------------------
   --  Return true if the file was modified and need a backup.
   --  ------------------------------
   function Is_Modified (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      if Element.Id = NO_IDENTIFIER then
         return True;
      elsif (Element.Status and FILE_MODIFIED) /= 0 then
         return True;
      else
         return False;
      end if;
   end Is_Modified;

   --  ------------------------------
   --  Return true if the file is a new file.
   --  ------------------------------
   function Is_New (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      return Element.Id = NO_IDENTIFIER;
   end Is_New;

   --  ------------------------------
   --  Set the file as modified.
   --  ------------------------------
   procedure Set_Modified (Element : in File_Type) is
   begin
      Element.Status := Element.Status or FILE_MODIFIED;
   end Set_Modified;

   --  ------------------------------
   --  Set the SHA1 signature that was computed for this file.
   --  If the computed signature is different from the current signature,
   --  the FILE_MODIFIED flag is set on the file.  The FILE_HAS_SHA1 flag
   --  is set on the file.
   --  ------------------------------
   procedure Set_Signature (Element   : in File_Type;
                            Signature : in Util.Encoders.SHA1.Hash_Array) is
      use type Util.Encoders.SHA1.Hash_Array;
   begin
      if (Element.Status and FILE_HAS_SHA1) /= 0 and then Element.SHA1 /= Signature then
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
      Element.Status := Element.Status or FILE_HAS_SHA1;
      Element.SHA1   := Signature;
   end Set_Signature;

   --  ------------------------------
   --  Set the file size.  If the new size is different, the FILE_MODIFIED
   --  flag is set on the file.
   --  ------------------------------
   procedure Set_Size (Element : in File_Type;
                       Size    : in File_Size) is
   begin
      if Element.Size /= Size then
         Element.Size := Size;
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
   end Set_Size;

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File_Type) return String is
   begin
      if Element.Dir = null then
         return Element.Name;
      else
         return Util.Files.Compose (Get_Path (Element.Dir), Element.Name);
      end if;
   end Get_Path;

   --  ------------------------------
   --  Return the path for the directory.
   --  ------------------------------
   function Get_Path (Element : in Directory_Type) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Element.Path);
   end Get_Path;

   --  ------------------------------
   --  Return the SHA1 signature computed for the file.
   --  ------------------------------
   function Get_SHA1 (Element : in File_Type) return String is
   begin
      return Hex_Encoder.Transform (Element.SHA1);
   end Get_SHA1;

   --  ------------------------------
   --  Return the file size.
   --  ------------------------------
   function Get_Size (Element : in File_Type) return File_Size is
   begin
      return Element.Size;
   end Get_Size;

   --  ------------------------------
   --  Add the file with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_File (Into    : in out Default_Container;
                       Element : in File_Type) is
   begin
      Into.Files.Append (Element);
   end Add_File;

   --  ------------------------------
   --  Add the directory with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_Directory (Into    : in out Default_Container;
                            Element : in Directory_Type) is
   begin
      Into.Dirs.Append (Element);
   end Add_Directory;

   --  ------------------------------
   --  Create a new file instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Default_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 Default_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 Default_Container;
                  Name : in String) return File_Type is
      pragma Unreferenced (From, Name);
   begin
      return NO_FILE;
   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 Default_Container;
                  Name : in String) return Directory_Type is
      pragma Unreferenced (From, Name);
   begin
      return NO_DIRECTORY;
   end Find;

   --  ------------------------------
   --  Set the directory object associated with the container.
   --  ------------------------------
   procedure Set_Directory (Into      : in out Default_Container;
                            Directory : in Directory_Type) is
   begin
      Into.Current := Directory;
      Into.Files.Clear;
      Into.Dirs.Clear;
   end Set_Directory;

   --  ------------------------------
   --  Execute the Process procedure on each directory found in the container.
   --  ------------------------------
   overriding
   procedure Each_Directory (Container : in Default_Container;
                             Process   : not null access
                               procedure (Dir : in Directory_Type)) is
      Iter : Directory_Vectors.Cursor := Container.Dirs.First;
   begin
      while Directory_Vectors.Has_Element (Iter) loop
         Process (Directory_Vectors.Element (Iter));
         Directory_Vectors.Next (Iter);
      end loop;
   end Each_Directory;

   --  ------------------------------
   --  Execute the Process procedure on each file found in the container.
   --  ------------------------------
   overriding
   procedure Each_File (Container : in Default_Container;
                        Process   : not null access
                          procedure (F : in File_Type)) is
      Iter : File_Vectors.Cursor := Container.Files.First;
   begin
      while File_Vectors.Has_Element (Iter) loop
         Process (File_Vectors.Element (Iter));
         File_Vectors.Next (Iter);
      end loop;
   end Each_File;

end Babel.Files;

--  bkp-files -- File 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.
-----------------------------------------------------------------------

with Util.Log.Loggers;
with Util.Files;
with Util.Encoders.Base16;
package body Babel.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bkp.Files");

   Hex_Encoder : Util.Encoders.Base16.Encoder;

   --  ------------------------------
   --  Compare two files on their name and directory.
   --  ------------------------------
   function "<" (Left, Right : in File_Type) return Boolean is
      use type Ada.Strings.Unbounded.Unbounded_String;
   begin
      if Left = NO_FILE then
         return False;
      elsif Right = NO_FILE then
         return True;
      elsif Left.Dir = Right.Dir then
         return Left.Name < Right.Name;
      elsif Left.Dir = NO_DIRECTORY then
         return True;
      elsif Right.Dir = NO_DIRECTORY then
         return False;
      else
         return Left.Dir.Path < Right.Dir.Path;
      end if;
   end "<";

   --  ------------------------------
   --  Allocate a File_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type is
      use Ada.Strings.Unbounded;
      Result : constant File_Type := new File '(Len    => Name'Length,
                                                Id     => NO_IDENTIFIER,
                                                Dir    => Dir,
                                                Name   => Name,
                                                others => <>);
   begin
      return Result;
   end Allocate;

   --  ------------------------------
   --  Allocate a Directory_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return Directory_Type is
      use Ada.Strings.Unbounded;

      Result : constant Directory_Type := new Directory '(Len    => Name'Length,
                                                          Id     => NO_IDENTIFIER,
                                                          Parent => Dir,
                                                          Name   => Name,
                                                          others => <>);
   begin
      if Dir /= null then
         Result.Path := To_Unbounded_String
           (Util.Files.Compose (To_String (Dir.Path), Name));
      else
         Result.Path := To_Unbounded_String (Name);
      end if;
      return Result;
   end Allocate;

   --  ------------------------------
   --  Return true if the file was modified and need a backup.
   --  ------------------------------
   function Is_Modified (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      if Element.Id = NO_IDENTIFIER then
         return True;
      elsif (Element.Status and FILE_MODIFIED) /= 0 then
         return True;
      else
         return False;
      end if;
   end Is_Modified;

   --  ------------------------------
   --  Return true if the file is a new file.
   --  ------------------------------
   function Is_New (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      return Element.Id = NO_IDENTIFIER;
   end Is_New;

   --  ------------------------------
   --  Set the file as modified.
   --  ------------------------------
   procedure Set_Modified (Element : in File_Type) is
   begin
      Element.Status := Element.Status or FILE_MODIFIED;
   end Set_Modified;

   --  ------------------------------
   --  Set the SHA1 signature that was computed for this file.
   --  If the computed signature is different from the current signature,
   --  the FILE_MODIFIED flag is set on the file.  The FILE_HAS_SHA1 flag
   --  is set on the file.
   --  ------------------------------
   procedure Set_Signature (Element   : in File_Type;
                            Signature : in Util.Encoders.SHA1.Hash_Array) is
      use type Util.Encoders.SHA1.Hash_Array;
   begin
      if (Element.Status and FILE_HAS_SHA1) /= 0 and then Element.SHA1 /= Signature then
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
      Element.Status := Element.Status or FILE_HAS_SHA1;
      Element.SHA1   := Signature;
   end Set_Signature;

   --  ------------------------------
   --  Set the file size.  If the new size is different, the FILE_MODIFIED
   --  flag is set on the file.
   --  ------------------------------
   procedure Set_Size (Element : in File_Type;
                       Size    : in File_Size) is
   begin
      if Element.Size /= Size then
         Element.Size := Size;
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
   end Set_Size;

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File_Type) return String is
   begin
      if Element.Dir = null then
         return Element.Name;
      else
         return Util.Files.Compose (Get_Path (Element.Dir), Element.Name);
      end if;
   end Get_Path;

   --  ------------------------------
   --  Return the path for the directory.
   --  ------------------------------
   function Get_Path (Element : in Directory_Type) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Element.Path);
   end Get_Path;

   --  ------------------------------
   --  Return the SHA1 signature computed for the file.
   --  ------------------------------
   function Get_SHA1 (Element : in File_Type) return String is
   begin
      return Hex_Encoder.Transform (Element.SHA1);
   end Get_SHA1;

   --  ------------------------------
   --  Return the file size.
   --  ------------------------------
   function Get_Size (Element : in File_Type) return File_Size is
   begin
      return Element.Size;
   end Get_Size;

   --  ------------------------------
   --  Return the file modification date.
   --  ------------------------------
   function Get_Date (Element : in File_Type) return Ada.Calendar.Time is
   begin
      return Element.Date;
   end Get_Date;

   --  ------------------------------
   --  Add the file with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_File (Into    : in out Default_Container;
                       Element : in File_Type) is
   begin
      Into.Files.Append (Element);
   end Add_File;

   --  ------------------------------
   --  Add the directory with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_Directory (Into    : in out Default_Container;
                            Element : in Directory_Type) is
   begin
      Into.Dirs.Append (Element);
   end Add_Directory;

   --  ------------------------------
   --  Create a new file instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Default_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 Default_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 Default_Container;
                  Name : in String) return File_Type is
      pragma Unreferenced (From, Name);
   begin
      return NO_FILE;
   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 Default_Container;
                  Name : in String) return Directory_Type is
      pragma Unreferenced (From, Name);
   begin
      return NO_DIRECTORY;
   end Find;

   --  ------------------------------
   --  Set the directory object associated with the container.
   --  ------------------------------
   procedure Set_Directory (Into      : in out Default_Container;
                            Directory : in Directory_Type) is
   begin
      Into.Current := Directory;
      Into.Files.Clear;
      Into.Dirs.Clear;
   end Set_Directory;

   --  ------------------------------
   --  Execute the Process procedure on each directory found in the container.
   --  ------------------------------
   overriding
   procedure Each_Directory (Container : in Default_Container;
                             Process   : not null access
                               procedure (Dir : in Directory_Type)) is
      Iter : Directory_Vectors.Cursor := Container.Dirs.First;
   begin
      while Directory_Vectors.Has_Element (Iter) loop
         Process (Directory_Vectors.Element (Iter));
         Directory_Vectors.Next (Iter);
      end loop;
   end Each_Directory;

   --  ------------------------------
   --  Execute the Process procedure on each file found in the container.
   --  ------------------------------
   overriding
   procedure Each_File (Container : in Default_Container;
                        Process   : not null access
                          procedure (F : in File_Type)) is
      Iter : File_Vectors.Cursor := Container.Files.First;
   begin
      while File_Vectors.Has_Element (Iter) loop
         Process (File_Vectors.Element (Iter));
         File_Vectors.Next (Iter);
      end loop;
   end Each_File;

end Babel.Files;

Implement the Get_Date operation

Implement the Get_Date operation


-----------------------------------------------------------------------
--  mat-symbols-targets - Symbol files management
--  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 MAT.Symbols.Targets is

   --  ------------------------------
   --  Open the binary and load the symbols from that file.
   --  ------------------------------
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String) is
   begin
      Bfd.Files.Open (Symbols.File, Path, "");
      if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
         Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
      end if;
   end Open;

end MAT.Symbols.Targets;

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

   --  ------------------------------
   --  Open the binary and load the symbols from that file.
   --  ------------------------------
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String) is
   begin
      Bfd.Files.Open (Symbols.File, Path, "");
      if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
         Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
      end if;
   end Open;

   --  ------------------------------
   --  Find the nearest source file and line for the given address.
   --  ------------------------------
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Name    : out Ada.Strings.Unbounded.Unbounded_String;
                                Func    : out Ada.Strings.Unbounded.Unbounded_String;
                                Line    : out Natural) is
      Text_Section : Bfd.Sections.Section;
   begin
      Line := 0;
      if Bfd.Files.Is_Open (Symbols.File) then
         Text_Section := Bfd.Sections.Find_Section (Symbols.File, ".text");
         Bfd.Symbols.Find_Nearest_Line (File    => Symbols.File,
                                        Sec     => Text_Section,
                                        Symbols => Symbols.Symbols,
                                        Addr    => Bfd.Vma_Type (Addr),
                                        Name    => Name,
                                        Func    => Func,
                                        Line    => Line);
      else
         Line := 0;
         Name := Ada.Strings.Unbounded.To_Unbounded_String ("");
         Func := Ada.Strings.Unbounded.To_Unbounded_String ("");
      end if;

   exception
      when Bfd.NOT_FOUND =>
         Line := 0;
         Name := Ada.Strings.Unbounded.To_Unbounded_String ("");
         Func := Ada.Strings.Unbounded.To_Unbounded_String ("");
   end Find_Nearest_Line;

end MAT.Symbols.Targets;

Implement Find_Nearest_Line by using Bfd library