--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

with Ada.Strings.Fixed;
with Ada.Strings.UTF_Encoding.Strings;

package body CommonText is

   package AS  renames Ada.Strings;
   package UES renames Ada.Strings.UTF_Encoding.Strings;

   -----------
   --  USS  --
   -----------
   function USS (US : Text) return String is
   begin
      return SU.To_String (US);
   end USS;

   -----------
   --  SUS  --
   -----------
   function SUS (S : String) return Text is
   begin
      return SU.To_Unbounded_String (S);
   end SUS;

   -------------
   --  UTF8S  --
   -------------
   function UTF8S (S8 : UTF8) return String is
   begin
      return UES.Decode (S8);
   end UTF8S;

   -------------
   --  SUTF8  --
   -------------
   function SUTF8 (S : String) return UTF8 is
   begin
      return UES.Encode (S);
   end SUTF8;

   -----------------
   --  IsBlank #1 --
   -----------------
   function IsBlank (US : Text)   return Boolean is
   begin
      return SU.Length (US) = 0;
   end IsBlank;

   -----------------
   --  IsBlank #2 --
   -----------------
   function IsBlank (S  : String) return Boolean is
   begin
      return S'Length = 0;
   end IsBlank;

   ------------------
   --  equivalent  --
   ------------------
   function equivalent (A, B : Text) return Boolean
   is
      use type Text;
   begin
      return A = B;
   end equivalent;

   ------------------
   --  equivalent  --
   ------------------
   function equivalent (A : Text; B : String) return Boolean
   is
      AS : constant String := USS (A);
   begin
      return AS = B;
   end equivalent;

   --------------
   --  trim #1 --
   --------------
   function trim (US : Text) return Text is
   begin
      return SU.Trim (US, AS.Both);
   end trim;

   --------------
   --  trim #2 --
   --------------
   function trim (S : String) return String is
   begin
      return AS.Fixed.Trim (S, AS.Both);
   end trim;

   ---------------
   --  int2str  --
   ---------------
   function int2str  (A : Integer) return String
   is
      raw : constant String := A'Img;
      len : constant Natural := raw'Length;
   begin
      return raw (2 .. len);
   end int2str;

   ----------------
   --  int2text  --
   ----------------
   function int2text (A : Integer) return Text is
   begin
      return SUS (int2str (A));
   end int2text;

   ----------------
   --  bool2str  --
   ----------------
   function bool2str  (A : Boolean) return String is
   begin
      if A then
         return "true";
      end if;
      return "false";
   end bool2str;

   -----------------
   --  bool2text  --
   -----------------
   function bool2text (A : Boolean) return Text is
   begin
      return SUS (bool2str (A));
   end bool2text;

   --------------------
   --  contains  #1  --
   --------------------
   function contains (S : String; fragment : String) return Boolean is
   begin
      return (AS.Fixed.Index (Source => S, Pattern => fragment) > 0);
   end contains;

   --------------------
   --  contains  #2  --
   --------------------
   function contains (US : Text; fragment : String) return Boolean is
   begin
      return (SU.Index (Source => US, Pattern => fragment) > 0);
   end contains;

   --------------
   --  part_1  --
   --------------
   function part_1 (S : String; separator : String := "/") return String
   is
      slash : Integer := AS.Fixed.Index (S, separator);
   begin
      if slash = 0 then
         return S;
      end if;
      return S (S'First .. slash - 1);
   end part_1;

   --------------
   --  part_2  --
   --------------
   function part_2 (S : String; separator : String := "/") return String
   is
      slash : Integer := AS.Fixed.Index (S, separator);
   begin
      if slash = 0 then
         return S;
      end if;
      return S (slash + separator'Length .. S'Last);
   end part_2;

   ---------------
   --  replace  --
   ---------------
   function replace (S : String; reject, shiny : Character) return String
   is
      rejectstr : constant String (1 .. 1) := (1 => reject);
      focus     : constant Natural :=
                           AS.Fixed.Index (Source => S, Pattern => rejectstr);
      returnstr : String := S;
   begin
      if focus > 0 then
        returnstr (focus) := shiny;
      end if;
      return returnstr;
   end replace;

   ---------------
   --  zeropad  --
   ---------------
   function zeropad (N : Natural; places : Positive) return String
   is
      template : String (1 .. places) := (others => '0');
      myimage  : constant String := trim (N'Img);
      startpos : constant Integer := 1 + places - myimage'Length;
   begin
      if startpos < 1 then
         return myimage;
      else
         template (startpos .. places) := myimage;
         return template;
      end if;
   end zeropad;

   --------------
   --  len #1  --
   --------------
   function len (US : Text) return Natural is
   begin
      return SU.Length (US);
   end len;

   --------------
   --  len #2  --
   --------------
   function len (S : String) return Natural is
   begin
      return S'Length;
   end len;

   ------------------
   --  count_char  --
   ------------------
   function count_char (S : String; focus : Character) return Natural
   is
      result : Natural := 0;
   begin
      for x in S'Range loop
         if S (x) = focus then
            result := result + 1;
         end if;
      end loop;
      return result;
   end count_char;

   ---------------------
   --  redact_quotes  --
   ---------------------
   function redact_quotes (sql : String) return String
   is
      --  This block will mask anything between quotes (single or double)
      --  These are considered to be literal and not suitable for binding
      type seeking is (none, single, double);
      redacted    : String := sql;
      seek_status : seeking := none;
      arrow       : Positive := 1;
   begin
      if IsBlank (sql) then
         return "";
      end if;
      loop
         case sql (arrow) is
            when ''' =>
               case seek_status is
                  when none =>
                     seek_status := single;
                     redacted (arrow) := '#';
                  when single =>
                     seek_status := none;
                     redacted (arrow) := '#';
                  when double => null;
               end case;
            when ASCII.Quotation =>
               case seek_status is
                  when none =>
                     seek_status := double;
                     redacted (arrow) := '#';
                  when double =>
                     seek_status := none;
                     redacted (arrow) := '#';
                  when single => null;
               end case;
            when others => null;
         end case;
         exit when arrow = sql'Length;
         arrow := arrow + 1;
      end loop;
      return redacted;
   end redact_quotes;

   ----------------
   --  trim_sql  --
   ----------------
   function trim_sql (sql : String) return String is
      pass1 : String := trim (sql);
      pass2 : String (1 .. pass1'Length) := pass1;
   begin
      if pass2 (pass2'Last) = ASCII.Semicolon then
         return pass2 (1 .. pass2'Length - 1);
      else
         return pass2;
      end if;
   end trim_sql;

   ---------------------
   --  count_queries  --
   ---------------------
   function count_queries (trimmed_sql : String) return Natural
   is
      mask : String := redact_quotes (trimmed_sql);
   begin
      return count_char (S => mask, focus => ASCII.Semicolon) + 1;
   end count_queries;

   ----------------
   --  subquery  --
   ----------------
   function subquery (trimmed_sql : String; index : Positive) return String
   is
      mask     : String := redact_quotes (trimmed_sql);
      start    : Natural := trimmed_sql'First;
      segment  : Natural := 1;
      scanning : Boolean := (index = segment);
   begin
      for x in mask'Range loop
         if mask (x) = ASCII.Semicolon then
            if scanning then
               return trimmed_sql (start .. x - 1);
            else
               segment  := segment + 1;
               start    := x + 1;
               scanning := (index = segment);
            end if;
         end if;
      end loop;

      --  Here we're either scanning (return current segment) or we aren't,
      --  meaning the index was too high, so return nothing.  (This should
      --  never happen because caller knows how many segments there are and
      --  thus would not request something impossible like this.)
      if scanning then
         return trimmed_sql (start .. trimmed_sql'Last);
      else
         return "";
      end if;
   end subquery;

end CommonText;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

with Ada.Strings.Fixed;
with Ada.Strings.UTF_Encoding.Strings;

package body CommonText is

   package AS  renames Ada.Strings;
   package UES renames Ada.Strings.UTF_Encoding.Strings;

   -----------
   --  USS  --
   -----------
   function USS (US : Text) return String is
   begin
      return SU.To_String (US);
   end USS;

   -----------
   --  SUS  --
   -----------
   function SUS (S : String) return Text is
   begin
      return SU.To_Unbounded_String (S);
   end SUS;

   -------------
   --  UTF8S  --
   -------------
   function UTF8S (S8 : UTF8) return String is
   begin
      return UES.Decode (S8);
   end UTF8S;

   -------------
   --  SUTF8  --
   -------------
   function SUTF8 (S : String) return UTF8 is
   begin
      return UES.Encode (S);
   end SUTF8;

   -----------------
   --  IsBlank #1 --
   -----------------
   function IsBlank (US : Text)   return Boolean is
   begin
      return SU.Length (US) = 0;
   end IsBlank;

   -----------------
   --  IsBlank #2 --
   -----------------
   function IsBlank (S  : String) return Boolean is
   begin
      return S'Length = 0;
   end IsBlank;

   ------------------
   --  equivalent  --
   ------------------
   function equivalent (A, B : Text) return Boolean
   is
      use type Text;
   begin
      return A = B;
   end equivalent;

   ------------------
   --  equivalent  --
   ------------------
   function equivalent (A : Text; B : String) return Boolean
   is
      AS : constant String := USS (A);
   begin
      return AS = B;
   end equivalent;

   --------------
   --  trim #1 --
   --------------
   function trim (US : Text) return Text is
   begin
      return SU.Trim (US, AS.Both);
   end trim;

   --------------
   --  trim #2 --
   --------------
   function trim (S : String) return String is
   begin
      return AS.Fixed.Trim (S, AS.Both);
   end trim;

   ---------------
   --  int2str  --
   ---------------
   function int2str  (A : Integer) return String
   is
      raw : constant String := A'Img;
      len : constant Natural := raw'Length;
   begin
      return raw (2 .. len);
   end int2str;

   ----------------
   --  int2text  --
   ----------------
   function int2text (A : Integer) return Text is
   begin
      return SUS (int2str (A));
   end int2text;

   ----------------
   --  bool2str  --
   ----------------
   function bool2str  (A : Boolean) return String is
   begin
      if A then
         return "true";
      end if;
      return "false";
   end bool2str;

   -----------------
   --  bool2text  --
   -----------------
   function bool2text (A : Boolean) return Text is
   begin
      return SUS (bool2str (A));
   end bool2text;

   --------------------
   --  contains  #1  --
   --------------------
   function contains (S : String; fragment : String) return Boolean is
   begin
      return (AS.Fixed.Index (Source => S, Pattern => fragment) > 0);
   end contains;

   --------------------
   --  contains  #2  --
   --------------------
   function contains (US : Text; fragment : String) return Boolean is
   begin
      return (SU.Index (Source => US, Pattern => fragment) > 0);
   end contains;

   --------------
   --  part_1  --
   --------------
   function part_1 (S : String; separator : String := "/") return String
   is
      slash : Integer := AS.Fixed.Index (S, separator);
   begin
      if slash = 0 then
         return S;
      end if;
      return S (S'First .. slash - 1);
   end part_1;

   --------------
   --  part_2  --
   --------------
   function part_2 (S : String; separator : String := "/") return String
   is
      slash : Integer := AS.Fixed.Index (S, separator);
   begin
      if slash = 0 then
         return S;
      end if;
      return S (slash + separator'Length .. S'Last);
   end part_2;

   ---------------
   --  replace  --
   ---------------
   function replace (S : String; reject, shiny : Character) return String
   is
      rejectstr : constant String (1 .. 1) := (1 => reject);
      focus     : constant Natural :=
                           AS.Fixed.Index (Source => S, Pattern => rejectstr);
      returnstr : String := S;
   begin
      if focus > 0 then
        returnstr (focus) := shiny;
      end if;
      return returnstr;
   end replace;

   ---------------
   --  zeropad  --
   ---------------
   function zeropad (N : Natural; places : Positive) return String
   is
      template : String (1 .. places) := (others => '0');
      myimage  : constant String := trim (N'Img);
      startpos : constant Integer := 1 + places - myimage'Length;
   begin
      if startpos < 1 then
         return myimage;
      else
         template (startpos .. places) := myimage;
         return template;
      end if;
   end zeropad;

   --------------
   --  len #1  --
   --------------
   function len (US : Text) return Natural is
   begin
      return SU.Length (US);
   end len;

   --------------
   --  len #2  --
   --------------
   function len (S : String) return Natural is
   begin
      return S'Length;
   end len;

   ------------------
   --  count_char  --
   ------------------
   function count_char (S : String; focus : Character) return Natural
   is
      result : Natural := 0;
   begin
      for x in S'Range loop
         if S (x) = focus then
            result := result + 1;
         end if;
      end loop;
      return result;
   end count_char;

   ---------------------
   --  redact_quotes  --
   ---------------------
   function redact_quotes (sql : String) return String
   is
      --  This block will mask anything between quotes (single or double)
      --  These are considered to be literal and not suitable for binding
      type seeking is (none, single, double);
      redacted    : String := sql;
      seek_status : seeking := none;
      arrow       : Positive := 1;
   begin
      if IsBlank (sql) then
         return "";
      end if;
      loop
         case sql (arrow) is
            when ''' =>
               case seek_status is
                  when none =>
                     seek_status := single;
                     redacted (arrow) := '#';
                  when single =>
                     seek_status := none;
                     redacted (arrow) := '#';
                  when double => null;
               end case;
            when ASCII.Quotation =>
               case seek_status is
                  when none =>
                     seek_status := double;
                     redacted (arrow) := '#';
                  when double =>
                     seek_status := none;
                     redacted (arrow) := '#';
                  when single => null;
               end case;
            when others => null;
         end case;
         exit when arrow = sql'Length;
         arrow := arrow + 1;
      end loop;
      return redacted;
   end redact_quotes;

   ----------------
   --  trim_sql  --
   ----------------
   function trim_sql (sql : String) return String is
      pass1 : String := trim (sql);
      pass2 : String (1 .. pass1'Length) := pass1;
   begin
      if pass2 (pass2'Last) = ASCII.Semicolon then
         return pass2 (1 .. pass2'Length - 1);
      else
         return pass2;
      end if;
   end trim_sql;

   ---------------------
   --  count_queries  --
   ---------------------
   function count_queries (trimmed_sql : String) return Natural
   is
      mask : String := redact_quotes (trimmed_sql);
   begin
      return count_char (S => mask, focus => ASCII.Semicolon) + 1;
   end count_queries;

   ----------------
   --  subquery  --
   ----------------
   function subquery (trimmed_sql : String; index : Positive) return String
   is
      mask     : String := redact_quotes (trimmed_sql);
      start    : Natural := trimmed_sql'First;
      segment  : Natural := 1;
      scanning : Boolean := (index = segment);
   begin
      for x in mask'Range loop
         if mask (x) = ASCII.Semicolon then
            if scanning then
               return trimmed_sql (start .. x - 1);
            else
               segment  := segment + 1;
               start    := x + 1;
               scanning := (index = segment);
            end if;
         end if;
      end loop;

      --  Here we're either scanning (return current segment) or we aren't,
      --  meaning the index was too high, so return nothing.  (This should
      --  never happen because caller knows how many segments there are and
      --  thus would not request something impossible like this.)
      if scanning then
         return trim (trimmed_sql (start .. trimmed_sql'Last));
      else
         return "";
      end if;
   end subquery;

end CommonText;

Trim each subquery to remove whitespace

commontext: Trim each subquery to remove whitespace


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

--  == Integration ==
--  The <tt>Setting_Module</tt> manages the application and user settings.  An instance of the
--  the <tt>Setting_Module</tt> must be declared and registered in the AWA application.
--  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Setting_Module : aliased AWA.Settings.Modules.Setting_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Settings.Modules.NAME,
--              URI    => "settings",
--              Module => App.Setting_Module'Access);
--
--  == Model ==
--  [images/awa_settings_model.png]
package AWA.Settings.Modules is

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

   --  The name of the HTTP session attribute that contains user settings.
   SESSION_ATTR_NAME : constant String := "AWA.Settings";

   --  The settings manager controls the creation and update of user settings.
   --  It maintains a small LRU cache of user settings that have been loaded and
   --  used by the application.  The settings manager is intended to be stored as
   --  an HTTP session attribute.
   type Setting_Manager is new AWA.Modules.Module_Manager with private;
   type Setting_Manager_Access is access all Setting_Manager'Class;

   --  Set the user setting with the given name in the setting manager cache
   --  and in the database.
   procedure Set (Manager : in out Setting_Manager;
                  Name    : in String;
                  Value   : in String);

   --  Get the user setting with the given name from the setting manager cache.
   --  Load the user setting from the database if necessary.
   procedure Get (Manager : in out Setting_Manager;
                  Name    : in String;
                  Default : in String;
                  Value   : out Ada.Strings.Unbounded.Unbounded_String);

   --  Get the current setting manager for the current user.
   function Current return Setting_Manager_Access;

   --  ------------------------------
   --  Module awa-settings
   --  ------------------------------
   type Setting_Module is new AWA.Modules.Module with private;
   type Setting_Module_Access is access all Setting_Module'Class;

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

   --  Get the settings module.
   function Get_Setting_Module return Setting_Module_Access;

private

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

   type Setting_Data;
   type Setting_Data_Access is access all Setting_Data;

   type Setting_Data is limited record
      Next_Setting : Setting_Data_Access;
      Name         : Ada.Strings.Unbounded.Unbounded_String;
      Value        : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   protected type Settings is

      procedure Get (Name    : in String;
                     Default : in String;
                     Value   : out Ada.Strings.Unbounded.Unbounded_String);

      procedure Set (Name  : in String;
                     Value : in String);

      procedure Clear;

   private
      First   : Setting_Data_Access := null;
   end Settings;

   type Setting_Manager is new AWA.Modules.Module_Manager with record
      Data : Settings;
   end record;

end AWA.Settings.Modules;

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

--  == Integration ==
--  The <tt>Setting_Module</tt> manages the application and user settings.  An instance of the
--  the <tt>Setting_Module</tt> must be declared and registered in the AWA application.
--  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Setting_Module : aliased AWA.Settings.Modules.Setting_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Settings.Modules.NAME,
--              URI    => "settings",
--              Module => App.Setting_Module'Access);
--
--  == Model ==
--  [images/awa_settings_model.png]
package AWA.Settings.Modules is

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

   --  The name of the HTTP session attribute that contains user settings.
   SESSION_ATTR_NAME : constant String := "AWA.Settings";

   --  The settings manager controls the creation and update of user settings.
   --  It maintains a small LRU cache of user settings that have been loaded and
   --  used by the application.  The settings manager is intended to be stored as
   --  an HTTP session attribute.
   type Setting_Manager is new AWA.Modules.Module_Manager with private;
   type Setting_Manager_Access is access all Setting_Manager'Class;

   --  Set the user setting with the given name in the setting manager cache
   --  and in the database.
   procedure Set (Manager : in out Setting_Manager;
                  Name    : in String;
                  Value   : in String);

   --  Get the user setting with the given name from the setting manager cache.
   --  Load the user setting from the database if necessary.
   procedure Get (Manager : in out Setting_Manager;
                  Name    : in String;
                  Default : in String;
                  Value   : out Ada.Strings.Unbounded.Unbounded_String);

   --  Get the current setting manager for the current user.
   function Current return Setting_Manager_Access;

   --  ------------------------------
   --  Module awa-settings
   --  ------------------------------
   type Setting_Module is new AWA.Modules.Module with private;
   type Setting_Module_Access is access all Setting_Module'Class;

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

   --  Get the settings module.
   function Get_Setting_Module return Setting_Module_Access;

private

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

   type Setting_Data;
   type Setting_Data_Access is access all Setting_Data;

   type Setting_Data is limited record
      Next_Setting : Setting_Data_Access;
      Name         : Ada.Strings.Unbounded.Unbounded_String;
      Value        : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   protected type Settings is

      procedure Get (Name    : in String;
                     Default : in String;
                     Value   : out Ada.Strings.Unbounded.Unbounded_String);

      procedure Set (Name  : in String;
                     Value : in String);

      procedure Clear;

   private
      First   : Setting_Data_Access := null;
   end Settings;

   type Setting_Manager is new AWA.Modules.Module_Manager with record
      Data : Settings;
   end record;

end AWA.Settings.Modules;

Rename the module NAME into 'settings'

Rename the module NAME into 'settings'


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

with Ada.Text_IO;
with Ada.Directories;

with Gen.Utils;
with Gen.Utils.GNAT;
with Gen.Model.Projects;

with Util.Strings.Sets;
with Util.Files;
package body Gen.Commands.Info is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);

      procedure Collect_Directories (List   : in Gen.Utils.String_List.Vector;
                                     Result : out Gen.Utils.String_List.Vector);

      procedure Print_Model_File (Name : in String;
                                  File : in String;
                                  Done : out Boolean);

      procedure Print_GNAT_Projects (Project : in out Gen.Model.Projects.Project_Definition);

      procedure Print_Dynamo_Projects (Project : in out Model.Projects.Root_Project_Definition);

      procedure Print_Modules (Project : in out Gen.Model.Projects.Project_Definition'Class;
                               Indent  : in Ada.Text_IO.Positive_Count);

      procedure Print_Project (Project : in out Gen.Model.Projects.Root_Project_Definition);

      procedure Print_Project_List (Indent  : in Ada.Text_IO.Positive_Count;
                                    List    : in Gen.Model.Projects.Project_Vectors.Vector);

      List  : Gen.Utils.String_List.Vector;
      Names : Util.Strings.Sets.Set;

      procedure Collect_Directories (List : in Gen.Utils.String_List.Vector;
                                     Result : out Gen.Utils.String_List.Vector) is

         procedure Add_Model_Dir (Base_Dir : in String;
                                  Dir : in String);

         procedure Add_Model_Dir (Base_Dir : in String;
                                  Dir : in String) is
            Path : constant String := Util.Files.Compose (Base_Dir, Dir);
         begin
            if not Result.Contains (Path) and then Ada.Directories.Exists (Path) then
               Result.Append (Path);
            end if;
         end Add_Model_Dir;

         Iter : Gen.Utils.String_List.Cursor := List.First;
      begin
         while Gen.Utils.String_List.Has_Element (Iter) loop
            declare
               Path : constant String := Gen.Utils.String_List.Element (Iter);
               Dir  : constant String := Ada.Directories.Containing_Directory (Path);
            begin
               Add_Model_Dir (Dir, "db");
               Add_Model_Dir (Dir, "db/regtests");
               Add_Model_Dir (Dir, "db/samples");
            end;
            Gen.Utils.String_List.Next (Iter);
         end loop;
      end Collect_Directories;

      procedure Print_Model_File (Name : in String;
                                  File : in String;
                                  Done : out Boolean) is
         pragma Unreferenced (Name);
      begin
         Ada.Text_IO.Put ("    ");
         Ada.Text_IO.Put_Line (File);
         Done := False;
      end Print_Model_File;

      --  ------------------------------
      --  Print the list of GNAT projects used by the main project.
      --  ------------------------------
      procedure Print_GNAT_Projects (Project : in out Gen.Model.Projects.Project_Definition) is
         use Gen.Utils.GNAT;

         Iter : Project_Info_Vectors.Cursor := Project.Project_Files.First;
         Info : Project_Info;
      begin
         if Project_Info_Vectors.Has_Element (Iter) then
            Ada.Text_IO.Put_Line ("GNAT project files:");
            while Project_Info_Vectors.Has_Element (Iter) loop
               Ada.Text_IO.Put ("   ");
               Info := Project_Info_Vectors.Element (Iter);
               Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Info.Path));
               Project_Info_Vectors.Next (Iter);
            end loop;
         end if;
      end Print_GNAT_Projects;

      --  ------------------------------
      --  Print the list of Dynamo modules
      --  ------------------------------
      procedure Print_Project_List (Indent  : in Ada.Text_IO.Positive_Count;
                                    List    : in Gen.Model.Projects.Project_Vectors.Vector) is
         use Gen.Model.Projects;
         use type Ada.Text_IO.Positive_Count;

         Iter : Project_Vectors.Cursor := List.First;
         Ref  : Model.Projects.Project_Reference;
      begin
         while Project_Vectors.Has_Element (Iter) loop
            Ref := Project_Vectors.Element (Iter);
            Ada.Text_IO.Set_Col (Indent);
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Ref.Name));
            Ada.Text_IO.Set_Col (Indent + 30);
            if Ref.Project /= null then
               Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Ref.Project.Path));
            else
               Ada.Text_IO.Put_Line ("?");
            end if;
            Project_Vectors.Next (Iter);
         end loop;
      end Print_Project_List;

      --  ------------------------------
      --  Print the list of Dynamo modules
      --  ------------------------------
      procedure Print_Modules (Project : in out Gen.Model.Projects.Project_Definition'Class;
                               Indent  : in Ada.Text_IO.Positive_Count) is
         use Gen.Model.Projects;
         use type Ada.Text_IO.Positive_Count;

         Iter : Project_Vectors.Cursor := Project.Modules.First;
         Ref  : Model.Projects.Project_Reference;
      begin
         if not Project.Modules.Is_Empty then
            Ada.Text_IO.Set_Col (Indent);
            Ada.Text_IO.Put_Line ("Dynamo plugins:");
            Print_Project_List (Indent, Project.Modules);

            Print_Project_List (Indent, Project.Dependencies);
            Iter := Project.Modules.First;
            while Project_Vectors.Has_Element (Iter) loop
               Ref := Project_Vectors.Element (Iter);
               if Ref.Project /= null and then not Ref.Project.Modules.Is_Empty then
                  declare
                     Name : constant String := Ada.Strings.Unbounded.To_String (Ref.Name);
                  begin
                     Ada.Text_IO.Set_Col (Indent);
                     if Names.Contains (Name) then
                        Ada.Text_IO.Put_Line ("!! " & Name);
                     else
                        Names.Insert (Name);
                        Ada.Text_IO.Put_Line ("== " & Name);
                        Print_Modules (Ref.Project.all, Indent + 4);
                        Names.Delete (Name);
                     end if;
                  end;
               end if;
               Project_Vectors.Next (Iter);
            end loop;
         end if;
      end Print_Modules;

      --  ------------------------------
      --  Print the list of Dynamo projects used by the main project.
      --  ------------------------------
      procedure Print_Dynamo_Projects (Project : in out Model.Projects.Root_Project_Definition) is
         Iter : Gen.Utils.String_List.Cursor := Project.Dynamo_Files.First;
      begin
         if Gen.Utils.String_List.Has_Element (Iter) then
            Ada.Text_IO.Put_Line ("Dynamo project files:");
            while Gen.Utils.String_List.Has_Element (Iter) loop
               Ada.Text_IO.Put ("   ");
               Ada.Text_IO.Put_Line (Gen.Utils.String_List.Element (Iter));
               Gen.Utils.String_List.Next (Iter);
            end loop;
         end if;
      end Print_Dynamo_Projects;

      procedure Print_Project (Project : in out Gen.Model.Projects.Root_Project_Definition) is
      begin
         Print_GNAT_Projects (Gen.Model.Projects.Project_Definition (Project));
         Print_Dynamo_Projects (Project);

         Print_Modules (Project, 1);
         declare
            Model_Dirs : Gen.Utils.String_List.Vector;
         begin
            Collect_Directories (List, Model_Dirs);
            declare
               Iter : Gen.Utils.String_List.Cursor := Model_Dirs.First;
            begin
               Ada.Text_IO.Put_Line ("ADO model files:");
               while Gen.Utils.String_List.Has_Element (Iter) loop
                  Ada.Text_IO.Put ("   ");
                  Ada.Text_IO.Put_Line (Gen.Utils.String_List.Element (Iter));
                  Util.Files.Iterate_Files_Path (Pattern => "*.xml",
                                                 Path    => Gen.Utils.String_List.Element (Iter),
                                                 Process => Print_Model_File'Access);
                  Gen.Utils.String_List.Next (Iter);
               end loop;
            end;
         end;
      end Print_Project;

   begin
      Generator.Read_Project ("dynamo.xml", True);

      Generator.Update_Project (Print_Project'Access);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
   begin
      Ada.Text_IO.Put_Line ("info: Print information about the current project");
      Ada.Text_IO.Put_Line ("Usage: info");
      Ada.Text_IO.New_Line;
   end Help;

end Gen.Commands.Info;

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

with Ada.Text_IO;
with Ada.Directories;

with Gen.Utils;
with Gen.Utils.GNAT;
with Gen.Model.Projects;

with Util.Strings.Sets;
with Util.Files;
package body Gen.Commands.Info is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);

      procedure Collect_Directories (List   : in Gen.Utils.String_List.Vector;
                                     Result : out Gen.Utils.String_List.Vector);

      procedure Print_Model_File (Name : in String;
                                  File : in String;
                                  Done : out Boolean);

      procedure Print_GNAT_Projects (Project : in out Gen.Model.Projects.Project_Definition);

      procedure Print_Dynamo_Projects (Project : in out Model.Projects.Root_Project_Definition);

      procedure Print_Modules (Project : in out Gen.Model.Projects.Project_Definition'Class;
                               Indent  : in Ada.Text_IO.Positive_Count);

      procedure Print_Project (Project : in out Gen.Model.Projects.Root_Project_Definition);

      procedure Print_Project_List (Indent  : in Ada.Text_IO.Positive_Count;
                                    List    : in Gen.Model.Projects.Project_Vectors.Vector);

      List  : Gen.Utils.String_List.Vector;
      Names : Util.Strings.Sets.Set;

      procedure Collect_Directories (List : in Gen.Utils.String_List.Vector;
                                     Result : out Gen.Utils.String_List.Vector) is

         procedure Add_Model_Dir (Base_Dir : in String;
                                  Dir : in String);

         procedure Add_Model_Dir (Base_Dir : in String;
                                  Dir : in String) is
            Path : constant String := Util.Files.Compose (Base_Dir, Dir);
         begin
            if not Result.Contains (Path) and then Ada.Directories.Exists (Path) then
               Result.Append (Path);
            end if;
         end Add_Model_Dir;

         Iter : Gen.Utils.String_List.Cursor := List.First;
      begin
         while Gen.Utils.String_List.Has_Element (Iter) loop
            declare
               Path : constant String := Gen.Utils.String_List.Element (Iter);
               Dir  : constant String := Ada.Directories.Containing_Directory (Path);
            begin
               Add_Model_Dir (Dir, "db");
               Add_Model_Dir (Dir, "db/regtests");
               Add_Model_Dir (Dir, "db/samples");
            end;
            Gen.Utils.String_List.Next (Iter);
         end loop;
      end Collect_Directories;

      procedure Print_Model_File (Name : in String;
                                  File : in String;
                                  Done : out Boolean) is
         pragma Unreferenced (Name);
      begin
         Ada.Text_IO.Put ("    ");
         Ada.Text_IO.Put_Line (File);
         Done := False;
      end Print_Model_File;

      --  ------------------------------
      --  Print the list of GNAT projects used by the main project.
      --  ------------------------------
      procedure Print_GNAT_Projects (Project : in out Gen.Model.Projects.Project_Definition) is
         use Gen.Utils.GNAT;

         Iter : Project_Info_Vectors.Cursor := Project.Project_Files.First;
         Info : Project_Info;
      begin
         if Project_Info_Vectors.Has_Element (Iter) then
            Ada.Text_IO.Put_Line ("GNAT project files:");
            while Project_Info_Vectors.Has_Element (Iter) loop
               Ada.Text_IO.Put ("   ");
               Info := Project_Info_Vectors.Element (Iter);
               Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Info.Path));
               Project_Info_Vectors.Next (Iter);
            end loop;
         end if;
      end Print_GNAT_Projects;

      --  ------------------------------
      --  Print the list of Dynamo modules
      --  ------------------------------
      procedure Print_Project_List (Indent  : in Ada.Text_IO.Positive_Count;
                                    List    : in Gen.Model.Projects.Project_Vectors.Vector) is
         use Gen.Model.Projects;
         use type Ada.Text_IO.Positive_Count;

         Iter : Project_Vectors.Cursor := List.First;
         Ref  : Model.Projects.Project_Reference;
      begin
         while Project_Vectors.Has_Element (Iter) loop
            Ref := Project_Vectors.Element (Iter);
            Ada.Text_IO.Set_Col (Indent);
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Ref.Name));
            Ada.Text_IO.Set_Col (Indent + 30);
            if Ref.Project /= null then
               Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Ref.Project.Path));
            else
               Ada.Text_IO.Put_Line ("?");
            end if;
            Project_Vectors.Next (Iter);
         end loop;
      end Print_Project_List;

      --  ------------------------------
      --  Print the list of Dynamo modules
      --  ------------------------------
      procedure Print_Modules (Project : in out Gen.Model.Projects.Project_Definition'Class;
                               Indent  : in Ada.Text_IO.Positive_Count) is
         use Gen.Model.Projects;
         use type Ada.Text_IO.Positive_Count;

         Iter : Project_Vectors.Cursor := Project.Modules.First;
         Ref  : Model.Projects.Project_Reference;
      begin
         if not Project.Modules.Is_Empty then
            Ada.Text_IO.Set_Col (Indent);
            Ada.Text_IO.Put_Line ("Dynamo plugins:");
            Print_Project_List (Indent, Project.Modules);

            Print_Project_List (Indent, Project.Dependencies);
            Iter := Project.Modules.First;
            while Project_Vectors.Has_Element (Iter) loop
               Ref := Project_Vectors.Element (Iter);
               if Ref.Project /= null and then not Ref.Project.Modules.Is_Empty then
                  declare
                     Name : constant String := Ada.Strings.Unbounded.To_String (Ref.Name);
                  begin
                     Ada.Text_IO.Set_Col (Indent);
                     if Names.Contains (Name) then
                        Ada.Text_IO.Put_Line ("!! " & Name);
                     else
                        Names.Insert (Name);
                        Ada.Text_IO.Put_Line ("== " & Name);
                        Print_Modules (Ref.Project.all, Indent + 4);
                        Names.Delete (Name);
                     end if;
                  end;
               end if;
               Project_Vectors.Next (Iter);
            end loop;
         end if;
      end Print_Modules;

      --  ------------------------------
      --  Print the list of Dynamo projects used by the main project.
      --  ------------------------------
      procedure Print_Dynamo_Projects (Project : in out Model.Projects.Root_Project_Definition) is
         Iter : Gen.Utils.String_List.Cursor := Project.Dynamo_Files.First;
      begin
         if Gen.Utils.String_List.Has_Element (Iter) then
            Ada.Text_IO.Put_Line ("Dynamo project files:");
            while Gen.Utils.String_List.Has_Element (Iter) loop
               Ada.Text_IO.Put ("   ");
               Ada.Text_IO.Put_Line (Gen.Utils.String_List.Element (Iter));
               Gen.Utils.String_List.Next (Iter);
            end loop;
         end if;
      end Print_Dynamo_Projects;

      procedure Print_Project (Project : in out Gen.Model.Projects.Root_Project_Definition) is
      begin
         Print_GNAT_Projects (Gen.Model.Projects.Project_Definition (Project));
         Print_Dynamo_Projects (Project);

         Print_Modules (Project, 1);
         declare
            Model_Dirs : Gen.Utils.String_List.Vector;
         begin
            Collect_Directories (List, Model_Dirs);
            declare
               Iter : Gen.Utils.String_List.Cursor := Model_Dirs.First;
            begin
               Ada.Text_IO.Put_Line ("ADO model files:");
               while Gen.Utils.String_List.Has_Element (Iter) loop
                  Ada.Text_IO.Put ("   ");
                  Ada.Text_IO.Put_Line (Gen.Utils.String_List.Element (Iter));
                  Util.Files.Iterate_Files_Path (Pattern => "*.xml",
                                                 Path    => Gen.Utils.String_List.Element (Iter),
                                                 Process => Print_Model_File'Access);
                  Gen.Utils.String_List.Next (Iter);
               end loop;
            end;
         end;
      end Print_Project;

   begin
      Generator.Read_Project ("dynamo.xml", True);

      Generator.Update_Project (Print_Project'Access);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
   begin
      Ada.Text_IO.Put_Line ("info: Print information about the current project");
      Ada.Text_IO.Put_Line ("Usage: info");
      Ada.Text_IO.New_Line;
   end Help;

end Gen.Commands.Info;

Update to use the new command implementation


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

with AWA.Storages.Models;
with AWA.Storages.Modules;

with ASF.Parts;

with ADO;

with Util.Beans.Objects;
with Util.Beans.Basic;

--  == Storage Beans ==
--  The <tt>Upload_Bean</tt> type is used to upload a file in the storage space.
--  It expect that the folder already exists.
--
--  The <tt>Folder_Bean</tt> type controls the creation of new folders.
--
--  The <tt>Storage_List_Bean</tt> type gives the files associated with a given folder.
package AWA.Storages.Beans is

   FOLDER_ID_PARAMETER : constant String := "folderId";

   --  ------------------------------
   --  Upload Bean
   --  ------------------------------
   --  The Upload_Bean allows to upload a file in the storage space.
   type Upload_Bean is new AWA.Storages.Models.Upload_Bean with record
      Module    : AWA.Storages.Modules.Storage_Module_Access := null;
      Folder_Id : ADO.Identifier;
      Error     : Boolean := False;
   end record;
   type Upload_Bean_Access is access all Upload_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Save the uploaded file in the storage service.
   --  @method
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class);

   --  Upload the file.
   overriding
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the file.
   overriding
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Publish the file.
   overriding
   procedure Publish (Bean    : in out Upload_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Upload_Bean bean instance.
   function Create_Upload_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Folder Bean
   --  ------------------------------
   --  The Folder_Bean allows to create or update the folder name.
   type Folder_Bean is new AWA.Storages.Models.Storage_Folder_Ref
     and Util.Beans.Basic.Bean with record
      Module  : AWA.Storages.Modules.Storage_Module_Access := null;
   end record;
   type Folder_Bean_Access is access all Folder_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the folder.
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   type Init_Flag is (INIT_FOLDER, INIT_FOLDER_LIST, INIT_FILE_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Storage List Bean
   --  ------------------------------
   --  This bean represents a list of storage files for a given folder.
   type Storage_List_Bean is new AWA.Storages.Models.Storage_List_Bean with record
      Module           : AWA.Storages.Modules.Storage_Module_Access := null;

      --  Current folder.
      Folder           : aliased Folder_Bean;
      Folder_Bean      : Folder_Bean_Access;

      --  List of folders.
      Folder_List      : aliased AWA.Storages.Models.Folder_Info_List_Bean;
      Folder_List_Bean : AWA.Storages.Models.Folder_Info_List_Bean_Access;

      --  List of files.
      Files_List       : aliased AWA.Storages.Models.Storage_Info_List_Bean;
      Files_List_Bean  : AWA.Storages.Models.Storage_Info_List_Bean_Access;

      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Storage_List_Bean_Access is access all Storage_List_Bean'Class;

   --  Load the folder instance.
   procedure Load_Folder (Storage : in Storage_List_Bean);

   --  Load the list of folders.
   procedure Load_Folders (Storage : in Storage_List_Bean);

   --  Load the list of files associated with the current folder.
   procedure Load_Files (Storage : in Storage_List_Bean);

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Storage_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the files and folder information.
   overriding
   procedure Load (List    : in out Storage_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Folder_List_Bean bean instance.
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   --  Create the Storage_List_Bean bean instance.
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Storage Bean
   --  ------------------------------
   --  Information about a document (excluding the document data itself).
   type Storage_Bean is new AWA.Storages.Models.Storage_Bean with record
      Module : AWA.Storages.Modules.Storage_Module_Access;
   end record;
   type Storage_Bean_Access is access all Storage_Bean'Class;

   overriding
   procedure Load (Into    : in out Storage_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Storage_Bean bean instance.
   function Create_Storage_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                               return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Storages.Beans;

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

with AWA.Storages.Models;
with AWA.Storages.Modules;

with ASF.Parts;

with ADO;

with Util.Beans.Objects;
with Util.Beans.Basic;

--  == Storage Beans ==
--  The <tt>Upload_Bean</tt> type is used to upload a file in the storage space.
--  It expect that the folder already exists.
--
--  The <tt>Folder_Bean</tt> type controls the creation of new folders.
--
--  The <tt>Storage_List_Bean</tt> type gives the files associated with a given folder.
package AWA.Storages.Beans is

   FOLDER_ID_PARAMETER : constant String := "folderId";

   --  ------------------------------
   --  Upload Bean
   --  ------------------------------
   --  The Upload_Bean allows to upload a file in the storage space.
   type Upload_Bean is new AWA.Storages.Models.Upload_Bean with record
      Module    : AWA.Storages.Modules.Storage_Module_Access := null;
      Folder_Id : ADO.Identifier;
      Error     : Boolean := False;
   end record;
   type Upload_Bean_Access is access all Upload_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Save the uploaded file in the storage service.
   --  @method
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class);

   --  Upload the file.
   overriding
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the file.
   overriding
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Publish the file.
   overriding
   procedure Publish (Bean    : in out Upload_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Upload_Bean bean instance.
   function Create_Upload_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Folder Bean
   --  ------------------------------
   --  The Folder_Bean allows to create or update the folder name.
   type Folder_Bean is new AWA.Storages.Models.Storage_Folder_Ref
     and Util.Beans.Basic.Bean with record
      Module  : AWA.Storages.Modules.Storage_Module_Access := null;
   end record;
   type Folder_Bean_Access is access all Folder_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the folder.
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   type Init_Flag is (INIT_FOLDER, INIT_FOLDER_LIST, INIT_FILE_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Storage List Bean
   --  ------------------------------
   --  This bean represents a list of storage files for a given folder.
   type Storage_List_Bean is new AWA.Storages.Models.Storage_List_Bean with record
      Module           : AWA.Storages.Modules.Storage_Module_Access := null;

      --  Current folder.
      Folder           : aliased Folder_Bean;
      Folder_Bean      : Folder_Bean_Access;

      --  List of folders.
      Folder_List      : aliased AWA.Storages.Models.Folder_Info_List_Bean;
      Folder_List_Bean : AWA.Storages.Models.Folder_Info_List_Bean_Access;

      --  List of files.
      Files_List       : aliased AWA.Storages.Models.Storage_Info_List_Bean;
      Files_List_Bean  : AWA.Storages.Models.Storage_Info_List_Bean_Access;

      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Storage_List_Bean_Access is access all Storage_List_Bean'Class;

   --  Load the folder instance.
   procedure Load_Folder (Storage : in Storage_List_Bean);

   --  Load the list of folders.
   procedure Load_Folders (Storage : in Storage_List_Bean);

   --  Load the list of files associated with the current folder.
   procedure Load_Files (Storage : in Storage_List_Bean);

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Storage_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the files and folder information.
   overriding
   procedure Load (List    : in out Storage_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Folder_List_Bean bean instance.
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   --  Create the Storage_List_Bean bean instance.
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Storage Bean
   --  ------------------------------
   --  Information about a document (excluding the document data itself).
   type Storage_Bean is new AWA.Storages.Models.Storage_Bean with record
      Module : AWA.Storages.Modules.Storage_Module_Access;
   end record;
   type Storage_Bean_Access is access all Storage_Bean'Class;

   overriding
   function Get_Value (From : in Storage_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   overriding
   procedure Load (Into    : in out Storage_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Storage_Bean bean instance.
   function Create_Storage_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                               return Util.Beans.Basic.Readonly_Bean_Access;

   --  Returns true if the given mime type can be displayed by a browser.
   --  Mime types: application/pdf, text/*, image/*
   function Is_Browser_Visible (Mime_Type : in String) return Boolean;

end AWA.Storages.Beans;

Declare Is_Browser_Visible function and Get_Value for the Storage_Bean type


-----------------------------------------------------------------------
--  mat-readers-sockets -- Reader for TCP/IP sockets
--  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 Ada.Streams;
with Util.Log.Loggers;

with MAT.Readers.Marshaller;
package body MAT.Readers.Streams.Sockets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Sockets");

   BUFFER_SIZE  : constant Natural := 100 * 1024;
   MAX_MSG_SIZE : constant Ada.Streams.Stream_Element_Offset := 2048;

   --  ------------------------------
   --  Open the socket to accept connections and start the listener task.
   --  ------------------------------
   procedure Start (Listener : in out Socket_Listener_Type;
                    Address  : in GNAT.Sockets.Sock_Addr_Type) is
   begin
      Log.Info ("Starting the listener socket task");

      Listener.Listener.Start (Address);
   end Start;

   --  ------------------------------
   --  Stop the listener socket.
   --  ------------------------------
   procedure Stop (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Abort_Selector (Listener.Accept_Selector);
   end Stop;

   task body Socket_Listener_Task is
      use type GNAT.Sockets.Socket_Type;

      Peer     : GNAT.Sockets.Sock_Addr_Type;
      Server   : GNAT.Sockets.Socket_Type;
      Instance : Socket_Reader_Type_Access;
      Socket   : GNAT.Sockets.Socket_Type;
      Status   : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (S : in Socket_Reader_Type_Access;
                       Address : in GNAT.Sockets.Sock_Addr_Type) do
            Instance := S;
            GNAT.Sockets.Create_Socket (Server);
            GNAT.Sockets.Set_Socket_Option (Server, GNAT.Sockets.Socket_Level,
                                            (GNAT.Sockets.Reuse_Address, True));
            GNAT.Sockets.Bind_Socket (Server, Address);
            GNAT.Sockets.Listen_Socket (Server);
         end Start;
      or
         terminate;
      end select;
      while not Instance.Stop loop
         GNAT.Sockets.Accept_Socket (Server, Socket, Peer, 1.0, null, Status);
         if Socket /= GNAT.Sockets.No_Socket then
            Instance.Socket.Open (Socket);
            Instance.Read_All;
         end if;
      end loop;
      GNAT.Sockets.Close_Socket (Server);
   end Socket_Listener_Task;

   task body Socket_Reader_Task is
      use type GNAT.Sockets.Socket_Type;

      Peer     : GNAT.Sockets.Sock_Addr_Type;
      Server   : GNAT.Sockets.Socket_Type;
      Instance : Socket_Reader_Type_Access;
      Socket   : GNAT.Sockets.Socket_Type;
      Status   : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (S : in Socket_Reader_Type_Access;
                       Address : in GNAT.Sockets.Sock_Addr_Type) do
            Instance := S;
            --              Address.Addr := GNAT.Sockets.Addresses (Get_Host_By_Name (S.Get_Host), 1);
--              Address.Addr := GNAT.Sockets.Any_Inet_Addr;
--              Address.Port := 4096;
            GNAT.Sockets.Create_Socket (Server);
            GNAT.Sockets.Set_Socket_Option (Server, GNAT.Sockets.Socket_Level,
                                            (GNAT.Sockets.Reuse_Address, True));
            GNAT.Sockets.Bind_Socket (Server, Address);
--              Address := GNAT.Sockets.Get_Socket_Name (Server);
            GNAT.Sockets.Listen_Socket (Server);
         end Start;
      or
         terminate;
      end select;
      while not Instance.Stop loop
         GNAT.Sockets.Accept_Socket (Server, Socket, Peer, 1.0, null, Status);
         if Socket /= GNAT.Sockets.No_Socket then
            Instance.Socket.Open (Socket);
            Instance.Read_All;
         end if;
      end loop;
      GNAT.Sockets.Close_Socket (Server);

   exception
      when E : others =>
         Log.Error ("Exception", E);

   end Socket_Reader_Task;

   --  Open the socket to accept connections.
   procedure Open (Reader  : in out Socket_Reader_Type;
                   Address : in GNAT.Sockets.Sock_Addr_Type) is
   begin
      Log.Info ("Reading server stream");

      Reader.Stream.Initialize (Size   => BUFFER_SIZE,
                                Input  => Reader.Socket'Unchecked_Access,
                                Output => null);
      Reader.Server.Start (Reader'Unchecked_Access, Address);
   end Open;

   procedure Close (Reader : in out Socket_Reader_Type) is
   begin
      Reader.Stop := True;
   end Close;

end MAT.Readers.Streams.Sockets;

-----------------------------------------------------------------------
--  mat-readers-sockets -- Reader for TCP/IP sockets
--  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 Ada.Streams;
with Util.Log.Loggers;

with MAT.Readers.Marshaller;
package body MAT.Readers.Streams.Sockets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Sockets");

   BUFFER_SIZE  : constant Natural := 100 * 1024;
   MAX_MSG_SIZE : constant Ada.Streams.Stream_Element_Offset := 2048;

   --  ------------------------------
   --  Initialize the socket listener.
   --  ------------------------------
   overriding
   procedure Initialize (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Create_Selector (Listener.Accept_Selector);
   end Initialize;

   --  ------------------------------
   --  Open the socket to accept connections and start the listener task.
   --  ------------------------------
   procedure Start (Listener : in out Socket_Listener_Type;
                    Address  : in GNAT.Sockets.Sock_Addr_Type) is
   begin
      Log.Info ("Starting the listener socket task");

      Listener.Listener.Start (Address);
   end Start;

   --  ------------------------------
   --  Stop the listener socket.
   --  ------------------------------
   procedure Stop (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Abort_Selector (Listener.Accept_Selector);
   end Stop;

   task body Socket_Listener_Task is
      use type GNAT.Sockets.Socket_Type;

      Peer     : GNAT.Sockets.Sock_Addr_Type;
      Server   : GNAT.Sockets.Socket_Type;
      Instance : Socket_Reader_Type_Access;
      Socket   : GNAT.Sockets.Socket_Type;
      Status   : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (S : in Socket_Reader_Type_Access;
                       Address : in GNAT.Sockets.Sock_Addr_Type) do
            Instance := S;
            GNAT.Sockets.Create_Socket (Server);
            GNAT.Sockets.Set_Socket_Option (Server, GNAT.Sockets.Socket_Level,
                                            (GNAT.Sockets.Reuse_Address, True));
            GNAT.Sockets.Bind_Socket (Server, Address);
            GNAT.Sockets.Listen_Socket (Server);
         end Start;
      or
         terminate;
      end select;
      while not Instance.Stop loop
         GNAT.Sockets.Accept_Socket (Server, Socket, Peer, 1.0, null, Status);
         if Socket /= GNAT.Sockets.No_Socket then
            Instance.Socket.Open (Socket);
            Instance.Read_All;
         end if;
      end loop;
      GNAT.Sockets.Close_Socket (Server);
   end Socket_Listener_Task;

   task body Socket_Reader_Task is
      use type GNAT.Sockets.Socket_Type;

      Peer     : GNAT.Sockets.Sock_Addr_Type;
      Server   : GNAT.Sockets.Socket_Type;
      Instance : Socket_Reader_Type_Access;
      Socket   : GNAT.Sockets.Socket_Type;
      Status   : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (S : in Socket_Reader_Type_Access;
                       Address : in GNAT.Sockets.Sock_Addr_Type) do
            Instance := S;
            --              Address.Addr := GNAT.Sockets.Addresses (Get_Host_By_Name (S.Get_Host), 1);
--              Address.Addr := GNAT.Sockets.Any_Inet_Addr;
--              Address.Port := 4096;
            GNAT.Sockets.Create_Socket (Server);
            GNAT.Sockets.Set_Socket_Option (Server, GNAT.Sockets.Socket_Level,
                                            (GNAT.Sockets.Reuse_Address, True));
            GNAT.Sockets.Bind_Socket (Server, Address);
--              Address := GNAT.Sockets.Get_Socket_Name (Server);
            GNAT.Sockets.Listen_Socket (Server);
         end Start;
      or
         terminate;
      end select;
      while not Instance.Stop loop
         GNAT.Sockets.Accept_Socket (Server, Socket, Peer, 1.0, null, Status);
         if Socket /= GNAT.Sockets.No_Socket then
            Instance.Socket.Open (Socket);
            Instance.Read_All;
         end if;
      end loop;
      GNAT.Sockets.Close_Socket (Server);

   exception
      when E : others =>
         Log.Error ("Exception", E);

   end Socket_Reader_Task;

   --  Open the socket to accept connections.
   procedure Open (Reader  : in out Socket_Reader_Type;
                   Address : in GNAT.Sockets.Sock_Addr_Type) is
   begin
      Log.Info ("Reading server stream");

      Reader.Stream.Initialize (Size   => BUFFER_SIZE,
                                Input  => Reader.Socket'Unchecked_Access,
                                Output => null);
      Reader.Server.Start (Reader'Unchecked_Access, Address);
   end Open;

   procedure Close (Reader : in out Socket_Reader_Type) is
   begin
      Reader.Stop := True;
   end Close;

end MAT.Readers.Streams.Sockets;

Implement the Initialize procedure to create the accept selector


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

procedure Encodes is

   use Util.Encoders;

   Encode : Boolean := True;
   Count  : constant Natural := Ada.Command_Line.Argument_Count;

begin
   if Count <= 1 then
      Ada.Text_IO.Put_Line ("Usage: encodes {encoder} [-d|-e] string...");
      Ada.Text_IO.Put_Line ("Encoders: " & Util.Encoders.BASE_64 & ", "
                            & Util.Encoders.BASE_64_URL & ", "
                            & Util.Encoders.BASE_16 & ", "
                            & Util.Encoders.HASH_SHA1);
      return;
   end if;
   declare
      Name : constant String := Ada.Command_Line.Argument (1);
      C    : constant Encoder := Util.Encoders.Create (Name);
   begin
      for I in 2 .. Count loop
         declare
            S : constant String := Ada.Command_Line.Argument (I);
         begin
            if S = "-d" then
               Encode := False;
            elsif S = "-e" then
               Encode := True;
            elsif Encode then
               Ada.Text_IO.Put_Line ("Encodes " & Name & ": " & C.Encode (S));
            else
               Ada.Text_IO.Put_Line ("Decodes " & Name & ": " & C.Decode (S));
            end if;
         end;
      end loop;
   end;
end Encodes;

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

procedure Encodes is

   use Util.Encoders;

   Encode : Boolean := True;
   Count  : constant Natural := Ada.Command_Line.Argument_Count;

begin
   if Count <= 1 then
      Ada.Text_IO.Put_Line ("Usage: encodes {encoder} [-d|-e] string...");
      Ada.Text_IO.Put_Line ("Encoders: " & Util.Encoders.BASE_64 & ", "
                            & Util.Encoders.BASE_64_URL & ", "
                            & Util.Encoders.BASE_16 & ", "
                            & Util.Encoders.HASH_SHA1);
      return;
   end if;
   declare
      Name : constant String := Ada.Command_Line.Argument (1);
      C    : constant Encoder := Util.Encoders.Create (Name);
      D    : constant Decoder := Util.Encoders.Create (Name);
   begin
      for I in 2 .. Count loop
         declare
            S : constant String := Ada.Command_Line.Argument (I);
         begin
            if S = "-d" then
               Encode := False;
            elsif S = "-e" then
               Encode := True;
            elsif Encode then
               Ada.Text_IO.Put_Line ("Encodes " & Name & ": " & C.Encode (S));
            else
	       null;
               Ada.Text_IO.Put_Line ("Decodes " & Name & ": " & D.Decode (S));
            end if;
         end;
      end loop;
   end;
end Encodes;

fix encodes.adb by creating/using a Decoder in place of using Decode() over an Encoder.


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

with Util.Beans.Objects;
with Util.Streams;
with Util.Streams.Buffered;
with Util.Serialize.Contexts;
with Util.Serialize.Mappers;
with Util.Log.Loggers;
with Util.Stacks;
package Util.Serialize.IO is

   Parse_Error : exception;

   --  ------------------------------
   --  Output stream for serialization
   --  ------------------------------
   --  The Output_Stream interface defines the abstract operations for
   --  the serialization framework to write objects on the stream according to
   --  a target format such as XML or JSON.
   type Output_Stream is limited interface and Util.Streams.Output_Stream;

   --  Start a document.
   procedure Start_Document (Stream : in out Output_Stream) is null;

   --  Finish a document.
   procedure End_Document (Stream : in out Output_Stream) is null;

   procedure Start_Entity (Stream : in out Output_Stream;
                           Name   : in String) is null;

   procedure End_Entity (Stream : in out Output_Stream;
                         Name   : in String) is null;

   --  Write the attribute name/value pair.
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String) is abstract;

   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String) is abstract;

   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer) is abstract;

   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean) is abstract;

   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object) is abstract;

   procedure Write_Attribute (Stream : in out Output_Stream'Class;
                              Name   : in String;
                              Value  : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write the entity value.
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String) is abstract;

   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String) is abstract;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean) is abstract;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer) is abstract;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time) is abstract;

   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer) is abstract;

   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String) is abstract;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object) is abstract;

   procedure Write_Entity (Stream : in out Output_Stream'Class;
                           Name   : in String;
                           Value  : in Ada.Strings.Unbounded.Unbounded_String);

   procedure Start_Array (Stream : in out Output_Stream;
                          Name   : in String) is null;

   procedure End_Array (Stream : in out Output_Stream;
                        Name   : in String) is null;

   type Parser is abstract new Util.Serialize.Contexts.Context with private;

   --  Parse the stream using the JSON parser.
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class) is abstract;

   --  Read the file and parse it using the parser.
   procedure Parse (Handler : in out Parser;
                    File    : in String);

   --  Parse the content string.
   procedure Parse_String (Handler : in out Parser;
                           Content : in String);

   --  Returns true if the Parse operation detected at least one error.
   function Has_Error (Handler : in Parser) return Boolean;

   --  Set the error logger to report messages while parsing and reading the input file.
   procedure Set_Logger (Handler : in out Parser;
                         Logger  : in Util.Log.Loggers.Logger_Access);

   --  Start a new object associated with the given name.  This is called when
   --  the '{' is reached.  The reader must be updated so that the next
   --  Set_Member procedure will associate the name/value pair on the
   --  new object.
   procedure Start_Object (Handler : in out Parser;
                           Name    : in String);

   --  Finish an object associated with the given name.  The reader must be
   --  updated to be associated with the previous object.
   procedure Finish_Object (Handler : in out Parser;
                            Name    : in String);

   procedure Start_Array (Handler : in out Parser;
                          Name    : in String);

   procedure Finish_Array (Handler : in out Parser;
                           Name    : in String);

   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   procedure Set_Member (Handler   : in out Parser;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Attribute : in Boolean := False);

   --  Get the current location (file and line) to report an error message.
   function Get_Location (Handler : in Parser) return String;

   --  Report an error while parsing the input stream.  The error message will be reported
   --  on the logger associated with the parser.  The parser will be set as in error so that
   --  the Has_Error function will return True after parsing the whole file.
   procedure Error (Handler : in out Parser;
                    Message : in String);

   procedure Add_Mapping (Handler : in out Parser;
                          Path    : in String;
                          Mapper  : in Util.Serialize.Mappers.Mapper_Access);

   --  Dump the mapping tree on the logger using the INFO log level.
   procedure Dump (Handler : in Parser'Class;
                   Logger  : in Util.Log.Loggers.Logger'Class);

private

   --  Implementation limitation:  the max number of active mapping nodes
   MAX_NODES : constant Positive := 10;

   type Mapper_Access_Array is array (1 .. MAX_NODES) of Serialize.Mappers.Mapper_Access;

   procedure Push (Handler : in out Parser);

   --  Pop the context and restore the previous context when leaving an element
   procedure Pop (Handler  : in out Parser);

   function Find_Mapper (Handler : in Parser;
                         Name    : in String) return Util.Serialize.Mappers.Mapper_Access;

   type Element_Context is record
      --  The object mapper being process.
      Object_Mapper : Util.Serialize.Mappers.Mapper_Access;

      --  The active mapping nodes.
      Active_Nodes : Mapper_Access_Array;
   end record;
   type Element_Context_Access is access all Element_Context;

   package Context_Stack is new Util.Stacks (Element_Type => Element_Context,
                                             Element_Type_Access => Element_Context_Access);

   type Parser is abstract new Util.Serialize.Contexts.Context with record
      Error_Flag     : Boolean := False;
      Stack          : Context_Stack.Stack;
      Mapping_Tree   : aliased Mappers.Mapper;
      Current_Mapper : Util.Serialize.Mappers.Mapper_Access;

      --  The file name to use when reporting errors.
      File           : Ada.Strings.Unbounded.Unbounded_String;

      --  The logger which is used to report error messages when parsing an input file.
      Error_Logger   : Util.Log.Loggers.Logger_Access := null;
   end record;

end Util.Serialize.IO;

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

with Ada.Strings.Unbounded;
with Ada.Calendar;

with Util.Beans.Objects;
with Util.Streams;
with Util.Streams.Buffered;
with Util.Serialize.Contexts;
with Util.Serialize.Mappers;
with Util.Log.Loggers;
with Util.Stacks;
package Util.Serialize.IO is

   Parse_Error : exception;

   --  ------------------------------
   --  Output stream for serialization
   --  ------------------------------
   --  The Output_Stream interface defines the abstract operations for
   --  the serialization framework to write objects on the stream according to
   --  a target format such as XML or JSON.
   type Output_Stream is limited interface and Util.Streams.Output_Stream;

   --  Start a document.
   procedure Start_Document (Stream : in out Output_Stream) is null;

   --  Finish a document.
   procedure End_Document (Stream : in out Output_Stream) is null;

   procedure Start_Entity (Stream : in out Output_Stream;
                           Name   : in String) is null;

   procedure End_Entity (Stream : in out Output_Stream;
                         Name   : in String) is null;

   --  Write the attribute name/value pair.
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String) is abstract;

   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String) is abstract;

   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer) is abstract;

   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean) is abstract;

   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object) is abstract;

   procedure Write_Attribute (Stream : in out Output_Stream'Class;
                              Name   : in String;
                              Value  : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write the entity value.
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String) is abstract;

   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String) is abstract;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean) is abstract;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer) is abstract;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time) is abstract;

   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer) is abstract;

   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String) is abstract;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object) is abstract;

   procedure Write_Entity (Stream : in out Output_Stream'Class;
                           Name   : in String;
                           Value  : in Ada.Strings.Unbounded.Unbounded_String);

   procedure Start_Array (Stream : in out Output_Stream;
                          Name   : in String) is null;

   procedure End_Array (Stream : in out Output_Stream;
                        Name   : in String) is null;

   type Parser is abstract new Util.Serialize.Contexts.Context with private;

   --  Parse the stream using the JSON parser.
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class) is abstract;

   --  Read the file and parse it using the parser.
   procedure Parse (Handler : in out Parser;
                    File    : in String);

   --  Parse the content string.
   procedure Parse_String (Handler : in out Parser;
                           Content : in String);

   --  Returns true if the Parse operation detected at least one error.
   function Has_Error (Handler : in Parser) return Boolean;

   --  Set the error logger to report messages while parsing and reading the input file.
   procedure Set_Logger (Handler : in out Parser;
                         Logger  : in Util.Log.Loggers.Logger_Access);

   --  Start a new object associated with the given name.  This is called when
   --  the '{' is reached.  The reader must be updated so that the next
   --  Set_Member procedure will associate the name/value pair on the
   --  new object.
   procedure Start_Object (Handler : in out Parser;
                           Name    : in String);

   --  Finish an object associated with the given name.  The reader must be
   --  updated to be associated with the previous object.
   procedure Finish_Object (Handler : in out Parser;
                            Name    : in String);

   procedure Start_Array (Handler : in out Parser;
                          Name    : in String);

   procedure Finish_Array (Handler : in out Parser;
                           Name    : in String);

   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   procedure Set_Member (Handler   : in out Parser;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Attribute : in Boolean := False);

   --  Get the current location (file and line) to report an error message.
   function Get_Location (Handler : in Parser) return String;

   --  Report an error while parsing the input stream.  The error message will be reported
   --  on the logger associated with the parser.  The parser will be set as in error so that
   --  the Has_Error function will return True after parsing the whole file.
   procedure Error (Handler : in out Parser;
                    Message : in String);

   procedure Add_Mapping (Handler : in out Parser;
                          Path    : in String;
                          Mapper  : in Util.Serialize.Mappers.Mapper_Access);

   --  Dump the mapping tree on the logger using the INFO log level.
   procedure Dump (Handler : in Parser'Class;
                   Logger  : in Util.Log.Loggers.Logger'Class);

private

   --  Implementation limitation:  the max number of active mapping nodes
   MAX_NODES : constant Positive := 10;

   type Mapper_Access_Array is array (1 .. MAX_NODES) of Serialize.Mappers.Mapper_Access;

   procedure Push (Handler : in out Parser);

   --  Pop the context and restore the previous context when leaving an element
   procedure Pop (Handler  : in out Parser);

   function Find_Mapper (Handler : in Parser;
                         Name    : in String) return Util.Serialize.Mappers.Mapper_Access;

   type Element_Context is record
      --  The object mapper being process.
      Object_Mapper : Util.Serialize.Mappers.Mapper_Access;

      --  The active mapping nodes.
      Active_Nodes : Mapper_Access_Array;
   end record;
   type Element_Context_Access is access all Element_Context;

   package Context_Stack is new Util.Stacks (Element_Type => Element_Context,
                                             Element_Type_Access => Element_Context_Access);

   type Parser is abstract new Util.Serialize.Contexts.Context with record
      Error_Flag     : Boolean := False;
      Stack          : Context_Stack.Stack;
      Mapping_Tree   : aliased Mappers.Mapper;
      Current_Mapper : Util.Serialize.Mappers.Mapper_Access;

      --  The file name to use when reporting errors.
      File           : Ada.Strings.Unbounded.Unbounded_String;

      --  The logger which is used to report error messages when parsing an input file.
      Error_Logger   : Util.Log.Loggers.Logger_Access := null;
   end record;

end Util.Serialize.IO;

Remove with clause Ada.Containers

Remove with clause Ada.Containers