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

with GNAT.Command_Line;

with ASF.Applications.Main;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;

with EL.Objects;
--  This example reads an XHTML file and renders the result.
procedure Render is

   use GNAT.Command_Line;
   use Ada.Strings.Fixed;

   use ASF;

   use EL.Objects;

   Factory  : ASF.Applications.Main.Application_Factory;
   App      : Applications.Main.Application;
   Conf     : Applications.Config;
begin
   Conf.Set ("view.ignore_white_spaces", "false");
   Conf.Set ("view.escape_unknown_tags", "false");
   Conf.Set ("view.ignore_empty_lines", "true");

   App.Initialize (Conf, Factory);
   loop
      case Getopt ("D:") is
         when 'D' =>
            declare
               Value : constant String := Parameter;
               Pos   : constant Natural := Index (Value, "=");
            begin
               if Pos > 0 then
                  App.Set_Global (Name  => Value (1 .. Pos - 1),
                                  Value => To_Object (Value (Pos + 1 .. Value'Last)));
               else
                  App.Set_Global (Name  => Value (1 .. Pos - 1),
                                  Value => To_Object(True));
               end if;
            end;

         when others =>
            exit;
      end case;
   end loop;

   declare
      View_Name : constant String := Get_Argument;
      Req       : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Content   : Ada.Strings.Unbounded.Unbounded_String;
   begin

      Req.Set_Path_Info (View_Name);
      App.Dispatch (Page     => View_Name,
                    Request  => Req,
                    Response => Reply);

      Reply.Read_Content (Content);
      Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Content));

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot read file '" & View_Name & "'");
   end;
end Render;

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

with GNAT.Command_Line;

with ASF.Applications.Main;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;

with EL.Objects;
--  This example reads an XHTML file and renders the result.
procedure Render is

   use GNAT.Command_Line;
   use Ada.Strings.Fixed;

   use ASF;

   use EL.Objects;

   Factory  : ASF.Applications.Main.Application_Factory;
   App      : Applications.Main.Application;
   Conf     : Applications.Config;
begin
   Conf.Set ("view.ignore_white_spaces", "false");
   Conf.Set ("view.escape_unknown_tags", "false");
   Conf.Set ("view.ignore_empty_lines", "true");

   App.Initialize (Conf, Factory);
   loop
      case Getopt ("D:") is
         when 'D' =>
            declare
               Value : constant String := Parameter;
               Pos   : constant Natural := Index (Value, "=");
            begin
               if Pos > 0 then
                  App.Set_Global (Name  => Value (Value'First .. Pos - 1),
                                  Value => To_Object (Value (Pos + 1 .. Value'Last)));
               else
                  App.Set_Global (Name  => Value (Value'First .. Pos - 1),
                                  Value => To_Object (True));
               end if;
            end;

         when others =>
            exit;
      end case;
   end loop;

   declare
      View_Name : constant String := Get_Argument;
      Pos       : constant Natural := Index (View_Name, ".");
      Req       : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Content   : Ada.Strings.Unbounded.Unbounded_String;
   begin
      if View_Name = "" or Pos = 0 then
         Ada.Text_IO.Put_Line ("Usage: render [-DNAME=VALUE ] file");
         Ada.Text_IO.Put_Line ("Example: render -DcontextPath=/test samples/web/ajax.xhtml");
         return;
      end if;

      Req.Set_Path_Info (View_Name (View_Name'First .. Pos - 1));
      App.Dispatch (Page     => View_Name (View_Name'First .. Pos - 1),
                    Request  => Req,
                    Response => Reply);

      Reply.Read_Content (Content);
      Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Content));

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot read file '" & View_Name & "'");
   end;
end Render;

Fix usage of render example

Fix usage of render example


-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  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.Unchecked_Deallocation;
with ADO.Queries.Loaders;
package body ADO.Queries is

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   --  ------------------------------
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := False;
   end Set_Query;

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   --  ------------------------------
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := True;
   end Set_Count_Query;

   procedure Set_Query (Into  : in out Context;
                        Name  : in String) is
   begin
      Into.Query_Def := ADO.Queries.Loaders.Find_Query (Name);
   end Set_Query;

   --  ------------------------------
   --  Set the query to execute as SQL statement.
   --  ------------------------------
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String) is
   begin
      ADO.SQL.Clear (Into.SQL);
      ADO.SQL.Append (Into.SQL, SQL);
   end Set_SQL;

   --  ------------------------------
   --  Set the limit for the SQL query.
   --  ------------------------------
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural) is
   begin
      Into.First := First;
      Into.Last  := Last;
   end Set_Limit;

   --  ------------------------------
   --  Get the first row index.
   --  ------------------------------
   function Get_First_Row_Index (From : in Context) return Natural is
   begin
      return From.First;
   end Get_First_Row_Index;

   --  ------------------------------
   --  Get the last row index.
   --  ------------------------------
   function Get_Last_Row_Index (From : in Context) return Natural is
   begin
      return From.Last;
   end Get_Last_Row_Index;

   --  ------------------------------
   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the <b>sql-count</b> query.
   --  ------------------------------
   function Get_Max_Row_Count (From : in Context) return Natural is
   begin
      return From.Max_Row_Count;
   end Get_Max_Row_Count;

   --  ------------------------------
   --  Get the SQL query that correspond to the query context.
   --  ------------------------------
   function Get_SQL (From   : in Context;
                     Manager : in Query_Manager'Class) return String is
   begin
      if From.Query_Def = null then
         return ADO.SQL.To_String (From.SQL);
      else
         return Get_SQL (From.Query_Def, Manager, From.Is_Count);
      end if;
   end Get_SQL;

   --  ------------------------------
   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   --  ------------------------------
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access is
      Query : Query_Definition_Access := File.File.Queries;
   begin
      while Query /= null loop
         if Query.Name.all = Name then
            return Query;
         end if;
         Query := Query.Next;
      end loop;
      return null;
   end Find_Query;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String is
      Query : Query_Info_Ref.Ref;
   begin
      ADO.Queries.Loaders.Read_Query (Manager, From);
      Query := Manager.Queries (From.Query).Get;
      if Query.Is_Null then
         return "";
      end if;
      if Use_Count then
         if Length (Query.Value.Count_Query (Manager.Driver).SQL) > 0 then
            return To_String (Query.Value.Count_Query (Manager.Driver).SQL);
         else
            return To_String (Query.Value.Count_Query (ADO.Drivers.Driver_Index'First).SQL);
         end if;
      elsif Length (Query.Value.Main_Query (Manager.Driver).SQL) > 0 then
         return To_String (Query.Value.Main_Query (Manager.Driver).SQL);
      else
         return To_String (Query.Value.Main_Query (ADO.Drivers.Driver_Index'First).SQL);
      end if;
   end Get_SQL;

   overriding
   procedure Finalize (Manager : in out Query_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => File_Table,
                                        Name   => File_Table_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Query_Table,
                                        Name   => Query_Table_Access);
   begin
      Free (Manager.Queries);
      Free (Manager.Files);
   end Finalize;

end ADO.Queries;

-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  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.Unchecked_Deallocation;
with ADO.Queries.Loaders;
package body ADO.Queries is

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   --  ------------------------------
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := False;
   end Set_Query;

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   --  ------------------------------
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := True;
   end Set_Count_Query;

   procedure Set_Query (Into  : in out Context;
                        Name  : in String) is
   begin
      Into.Query_Def := ADO.Queries.Loaders.Find_Query (Name);
   end Set_Query;

   --  ------------------------------
   --  Set the query to execute as SQL statement.
   --  ------------------------------
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String) is
   begin
      ADO.SQL.Clear (Into.SQL);
      ADO.SQL.Append (Into.SQL, SQL);
   end Set_SQL;

   --  ------------------------------
   --  Set the limit for the SQL query.
   --  ------------------------------
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural) is
   begin
      Into.First := First;
      Into.Last  := Last;
   end Set_Limit;

   --  ------------------------------
   --  Get the first row index.
   --  ------------------------------
   function Get_First_Row_Index (From : in Context) return Natural is
   begin
      return From.First;
   end Get_First_Row_Index;

   --  ------------------------------
   --  Get the last row index.
   --  ------------------------------
   function Get_Last_Row_Index (From : in Context) return Natural is
   begin
      return From.Last;
   end Get_Last_Row_Index;

   --  ------------------------------
   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the <b>sql-count</b> query.
   --  ------------------------------
   function Get_Max_Row_Count (From : in Context) return Natural is
   begin
      return From.Max_Row_Count;
   end Get_Max_Row_Count;

   --  ------------------------------
   --  Get the SQL query that correspond to the query context.
   --  ------------------------------
   function Get_SQL (From   : in Context;
                     Manager : in Query_Manager'Class) return String is
   begin
      if From.Query_Def = null then
         return ADO.SQL.To_String (From.SQL);
      else
         return Get_SQL (From.Query_Def, Manager, From.Is_Count);
      end if;
   end Get_SQL;

   --  ------------------------------
   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   --  ------------------------------
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access is
      Query : Query_Definition_Access := File.File.Queries;
   begin
      while Query /= null loop
         if Query.Name.all = Name then
            return Query;
         end if;
         Query := Query.Next;
      end loop;
      return null;
   end Find_Query;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String is
      Query : Query_Info_Ref.Ref;
   begin
      ADO.Queries.Loaders.Read_Query (Manager, From);
      Query := Manager.Queries (From.Query);
      if Query.Is_Null then
         return "";
      end if;
      if Use_Count then
         if Length (Query.Value.Count_Query (Manager.Driver).SQL) > 0 then
            return To_String (Query.Value.Count_Query (Manager.Driver).SQL);
         else
            return To_String (Query.Value.Count_Query (ADO.Drivers.Driver_Index'First).SQL);
         end if;
      elsif Length (Query.Value.Main_Query (Manager.Driver).SQL) > 0 then
         return To_String (Query.Value.Main_Query (Manager.Driver).SQL);
      else
         return To_String (Query.Value.Main_Query (ADO.Drivers.Driver_Index'First).SQL);
      end if;
   end Get_SQL;

   overriding
   procedure Finalize (Manager : in out Query_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => File_Table,
                                        Name   => File_Table_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Query_Table,
                                        Name   => Query_Table_Access);
   begin
      Free (Manager.Queries);
      Free (Manager.Files);
   end Finalize;

end ADO.Queries;

Update to use the simple reference

Update to use the simple reference


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

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

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

   Hex_Encoder : Util.Encoders.Base16.Encoder;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  Return the user uid.
   --  ------------------------------
   function Get_User (Element : in File_Type) return Uid_Type is
   begin
      return Element.User;
   end Get_User;

   --  ------------------------------
   --  Return the group gid.
   --  ------------------------------
   function Get_Group (Element : in File_Type) return Gid_Type is
   begin
      return Element.Group;
   end Get_Group;

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

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

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

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

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

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

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

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

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

end Babel.Files;

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

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

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

   Hex_Encoder : Util.Encoders.Base16.Encoder;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  Return the user uid.
   --  ------------------------------
   function Get_User (Element : in File_Type) return Uid_Type is
   begin
      return Element.User;
   end Get_User;

   --  ------------------------------
   --  Return the group gid.
   --  ------------------------------
   function Get_Group (Element : in File_Type) return Gid_Type is
   begin
      return Element.Group;
   end Get_Group;

   --  ------------------------------
   --  Return the file unix mode.
   --  ------------------------------
   function Get_Mode (Element : in File_Type) return File_Mode is
   begin
      return Element.Mode;
   end Get_Mode;

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

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

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

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

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

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

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

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

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

end Babel.Files;

Implement the Get_Mode operation

Implement the Get_Mode operation


-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  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 MAT.Frames;
with Util.Events;
with MAT.Memory.Events;
with MAT.Readers;
with Ada.Containers.Ordered_Maps;
package MAT.Memory.Targets is

   type Target_Memory is tagged limited private;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation);

   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation);

   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   procedure Probe_Realloc (Memory   : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type);

   type Size_Info_Type is record
      Count : Natural;
   end record;

   use type MAT.Types.Target_Size;

   package Size_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type => MAT.Types.Target_Size,
                                      Element_Type => Size_Info_Type);
   subtype Size_Info_Map is Size_Info_Maps.Map;
   subtype Size_Info_Cursor is Size_Info_Maps.Cursor;

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out Size_Info_Map);

private

   protected type Memory_Allocator is

      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation);

      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation);

      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation);

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type);

      --  Collect the information about memory slot sizes allocated by the application.
      procedure Size_Information (Sizes  : in out Size_Info_Map);

   private
      Used_Slots    : Allocation_Map;
      Freed_Slots   : Allocation_Map;
      Frames        : MAT.Frames.Frame_Type := MAT.Frames.Create_Root;
   end Memory_Allocator;

   type Target_Memory is tagged limited record
      Reader        : MAT.Readers.Reader_Access;
      Memory        : Memory_Allocator;
   end record;

end MAT.Memory.Targets;

-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  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.Containers.Ordered_Maps;

with Util.Events;

with MAT.Frames;
with MAT.Readers;
with MAT.Memory.Events;
with MAT.Memory.Tools;
package MAT.Memory.Targets is

   type Target_Memory is tagged limited private;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation);

   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation);

   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   procedure Probe_Realloc (Memory   : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type);

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

private

   protected type Memory_Allocator is

      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation);

      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation);

      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation);

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type);

      --  Collect the information about memory slot sizes allocated by the application.
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

   private
      Used_Slots    : Allocation_Map;
      Freed_Slots   : Allocation_Map;
      Frames        : MAT.Frames.Frame_Type := MAT.Frames.Create_Root;
   end Memory_Allocator;

   type Target_Memory is tagged limited record
      Reader        : MAT.Readers.Reader_Access;
      Memory        : Memory_Allocator;
   end record;

end MAT.Memory.Targets;

Use the MAT.Memory.Tools package for the sizes map


-----------------------------------------------------------------------
--  awa-workspaces-beans -- Beans for module workspaces
--  Copyright (C) 2011, 2012, 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.Events.Faces.Actions;

with ADO.Utils;
with ADO.Sessions.Entities;
with ADO.Sessions;
with ADO.Queries;
with ADO.Datasets;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Events.Action_Method;
with AWA.Services.Contexts;
package body AWA.Workspaces.Beans is

   package ASC renames AWA.Services.Contexts;

   overriding
   procedure Load (Bean : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Load_Invitation (Key        => Ada.Strings.Unbounded.To_String (Bean.Key),
                                   Invitation => Bean);

   exception
      when others =>
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
   end Load;

   overriding
   procedure Accept_Invitation (Bean    : in out Invitation_Bean;
                                Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Accept_Invitation;

   overriding
   procedure Send (Bean    : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Send_Invitation (Bean);
   end Send;

   --  ------------------------------
   --  Create the Invitation_Bean bean instance.
   --  ------------------------------
   function Create_Invitation_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Invitation_Bean_Access := new Invitation_Bean;
   begin
      Object.Module := Module;
      return Object;
   end Create_Invitation_Bean;

   --  ------------------------------
   --  Example of action method.
   --  ------------------------------
   procedure Action (Bean    : in out Workspaces_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Action;

   --  ------------------------------
   --  Event action called to create the workspace when the given event is posted.
   --  ------------------------------
   procedure Create (Bean  : in out Workspaces_Bean;
                     Event : in AWA.Events.Module_Event'Class) is
      pragma Unreferenced (Bean, Event);

      WS  : AWA.Workspaces.Models.Workspace_Ref;
      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (Session   => DB,
                                            Context   => Ctx,
                                            Workspace => WS);
      Ctx.Commit;
   end Create;

   package Action_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Workspaces_Bean,
                                                      Method => Action,
                                                      Name   => "action");

   package Create_Binding is
      new AWA.Events.Action_Method.Bind (Name   => "create",
                                         Bean   => Workspaces_Bean,
                                         Method => Create);

   Workspaces_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Action_Binding.Proxy'Access, Create_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Workspaces_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "count" then
         return Util.Beans.Objects.To_Object (From.Count);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Workspaces_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "count" then
         From.Count := Util.Beans.Objects.To_Integer (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Workspaces_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Workspaces_Bean_Binding'Access;
   end Get_Method_Bindings;

   --  ------------------------------
   --  Create the Workspaces_Bean bean instance.
   --  ------------------------------
   function Create_Workspaces_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Workspaces_Bean_Access := new Workspaces_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Workspaces_Bean;

   --  ------------------------------
   --  Load the list of members.
   --  ------------------------------
   overriding
   procedure Load (Into    : in out Member_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      User        : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session     : ADO.Sessions.Session := Into.Module.Get_Session;
      Query       : ADO.Queries.Context;
      Count_Query : ADO.Queries.Context;
      First       : constant Natural  := (Into.Page - 1) * Into.Page_Size;
   begin
      Query.Set_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
      Count_Query.Set_Count_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
--        ADO.Sessions.Entities.Bind_Param (Params  => Query,
--                                          Name    => "page_table",
--                                          Table   => AWA.Wikis.Models.WIKI_PAGE_TABLE,
--                                          Session => Session);
      Query.Bind_Param (Name => "user_id", Value => User);
      Count_Query.Bind_Param (Name => "user_id", Value => User);
      AWA.Workspaces.Models.List (Into.Members, Session, Query);
      Into.Count := ADO.Datasets.Get_Count (Session, Count_Query);
   end Load;

   --  ------------------------------
   --  Create the Member_List_Bean bean instance.
   --  ------------------------------
   function Create_Member_List_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Member_List_Bean_Access := new Member_List_Bean;
   begin
      Object.Module     := Module;
      Object.Members_Bean := Object.Members'Access;
      Object.Page_Size  := 20;
      Object.Page       := 1;
      Object.Count      := 0;
      return Object.all'Access;
   end Create_Member_List_Bean;

end AWA.Workspaces.Beans;

-----------------------------------------------------------------------
--  awa-workspaces-beans -- Beans for module workspaces
--  Copyright (C) 2011, 2012, 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.Events.Faces.Actions;

with ADO.Utils;
with ADO.Sessions.Entities;
with ADO.Sessions;
with ADO.Queries;
with ADO.Datasets;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Events.Action_Method;
with AWA.Services.Contexts;
package body AWA.Workspaces.Beans is

   package ASC renames AWA.Services.Contexts;

   overriding
   procedure Load (Bean : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Load_Invitation (Key        => Ada.Strings.Unbounded.To_String (Bean.Key),
                                   Invitation => Bean);

   exception
      when others =>
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
   end Load;

   overriding
   procedure Accept_Invitation (Bean    : in out Invitation_Bean;
                                Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Accept_Invitation;

   overriding
   procedure Send (Bean    : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Send_Invitation (Bean);
   end Send;

   --  ------------------------------
   --  Create the Invitation_Bean bean instance.
   --  ------------------------------
   function Create_Invitation_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Invitation_Bean_Access := new Invitation_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Invitation_Bean;

   --  ------------------------------
   --  Example of action method.
   --  ------------------------------
   procedure Action (Bean    : in out Workspaces_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Action;

   --  ------------------------------
   --  Event action called to create the workspace when the given event is posted.
   --  ------------------------------
   procedure Create (Bean  : in out Workspaces_Bean;
                     Event : in AWA.Events.Module_Event'Class) is
      pragma Unreferenced (Bean, Event);

      WS  : AWA.Workspaces.Models.Workspace_Ref;
      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (Session   => DB,
                                            Context   => Ctx,
                                            Workspace => WS);
      Ctx.Commit;
   end Create;

   package Action_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Workspaces_Bean,
                                                      Method => Action,
                                                      Name   => "action");

   package Create_Binding is
      new AWA.Events.Action_Method.Bind (Name   => "create",
                                         Bean   => Workspaces_Bean,
                                         Method => Create);

   Workspaces_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Action_Binding.Proxy'Access, Create_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Workspaces_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "count" then
         return Util.Beans.Objects.To_Object (From.Count);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Workspaces_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "count" then
         From.Count := Util.Beans.Objects.To_Integer (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Workspaces_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Workspaces_Bean_Binding'Access;
   end Get_Method_Bindings;

   --  ------------------------------
   --  Create the Workspaces_Bean bean instance.
   --  ------------------------------
   function Create_Workspaces_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Workspaces_Bean_Access := new Workspaces_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Workspaces_Bean;

   --  ------------------------------
   --  Load the list of members.
   --  ------------------------------
   overriding
   procedure Load (Into    : in out Member_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      User        : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session     : ADO.Sessions.Session := Into.Module.Get_Session;
      Query       : ADO.Queries.Context;
      Count_Query : ADO.Queries.Context;
      First       : constant Natural  := (Into.Page - 1) * Into.Page_Size;
   begin
      Query.Set_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
      Count_Query.Set_Count_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
--        ADO.Sessions.Entities.Bind_Param (Params  => Query,
--                                          Name    => "page_table",
--                                          Table   => AWA.Wikis.Models.WIKI_PAGE_TABLE,
--                                          Session => Session);
      Query.Bind_Param (Name => "user_id", Value => User);
      Count_Query.Bind_Param (Name => "user_id", Value => User);
      AWA.Workspaces.Models.List (Into.Members, Session, Query);
      Into.Count := ADO.Datasets.Get_Count (Session, Count_Query);
   end Load;

   --  ------------------------------
   --  Create the Member_List_Bean bean instance.
   --  ------------------------------
   function Create_Member_List_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Member_List_Bean_Access := new Member_List_Bean;
   begin
      Object.Module     := Module;
      Object.Members_Bean := Object.Members'Access;
      Object.Page_Size  := 20;
      Object.Page       := 1;
      Object.Count      := 0;
      return Object.all'Access;
   end Create_Member_List_Bean;

end AWA.Workspaces.Beans;

Fix compilation with gcc 4.6 that does not support all Ada 2012 features


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

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Dates.ISO8601.Image",
                       Test_ISO8601_Image'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.ISO8601.Value",
                       Test_ISO8601_Value'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.ISO8601.Value (Errors)",
                       Test_ISO8601_Error'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test converting a date in ISO8601.
   --  ------------------------------
   procedure Test_ISO8601_Image (T : in out Test) is
      T1 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (1980, 1, 2, 10, 30, 23);
   begin
      Util.Tests.Assert_Equals (T, "1980-01-02", ISO8601.Image (T1),
                                "Invalid Image");

      Util.Tests.Assert_Equals (T, "1980", ISO8601.Image (T1, ISO8601.YEAR),
                                "Invalid Image (YEAR precision)");

      Util.Tests.Assert_Equals (T, "1980-01", ISO8601.Image (T1, ISO8601.MONTH),
                                "Invalid Image (MONTH precision)");

      Util.Tests.Assert_Equals (T, "1980-01-02", ISO8601.Image (T1, ISO8601.DAY),
                                "Invalid Image (DAY precision)");

      Util.Tests.Assert_Equals (T, "1980-01-02T10", ISO8601.Image (T1, ISO8601.HOUR),
                                "Invalid Image (DAY precision)");

      Util.Tests.Assert_Equals (T, "1980-01-02T10:30", ISO8601.Image (T1, ISO8601.MINUTE),
                                "Invalid Image (MINUTE precision)");

      Util.Tests.Assert_Equals (T, "1980-01-02T10:30:23", ISO8601.Image (T1, ISO8601.SECOND),
                                "Invalid Image (SECOND precision)");

   end Test_ISO8601_Image;

   --  ------------------------------
   --  Test converting a string in ISO8601 into a date.
   --  ------------------------------
   procedure Test_ISO8601_Value (T : in out Test) is
      Date   : Ada.Calendar.Time;
   begin
      Date := ISO8601.Value ("1980");
      Util.Tests.Assert_Equals (T, "1980-01-01", ISO8601.Image (Date));

      Date := ISO8601.Value ("1980-02");
      Util.Tests.Assert_Equals (T, "1980-02", ISO8601.Image (Date, ISO8601.MONTH));

      Date := ISO8601.Value ("1980-03-04");
      Util.Tests.Assert_Equals (T, "1980-03-04", ISO8601.Image (Date));

      Date := ISO8601.Value ("1980-03-04");
      Util.Tests.Assert_Equals (T, "1980-03-04", ISO8601.Image (Date));

      Date := ISO8601.Value ("1980-12-31");
      Util.Tests.Assert_Equals (T, "1980-12-31", ISO8601.Image (Date));

      Date := ISO8601.Value ("19801231");
      Util.Tests.Assert_Equals (T, "1980-12-31", ISO8601.Image (Date));

      Date := ISO8601.Value ("1980-12-31T11:23");
      Util.Tests.Assert_Equals (T, "1980-12-31T11:23", ISO8601.Image (Date, ISO8601.MINUTE));

      Date := ISO8601.Value ("1980-12-31T11:23:34");
      Util.Tests.Assert_Equals (T, "1980-12-31T11:23:34", ISO8601.Image (Date, ISO8601.SECOND));

      Date := ISO8601.Value ("1980-12-31T11:23:34.123");
      Util.Tests.Assert_Equals (T, "1980-12-31T11:23:34.123+00:00",
                                ISO8601.Image (Date, ISO8601.SUBSECOND));

      Date := ISO8601.Value ("1980-12-31T11:23:34.123+04:30");
      --  The date was normalized in GMT
      Util.Tests.Assert_Equals (T, "1980-12-31T06:53:34.123+00:00",
                                ISO8601.Image (Date, ISO8601.SUBSECOND));
   end Test_ISO8601_Value;

   --  ------------------------------
   --  Test value convertion errors.
   --  ------------------------------
   procedure Test_ISO8601_Error (T : in out Test) is
      procedure Check (Date : in String);

      procedure Check (Date : in String) is
      begin
         declare
            Unused : constant Ada.Calendar.Time := ISO8601.Value (Date);
         begin
            T.Fail ("No exception raised for " & Date);

         end;

      exception
         when Constraint_Error =>
            null;
      end Check;

   begin
      Check ("");
      Check ("1980-");
      Check ("1980:02:03");
      Check ("1980-02-03u33:33");
      Check ("1980-02-03u33");
      Check ("1980-13-44");
      Check ("1980-12-00");
      Check ("1980-12-03T25:34");
      Check ("1980-12-03T10x34");
      Check ("1980-12-03T10:34p");
      Check ("1980-12-31T11:23:34123");
      Check ("1980-12-31T11:23:34,1");
      Check ("1980-12-31T11:23:34,12");
      Check ("1980-12-31T11:23:34x123");
      Check ("1980-12-31T11:23:34.1234");
      Check ("1980-12-31T11:23:34Zp");
      Check ("1980-12-31T11:23:34+2");
      Check ("1980-12-31T11:23:34+23x");
      Check ("1980-12-31T11:23:34+99");
      Check ("1980-12-31T11:23:34+10:0");
      Check ("1980-12-31T11:23:34+10:03x");
   end Test_ISO8601_Error;

end Util.Dates.Tests;

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

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Dates.ISO8601.Image",
                       Test_ISO8601_Image'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.ISO8601.Value",
                       Test_ISO8601_Value'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.ISO8601.Value (Errors)",
                       Test_ISO8601_Error'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Is_Same_Day",
                       Test_Is_Same_Day'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test converting a date in ISO8601.
   --  ------------------------------
   procedure Test_ISO8601_Image (T : in out Test) is
      T1 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (1980, 1, 2, 10, 30, 23);
   begin
      Util.Tests.Assert_Equals (T, "1980-01-02", ISO8601.Image (T1),
                                "Invalid Image");

      Util.Tests.Assert_Equals (T, "1980", ISO8601.Image (T1, ISO8601.YEAR),
                                "Invalid Image (YEAR precision)");

      Util.Tests.Assert_Equals (T, "1980-01", ISO8601.Image (T1, ISO8601.MONTH),
                                "Invalid Image (MONTH precision)");

      Util.Tests.Assert_Equals (T, "1980-01-02", ISO8601.Image (T1, ISO8601.DAY),
                                "Invalid Image (DAY precision)");

      Util.Tests.Assert_Equals (T, "1980-01-02T10", ISO8601.Image (T1, ISO8601.HOUR),
                                "Invalid Image (DAY precision)");

      Util.Tests.Assert_Equals (T, "1980-01-02T10:30", ISO8601.Image (T1, ISO8601.MINUTE),
                                "Invalid Image (MINUTE precision)");

      Util.Tests.Assert_Equals (T, "1980-01-02T10:30:23", ISO8601.Image (T1, ISO8601.SECOND),
                                "Invalid Image (SECOND precision)");

   end Test_ISO8601_Image;

   --  ------------------------------
   --  Test converting a string in ISO8601 into a date.
   --  ------------------------------
   procedure Test_ISO8601_Value (T : in out Test) is
      Date   : Ada.Calendar.Time;
   begin
      Date := ISO8601.Value ("1980");
      Util.Tests.Assert_Equals (T, "1980-01-01", ISO8601.Image (Date));

      Date := ISO8601.Value ("1980-02");
      Util.Tests.Assert_Equals (T, "1980-02", ISO8601.Image (Date, ISO8601.MONTH));

      Date := ISO8601.Value ("1980-03-04");
      Util.Tests.Assert_Equals (T, "1980-03-04", ISO8601.Image (Date));

      Date := ISO8601.Value ("1980-03-04");
      Util.Tests.Assert_Equals (T, "1980-03-04", ISO8601.Image (Date));

      Date := ISO8601.Value ("1980-12-31");
      Util.Tests.Assert_Equals (T, "1980-12-31", ISO8601.Image (Date));

      Date := ISO8601.Value ("19801231");
      Util.Tests.Assert_Equals (T, "1980-12-31", ISO8601.Image (Date));

      Date := ISO8601.Value ("1980-12-31T11:23");
      Util.Tests.Assert_Equals (T, "1980-12-31T11:23", ISO8601.Image (Date, ISO8601.MINUTE));

      Date := ISO8601.Value ("1980-12-31T11:23:34");
      Util.Tests.Assert_Equals (T, "1980-12-31T11:23:34", ISO8601.Image (Date, ISO8601.SECOND));

      Date := ISO8601.Value ("1980-12-31T11:23:34.123");
      Util.Tests.Assert_Equals (T, "1980-12-31T11:23:34.123+00:00",
                                ISO8601.Image (Date, ISO8601.SUBSECOND));

      Date := ISO8601.Value ("1980-12-31T11:23:34.123+04:30");
      --  The date was normalized in GMT
      Util.Tests.Assert_Equals (T, "1980-12-31T06:53:34.123+00:00",
                                ISO8601.Image (Date, ISO8601.SUBSECOND));
   end Test_ISO8601_Value;

   --  ------------------------------
   --  Test value convertion errors.
   --  ------------------------------
   procedure Test_ISO8601_Error (T : in out Test) is
      procedure Check (Date : in String);

      procedure Check (Date : in String) is
      begin
         declare
            Unused : constant Ada.Calendar.Time := ISO8601.Value (Date);
         begin
            T.Fail ("No exception raised for " & Date);

         end;

      exception
         when Constraint_Error =>
            null;
      end Check;

   begin
      Check ("");
      Check ("1980-");
      Check ("1980:02:03");
      Check ("1980-02-03u33:33");
      Check ("1980-02-03u33");
      Check ("1980-13-44");
      Check ("1980-12-00");
      Check ("1980-12-03T25:34");
      Check ("1980-12-03T10x34");
      Check ("1980-12-03T10:34p");
      Check ("1980-12-31T11:23:34123");
      Check ("1980-12-31T11:23:34,1");
      Check ("1980-12-31T11:23:34,12");
      Check ("1980-12-31T11:23:34x123");
      Check ("1980-12-31T11:23:34.1234");
      Check ("1980-12-31T11:23:34Zp");
      Check ("1980-12-31T11:23:34+2");
      Check ("1980-12-31T11:23:34+23x");
      Check ("1980-12-31T11:23:34+99");
      Check ("1980-12-31T11:23:34+10:0");
      Check ("1980-12-31T11:23:34+10:03x");
   end Test_ISO8601_Error;

   --  ------------------------------
   --  Test Is_Same_Day operation.
   --  ------------------------------
   procedure Test_Is_Same_Day (T : in out Test) is
      procedure Check (D1, D2   : in String;
                       Same_Day : in Boolean);

      procedure Check (D1, D2   : in String;
                       Same_Day : in Boolean) is
         T1 : constant Ada.Calendar.Time := ISO8601.Value (D1);
         T2 : constant Ada.Calendar.Time := ISO8601.Value (D2);
      begin
         T.Assert (Same_Day = Is_Same_Day (T1, T2), "Invalid Is_Same_Day for " & D1 & " " & D2);
         T.Assert (Same_Day = Is_Same_Day (T2, T1), "Invalid Is_Same_Day for " & D2 & " " & D1);
      end Check;

   begin
      Check ("1980-12-31T11:23:34.123", "1980-12-31T10:23:34.123", True);
      Check ("1980-12-31T11:23:34.123", "1980-12-30T10:23:34.123", False);
      Check ("1980-12-31T00:00:00", "1980-12-31T23:59:59", True);
   end Test_Is_Same_Day;

end Util.Dates.Tests;

Add new test for Is_Same_Day operation

Add new test for Is_Same_Day operation


-- Lua.Userdata
-- Adding Ada objects to Lua environment

-- Copyright (c) 2015, James Humphry - see LICENSE.md for terms

with System.Address_To_Access_Conversions;

with Interfaces, Interfaces.C, Interfaces.C.Strings;
use Interfaces;

with Lua.Internal, Lua.AuxInternal;

package body Lua.Userdata is

   use type Ada.Tags.Tag;
   use type C.int;

   --
   -- *** Conversions between C types and Ada types
   --

   package Address_To_Ada_Userdata is
     new System.Address_To_Access_Conversions(Object => Ada_Userdata);

   procedure Push (L : in Lua_State'Class; D : not null access T) is
      UserData_Address : System.Address
        := Internal.lua_newuserdata(L.L, Ada_Userdata'Size);
      UserData_Access : access Ada_Userdata
        := Address_To_Ada_Userdata.To_Pointer(UserData_Address);
      Has_Metatable : Boolean;
   begin
      UserData_Access.all.Tag := T'Tag;
      UserData_Access.all.Data := D;
      Has_Metatable := GetMetaTable(L);
      if Has_Metatable then
         Setmetatable(L, -2);
      end if;
   end Push;

   function ToUserdata (L : in Lua_State'Class; index : in Integer)
      return not null access T
   is
      UserData_Address : System.Address
        := Internal.lua_touserdata(L.L, C.int(index));
      UserData_Access : access Ada_Userdata
        := Address_To_Ada_Userdata.To_Pointer(UserData_Address);
   begin
      if UserData_Access = null then
         raise Program_Error with "Attempting to access non-userdata as userdata";
      elsif UserData_Access.Tag /= T'Tag then
         raise Program_Error with "Attempting invalid userdata type conversion";
      end if;
      return UserData_Access.Data;
   end ToUserdata;

   procedure NewMetaTable (L : in Lua_State'Class;
                           Set_Indexable : Boolean := True) is
      tname : C.Strings.chars_ptr
        := C.Strings.New_String("Ada_UserData:" & T'External_Tag);
      Result : C.int;
   begin
      Result := AuxInternal.luaL_newmetatable(L.L, tname);
      C.Strings.Free(tname);
      if Result = 0 then
         raise Program_Error with "Metatable could not be created or already exists";
      elsif Set_Indexable then
         -- Setting the metatables __index field to itself so any unidentified
         -- operations of the form object:operation() will be looked up in the
         -- metatable itself
         L.PushValue(-1);
         L.SetField(-2, "__index");
      end if;
   end NewMetaTable;

   function GetMetaTable (L : in Lua_State'Class) return Boolean is
       tname : C.Strings.chars_ptr
        := C.Strings.New_String("Ada_UserData:" & T'External_Tag);
      Result : C.int;
   begin
      Result := Internal.lua_getfield(L.L, C.int(RegistryIndex), tname);
      C.Strings.Free(tname);
      return Result /= 0;
   end GetMetaTable;

   procedure GetMetaTable (L : in Lua_State'Class) is
      Success : Boolean := GetMetaTable(L);
   begin
      if not Success then
         raise Program_Error with "No metatable exists for this type";
      end if;
   end GetMetaTable;

   procedure AddOperation (L : in Lua_State'Class; Name : in String; Op : AdaFunction) is
      C_name : C.Strings.chars_ptr := C.Strings.New_String(Name);
   begin
      L.PushAdaClosure(Op, 0);
      Internal.lua_setfield(L.L, -2, C_name);
      C.Strings.Free(C_name);
   end AddOperation;

end Lua.Userdata;

-- Lua.Userdata
-- Adding Ada objects to Lua environment

-- Copyright (c) 2015, James Humphry - see LICENSE.md for terms

with System.Address_To_Access_Conversions;

with Interfaces, Interfaces.C, Interfaces.C.Strings;
use Interfaces;

with Lua.Internal, Lua.AuxInternal;

package body Lua.Userdata is

   use type Ada.Tags.Tag;
   use type C.int;
   use type C.size_t;

   --
   -- *** Conversions between C types and Ada types
   --

   package Address_To_Ada_Userdata is
     new System.Address_To_Access_Conversions(Object => Ada_Userdata);

   procedure Push (L : in Lua_State'Class; D : not null access T) is
      UserData_Address : System.Address
        := Internal.lua_newuserdata(L.L, (Ada_Userdata'Size+7)/8);
      UserData_Access : access Ada_Userdata
        := Address_To_Ada_Userdata.To_Pointer(UserData_Address);
      Has_Metatable : Boolean;
   begin
      UserData_Access.all.Tag := T'Tag;
      UserData_Access.all.Data := D;
      Has_Metatable := GetMetaTable(L);
      if Has_Metatable then
         Setmetatable(L, -2);
      end if;
   end Push;

   function ToUserdata (L : in Lua_State'Class; index : in Integer)
      return not null access T
   is
      UserData_Address : System.Address
        := Internal.lua_touserdata(L.L, C.int(index));
      UserData_Access : access Ada_Userdata
        := Address_To_Ada_Userdata.To_Pointer(UserData_Address);
   begin
      if UserData_Access = null then
         raise Program_Error with "Attempting to access non-userdata as userdata";
      elsif UserData_Access.Tag /= T'Tag then
         raise Program_Error with "Attempting invalid userdata type conversion";
      end if;
      return UserData_Access.Data;
   end ToUserdata;

   procedure NewMetaTable (L : in Lua_State'Class;
                           Set_Indexable : Boolean := True) is
      tname : C.Strings.chars_ptr
        := C.Strings.New_String("Ada_UserData:" & T'External_Tag);
      Result : C.int;
   begin
      Result := AuxInternal.luaL_newmetatable(L.L, tname);
      C.Strings.Free(tname);
      if Result = 0 then
         raise Program_Error with "Metatable could not be created or already exists";
      elsif Set_Indexable then
         -- Setting the metatables __index field to itself so any unidentified
         -- operations of the form object:operation() will be looked up in the
         -- metatable itself
         L.PushValue(-1);
         L.SetField(-2, "__index");
      end if;
   end NewMetaTable;

   function GetMetaTable (L : in Lua_State'Class) return Boolean is
       tname : C.Strings.chars_ptr
        := C.Strings.New_String("Ada_UserData:" & T'External_Tag);
      Result : C.int;
   begin
      Result := Internal.lua_getfield(L.L, C.int(RegistryIndex), tname);
      C.Strings.Free(tname);
      return Result /= 0;
   end GetMetaTable;

   procedure GetMetaTable (L : in Lua_State'Class) is
      Success : Boolean := GetMetaTable(L);
   begin
      if not Success then
         raise Program_Error with "No metatable exists for this type";
      end if;
   end GetMetaTable;

   procedure AddOperation (L : in Lua_State'Class; Name : in String; Op : AdaFunction) is
      C_name : C.Strings.chars_ptr := C.Strings.New_String(Name);
   begin
      L.PushAdaClosure(Op, 0);
      Internal.lua_setfield(L.L, -2, C_name);
      C.Strings.Free(C_name);
   end AddOperation;

end Lua.Userdata;

Correct userdata size calculation

Correct userdata size calculation

Per RM-13-3 40 the 'Size attribute is in bits, whereas Lua requires a
byte count for allocating new objects.


-----------------------------------------------------------------------
--  bkp-files -- File and directories
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Calendar;
with Ada.Directories;
with Ada.Containers.Vectors;
with Util.Encoders.SHA1;
with Util.Concurrent.Fifos;
with Util.Strings.Vectors;
with ADO;
with Babel.Base.Models;
package Babel.Files.Queues is

   --  package Babel.Strategies.Flow/Optimize/Small/Larges/Default/Immediate/Simple/Pipeline/Serial
   --  File name
   --  Directory info
   --  File ID or null
   --  File size         => sha1, file status, backup
   package File_Fifo is new Util.Concurrent.Fifos (Element_Type     => File_Type,
                                                   Default_Size     => 100,
                                                   Clear_On_Dequeue => True);
   --
   --     procedure Execute (Backup : in out Small_Files_Strategy;
   --                        Queue  : in out File_Queue) is
   --     begin
   --        loop
   --           Queue.Dequeue (File, 1.0);
   --           --  load file
   --           --  compute sha1
   --           --  if modified then backup file
   --        end loop;
   --
   --     exception
   --        when File_Fifo.Timeout =>
   --           null;
   --     end Execute;

   type File_Queue is tagged limited record
      Queue       : File_Fifo.Fifo;
   end record;

   procedure Add_File (Into : in out File_Queue;
                       File : in File_Type);

   type Directory_Queue is limited private;

   --  Returns true if there is a directory in the queue.
   function Has_Directory (Queue : in Directory_Queue) return Boolean;

   --  Get the next directory from the queue.
   procedure Peek_Directory (Queue     : in out Directory_Queue;
                             Directory : out Directory_Type);

   --  Add the directory in the queue.
   procedure Add_Directory (Queue     : in out Directory_Queue;
                            Directory : in Directory_Type);

private

   type Directory_Queue is limited record
      Directories : Directory_Vector;
   end record;

end Babel.Files.Queues;

-----------------------------------------------------------------------
--  bkp-files -- File and directories
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Calendar;
with Ada.Directories;
with Ada.Containers.Vectors;
with Util.Encoders.SHA1;
with Util.Concurrent.Fifos;
with Util.Strings.Vectors;
with ADO;
with Babel.Base.Models;
package Babel.Files.Queues is

   --  package Babel.Strategies.Flow/Optimize/Small/Larges/Default/Immediate/Simple/Pipeline/Serial
   --  File name
   --  Directory info
   --  File ID or null
   --  File size         => sha1, file status, backup
   package File_Fifo is new Util.Concurrent.Fifos (Element_Type     => File_Type,
                                                   Default_Size     => 100,
                                                   Clear_On_Dequeue => False);
   --
   --     procedure Execute (Backup : in out Small_Files_Strategy;
   --                        Queue  : in out File_Queue) is
   --     begin
   --        loop
   --           Queue.Dequeue (File, 1.0);
   --           --  load file
   --           --  compute sha1
   --           --  if modified then backup file
   --        end loop;
   --
   --     exception
   --        when File_Fifo.Timeout =>
   --           null;
   --     end Execute;

   type File_Queue is tagged limited record
      Queue       : File_Fifo.Fifo;
   end record;
   type File_Queue_Access is access all File_Queue'Class;

   procedure Add_File (Into : in out File_Queue;
                       File : in File_Type);

   type Directory_Queue is limited private;

   --  Returns true if there is a directory in the queue.
   function Has_Directory (Queue : in Directory_Queue) return Boolean;

   --  Get the next directory from the queue.
   procedure Peek_Directory (Queue     : in out Directory_Queue;
                             Directory : out Directory_Type);

   --  Add the directory in the queue.
   procedure Add_Directory (Queue     : in out Directory_Queue;
                            Directory : in Directory_Type);

private

   type Directory_Queue is limited record
      Directories : Directory_Vector;
   end record;

end Babel.Files.Queues;

Declare File_Queue_Access type Do not use the fifo Clear_On_Dequeue because it is not necessary and it is broken