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

with Ada.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;
with AWA.Questions.Modules;
with AWA.Questions.Models;
package AWA.Questions.Beans is

   type Question_Bean is new AWA.Questions.Models.Question_Bean with record
      Service : Modules.Question_Module_Access := null;
   end record;
   type Question_Bean_Access is access all Question_Bean'Class;

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

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

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

   --  Delete the question.
   procedure Delete (Bean : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Questions_Bean bean instance.
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   type Answer_Bean is new AWA.Questions.Models.Answer_Bean with record
      Service  : Modules.Question_Module_Access := null;
      Question : AWA.Questions.Models.Question_Ref;
   end record;
   type Answer_Bean_Access is access all Answer_Bean'Class;

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

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

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

   --  Delete the question.
   procedure Delete (Bean    : in out Answer_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the answer bean instance.
   function Create_Answer_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access;

   --  Create the Question_Info_List_Bean bean instance.
   function Create_Question_List_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   type Question_Display_Bean is new Util.Beans.Basic.Bean with record
      Service          : Modules.Question_Module_Access := null;

      Answer_List      : aliased AWA.Questions.Models.Answer_Info_List_Bean;
      Answer_List_Bean : AWA.Questions.Models.Answer_Info_List_Bean_Access;

      Question         : aliased AWA.Questions.Models.Question_Display_Info;
      Question_Bean    : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Question_Display_Bean_Access is access all Question_Display_Bean'Class;

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

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

   --  Create the Question_Display_Bean bean instance.
   function Create_Question_Display_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                          return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Questions.Beans;

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

with Ada.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;
with AWA.Questions.Modules;
with AWA.Questions.Models;
with AWA.Tags.Beans;
package AWA.Questions.Beans is

   type Question_Bean is new AWA.Questions.Models.Question_Bean with record
      Service : Modules.Question_Module_Access := null;
   end record;
   type Question_Bean_Access is access all Question_Bean'Class;

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

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

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

   --  Delete the question.
   procedure Delete (Bean : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Questions_Bean bean instance.
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   type Answer_Bean is new AWA.Questions.Models.Answer_Bean with record
      Service  : Modules.Question_Module_Access := null;
      Question : AWA.Questions.Models.Question_Ref;
   end record;
   type Answer_Bean_Access is access all Answer_Bean'Class;

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

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

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

   --  Delete the question.
   procedure Delete (Bean    : in out Answer_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the answer bean instance.
   function Create_Answer_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access;

   --  Create the Question_Info_List_Bean bean instance.
   function Create_Question_List_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   type Question_Display_Bean is new Util.Beans.Basic.Bean with record
      Service          : Modules.Question_Module_Access := null;

      --  List of answers associated with the question.
      Answer_List      : aliased AWA.Questions.Models.Answer_Info_List_Bean;
      Answer_List_Bean : AWA.Questions.Models.Answer_Info_List_Bean_Access;

      --  The question.
      Question         : aliased AWA.Questions.Models.Question_Display_Info;
      Question_Bean    : Util.Beans.Basic.Readonly_Bean_Access;

      --  List of tags associated with the question.
      Tags             : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean        : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Question_Display_Bean_Access is access all Question_Display_Bean'Class;

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

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

   --  Create the Question_Display_Bean bean instance.
   function Create_Question_Display_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                          return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Questions.Beans;

Add the list of tags associated with the question


-----------------------------------------------------------------------
--  asf.requests -- ASF Requests
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 AWS.Attachments.Extend;
with AWS.Containers.Tables;
with AWS.Parameters;

with Util.Strings;

with ASF.Parts.Web;
package body ASF.Requests.Web is

   function Get_Parameter (R : Request; Name : String) return String is
   begin
      return AWS.Status.Parameter (R.Data.all, Name);
   end Get_Parameter;

   --  ------------------------------
   --  Iterate over the request parameters and executes the Process procedure.
   --  ------------------------------
   procedure Iterate_Parameters (Req     : in Request;
                                 Process : not null access
                                   procedure (Name  : in String;
                                              Value : in String)) is
      procedure Process_Wrapper (Name, Value : in String);

      procedure Process_Wrapper (Name, Value : in String) is
         Last : Natural := Value'First;
         Pos  : Natural;
      begin
         while Last <= Value'Last loop
            Pos := Util.Strings.Index (Value, ASCII.NUL, Last);
            if Pos > 0 then
               Process (Name, Value (Last .. Pos - 1));
               Last := Pos + 1;
            else
               Process (Name, Value (Last .. Value'Last));
               return;
            end if;
         end loop;
      end Process_Wrapper;

      P : constant AWS.Parameters.List := AWS.Status.Parameters (Req.Data.all);
   begin
      AWS.Containers.Tables.Iterate_Names (AWS.Containers.Tables.Table_Type (P),
                                           "" & ASCII.NUL, Process_Wrapper'Access);
   end Iterate_Parameters;

   --  ------------------------------
   --  Set the AWS data received to initialize the request object.
   --  ------------------------------
   procedure Set_Request (Req  : in out Request;
                          Data : access AWS.Status.Data) is
   begin
      Req.Data    := Data;
      Req.Headers := AWS.Status.Header (Data.all);
   end Set_Request;

   --  ------------------------------
   --  Returns the name of the HTTP method with which this request was made,
   --  for example, GET, POST, or PUT. Same as the value of the CGI variable
   --  REQUEST_METHOD.
   --  ------------------------------
   function Get_Method (Req : in Request) return String is
   begin
      return AWS.Status.Method (Req.Data.all);
   end Get_Method;

   --  ------------------------------
   --  Returns the name and version of the protocol the request uses in the form
   --  protocol/majorVersion.minorVersion, for example, HTTP/1.1. For HTTP servlets,
   --  the value returned is the same as the value of the CGI variable SERVER_PROTOCOL.
   --  ------------------------------
   function Get_Protocol (Req : in Request) return String is
   begin
      return AWS.Status.HTTP_Version (Req.Data.all);
   end Get_Protocol;

   --  ------------------------------
   --  Returns the part of this request's URL from the protocol name up to the query
   --  string in the first line of the HTTP request. The web container does not decode
   --  this String. For example:
   --  First line of HTTP request    Returned Value
   --  POST /some/path.html HTTP/1.1        /some/path.html
   --  GET http://foo.bar/a.html HTTP/1.0       /a.html
   --  HEAD /xyz?a=b HTTP/1.1       /xyz
   --  ------------------------------
   function Get_Request_URI (Req : in Request) return String is
   begin
      return AWS.Status.URI (Req.Data.all);
   end Get_Request_URI;

   --  ------------------------------
   --  Returns the value of the specified request header as a String. If the request
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any request header.
   --  ------------------------------
   function Get_Header (Req  : in Request;
                        Name : in String) return String is
      Values : constant AWS.Headers.VString_Array := AWS.Headers.Get_Values (Req.Headers, Name);
   begin
      if Values'Length > 0 then
         return To_String (Values (Values'First));
      else
         return "";
      end if;
   end Get_Header;

   --  ------------------------------
   --  Iterate over the request headers and executes the Process procedure.
   --  ------------------------------
   procedure Iterate_Headers (Req     : in Request;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is
   begin
      Req.Headers.Iterate_Names (", ",
                                 Process => Process);
   end Iterate_Headers;

   --  ------------------------------
   --  Returns all the values of the specified request header as an Enumeration
   --  of String objects.
   --
   --  Some headers, such as Accept-Language can be sent by clients as several headers
   --  each with a different value rather than sending the header as a comma
   --  separated list.
   --
   --  If the request did not include any headers of the specified name, this method
   --  returns an empty Enumeration. The header name is case insensitive. You can use
   --  this method with any request header.
   --  ------------------------------
   function Get_Headers (Req  : in Request;
                         Name : in String) return String is
   begin
      return AWS.Headers.Get_Values (Req.Headers, Name);
   end Get_Headers;

   --  ------------------------------
   --  Returns the Internet Protocol (IP) address of the client or last proxy that
   --  sent the request. For HTTP servlets, same as the value of the CGI variable
   --  REMOTE_ADDR.
   --  ------------------------------
   function Get_Remote_Addr (Req : in Request) return String is
   begin
      return AWS.Status.Peername (Req.Data.all);
   end Get_Remote_Addr;

   --  ------------------------------
   --  Get the number of parts included in the request.
   --  ------------------------------
   function Get_Part_Count (Req : in Request) return Natural is
   begin
      return AWS.Attachments.Count (AWS.Status.Attachments (Req.Data.all));
   end Get_Part_Count;

   --  ------------------------------
   --  Process the part at the given position and executes the Process operation
   --  with the part object.
   --  ------------------------------
   procedure Process_Part (Req      : in out Request;
                           Position : in Positive;
                           Process  : not null access
                             procedure (Data : in ASF.Parts.Part'Class)) is
      Attachs : constant AWS.Attachments.List := AWS.Status.Attachments (Req.Data.all);
   begin
      ASF.Parts.Web.Process_Part (AWS.Attachments.Get (Attachs, Position), Process);
   end Process_Part;

   --  ------------------------------
   --  Process the part identifed by Id and executes the Process operation
   --  with the part object.
   --  ------------------------------
   procedure Process_Part (Req      : in out Request;
                           Id       : in String;
                           Process  : not null access
                             procedure (Data : in ASF.Parts.Part'Class)) is
      procedure Process_Part (E : in AWS.Attachments.Element);

      procedure Process_Part (E : in AWS.Attachments.Element) is
         Name : constant String := AWS.Attachments.Extend.Get_Name (E);
      begin
         if Id = Name then
            ASF.Parts.Web.Process_Part (E, Process);
         end if;
      end Process_Part;

      Attachs : constant AWS.Attachments.List := AWS.Status.Attachments (Req.Data.all);
   begin
      AWS.Attachments.Iterate (Attachs, Process_Part'Access);
--        ASF.Parts.Web.Process_Part (AWS.Attachments.Get (Attachs, Id), Process);
   end Process_Part;

   --  ------------------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  ------------------------------
   overriding
   procedure Read (Stream : in out Request;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is
   begin
      AWS.Status.Read_Body (D      => Stream.Data.all,
                            Buffer => Into,
                            Last   => Last);
   end Read;

   overriding
   function Create_Input_Stream (Req : in Request) return ASF.Streams.Input_Stream_Access is
      Result : constant ASF.Streams.Input_Stream_Access := new ASF.Streams.Input_Stream;
   begin
      Result.Initialize (Output => null,
                         Input  => Req'Unrestricted_Access,
                         Size   => 8192);
      return Result;
   end Create_Input_Stream;

end ASF.Requests.Web;

-----------------------------------------------------------------------
--  asf.requests -- ASF Requests
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 AWS.Attachments.Extend;
with AWS.Containers.Tables;
with AWS.Parameters;

with Util.Strings;

with ASF.Parts.Web;
package body ASF.Requests.Web is

   function Get_Parameter (R : Request; Name : String) return String is
   begin
      return AWS.Status.Parameter (R.Data.all, Name);
   end Get_Parameter;

   --  ------------------------------
   --  Iterate over the request parameters and executes the Process procedure.
   --  ------------------------------
   procedure Iterate_Parameters (Req     : in Request;
                                 Process : not null access
                                   procedure (Name  : in String;
                                              Value : in String)) is
      procedure Process_Wrapper (Name, Value : in String);

      procedure Process_Wrapper (Name, Value : in String) is
         Last : Natural := Value'First;
         Pos  : Natural;
      begin
         while Last <= Value'Last loop
            Pos := Util.Strings.Index (Value, ASCII.NUL, Last);
            if Pos > 0 then
               Process (Name, Value (Last .. Pos - 1));
               Last := Pos + 1;
            else
               Process (Name, Value (Last .. Value'Last));
               return;
            end if;
         end loop;
      end Process_Wrapper;

      P : constant AWS.Parameters.List := AWS.Status.Parameters (Req.Data.all);
   begin
      AWS.Containers.Tables.Iterate_Names (AWS.Containers.Tables.Table_Type (P),
                                           "" & ASCII.NUL, Process_Wrapper'Access);
   end Iterate_Parameters;

   --  ------------------------------
   --  Set the AWS data received to initialize the request object.
   --  ------------------------------
   procedure Set_Request (Req  : in out Request;
                          Data : access AWS.Status.Data) is
   begin
      Req.Data    := Data;
      Req.Headers := AWS.Status.Header (Data.all);
   end Set_Request;

   --  ------------------------------
   --  Returns the name of the HTTP method with which this request was made,
   --  for example, GET, POST, or PUT. Same as the value of the CGI variable
   --  REQUEST_METHOD.
   --  ------------------------------
   function Get_Method (Req : in Request) return String is
   begin
      return AWS.Status.Method (Req.Data.all);
   end Get_Method;

   --  ------------------------------
   --  Returns the name and version of the protocol the request uses in the form
   --  protocol/majorVersion.minorVersion, for example, HTTP/1.1. For HTTP servlets,
   --  the value returned is the same as the value of the CGI variable SERVER_PROTOCOL.
   --  ------------------------------
   function Get_Protocol (Req : in Request) return String is
   begin
      return AWS.Status.HTTP_Version (Req.Data.all);
   end Get_Protocol;

   --  ------------------------------
   --  Returns the part of this request's URL from the protocol name up to the query
   --  string in the first line of the HTTP request. The web container does not decode
   --  this String. For example:
   --  First line of HTTP request    Returned Value
   --  POST /some/path.html HTTP/1.1        /some/path.html
   --  GET http://foo.bar/a.html HTTP/1.0       /a.html
   --  HEAD /xyz?a=b HTTP/1.1       /xyz
   --  ------------------------------
   function Get_Request_URI (Req : in Request) return String is
   begin
      return AWS.Status.URI (Req.Data.all);
   end Get_Request_URI;

   --  ------------------------------
   --  Returns the value of the specified request header as a String. If the request
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any request header.
   --  ------------------------------
   function Get_Header (Req  : in Request;
                        Name : in String) return String is
      Values : constant AWS.Headers.VString_Array := AWS.Headers.Get_Values (Req.Headers, Name);
   begin
      if Values'Length > 0 then
         return To_String (Values (Values'First));
      else
         return "";
      end if;
   end Get_Header;

   --  ------------------------------
   --  Iterate over the request headers and executes the Process procedure.
   --  ------------------------------
   procedure Iterate_Headers (Req     : in Request;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is
   begin
      Req.Headers.Iterate_Names (", ",
                                 Process => Process);
   end Iterate_Headers;

   --  ------------------------------
   --  Returns all the values of the specified request header as an Enumeration
   --  of String objects.
   --
   --  Some headers, such as Accept-Language can be sent by clients as several headers
   --  each with a different value rather than sending the header as a comma
   --  separated list.
   --
   --  If the request did not include any headers of the specified name, this method
   --  returns an empty Enumeration. The header name is case insensitive. You can use
   --  this method with any request header.
   --  ------------------------------
   function Get_Headers (Req  : in Request;
                         Name : in String) return String is
   begin
      return AWS.Headers.Get_Values (Req.Headers, Name);
   end Get_Headers;

   --  ------------------------------
   --  Returns the Internet Protocol (IP) address of the client or last proxy that
   --  sent the request. For HTTP servlets, same as the value of the CGI variable
   --  REMOTE_ADDR.
   --  ------------------------------
   function Get_Remote_Addr (Req : in Request) return String is
   begin
      return AWS.Status.Peername (Req.Data.all);
   end Get_Remote_Addr;

   --  ------------------------------
   --  Get the number of parts included in the request.
   --  ------------------------------
   function Get_Part_Count (Req : in Request) return Natural is
   begin
      return AWS.Attachments.Count (AWS.Status.Attachments (Req.Data.all));
   end Get_Part_Count;

   --  ------------------------------
   --  Process the part at the given position and executes the Process operation
   --  with the part object.
   --  ------------------------------
   procedure Process_Part (Req      : in out Request;
                           Position : in Positive;
                           Process  : not null access
                             procedure (Data : in ASF.Parts.Part'Class)) is
      Attachs : constant AWS.Attachments.List := AWS.Status.Attachments (Req.Data.all);
   begin
      ASF.Parts.Web.Process_Part (AWS.Attachments.Get (Attachs, Position), Process);
   end Process_Part;

   --  ------------------------------
   --  Process the part identifed by Id and executes the Process operation
   --  with the part object.
   --  ------------------------------
   procedure Process_Part (Req      : in out Request;
                           Id       : in String;
                           Process  : not null access
                             procedure (Data : in ASF.Parts.Part'Class)) is
      procedure Process_Part (E : in AWS.Attachments.Element);

      procedure Process_Part (E : in AWS.Attachments.Element) is
         Name : constant String := AWS.Attachments.Extend.Get_Name (E);
      begin
         if Id = Name then
            ASF.Parts.Web.Process_Part (E, Process);
         end if;
      end Process_Part;

      Attachs : constant AWS.Attachments.List := AWS.Status.Attachments (Req.Data.all);
   begin
      AWS.Attachments.Iterate (Attachs, Process_Part'Access);
--        ASF.Parts.Web.Process_Part (AWS.Attachments.Get (Attachs, Id), Process);
   end Process_Part;

   --  ------------------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  ------------------------------
   overriding
   procedure Read (Stream : in out Request;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is
   begin
      AWS.Status.Read_Body (D      => Stream.Data.all,
                            Buffer => Into,
                            Last   => Last);
   end Read;

   overriding
   function Create_Input_Stream (Req : in Request) return ASF.Streams.Input_Stream_Access is
      Result : constant ASF.Streams.Input_Stream_Access := new ASF.Streams.Input_Stream;
   begin
      Result.Initialize (Input  => Req'Unrestricted_Access,
                         Size   => 8192);
      return Result;
   end Create_Input_Stream;

end ASF.Requests.Web;

Update initialization of the input stream


-----------------------------------------------------------------------
--  ado-queries-loaders -- Loader for Database Queries
--  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 ADO.Drivers.Connections;
package ADO.Queries.Loaders is

   generic
      Path : String;
      Sha1 : String;
   package File is
      Name : aliased constant String := Path;
      Hash : aliased constant String := Sha1;
      File : aliased Query_File;
   end File;

   generic
      Name : String;
      File : Query_File_Access;
   package Query is
      Query_Name : aliased constant String := Name;
      Query      : aliased Query_Definition;
   end Query;

   --  Read the query definition.
   procedure Read_Query (Manager : in out Query_Manager;
                         Into    : in Query_Definition_Access);

   --  Register the query definition in the query file.  Registration is done
   --  in the package elaboration phase.
   procedure Register (File  : in Query_File_Access;
                       Query : in Query_Definition_Access);

   --  Initialize the queries to look in the list of directories specified by Paths.
   --  Each search directory is separated by ';' (yes, even on Unix).
   --  When Load is true, read the XML query file and initialize the query
   --  definitions from that file.
   procedure Initialize (Manager : in out Query_Manager_Access;
                         Config  : in ADO.Drivers.Connections.Configuration'Class);

   --  Find the query identified by the given name.
   function Find_Query (Name : in String) return Query_Definition_Access;

private

   --  Returns True if the XML query file must be reloaded.
   function Is_Modified (File : in out Query_File_Info) return Boolean;

   --  Read the query file and all the associated definitions.
   procedure Read_Query (Manager : in out Query_Manager;
                         File    : in out Query_File_Info);

end ADO.Queries.Loaders;

-----------------------------------------------------------------------
--  ado-queries-loaders -- Loader for Database Queries
--  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 ADO.Drivers.Connections;
package ADO.Queries.Loaders is

   generic
      Path : String;
      Sha1 : String;
   package File is
      Name : aliased constant String := Path;
      Hash : aliased constant String := Sha1;
      File : aliased Query_File;
   end File;

   generic
      Name : String;
      File : Query_File_Access;
   package Query is
      Query_Name : aliased constant String := Name;
      Query      : aliased Query_Definition;
   end Query;

   --  Read the query definition.
   procedure Read_Query (Manager : in Query_Manager;
                         Into    : in Query_Definition_Access);

   --  Register the query definition in the query file.  Registration is done
   --  in the package elaboration phase.
   procedure Register (File  : in Query_File_Access;
                       Query : in Query_Definition_Access);

   --  Initialize the queries to look in the list of directories specified by Paths.
   --  Each search directory is separated by ';' (yes, even on Unix).
   --  When Load is true, read the XML query file and initialize the query
   --  definitions from that file.
   procedure Initialize (Manager : in out Query_Manager;
                         Config  : in ADO.Drivers.Connections.Configuration'Class);

   --  Find the query identified by the given name.
   function Find_Query (Name : in String) return Query_Definition_Access;

private

   --  Returns True if the XML query file must be reloaded.
   function Is_Modified (File : in out Query_File_Info) return Boolean;

   --  Read the query file and all the associated definitions.
   procedure Read_Query (Manager : in Query_Manager;
                         File    : in out Query_File_Info);

end ADO.Queries.Loaders;

Update to use the Query_Manager instead of Query_Manager_Access


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

with AWA.Storages.Models;
package AWA.Storages.Stores is

   --  ------------------------------
   --  Store Service
   --  ------------------------------
   type Store is limited interface;
   type Store_Access is access all Store'Class;

   procedure Save (Storage : in Store;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String) is abstract;

   procedure Load (Storage : in Store;
                   From    : in AWA.Storages.Models.Storage_Ref'Class;
                   Into    : in String) is abstract;

end AWA.Storages.Stores;

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

with AWA.Storages.Models;

--  == Store Service ==
--  The `AWA.Storages.Stores` package defines the interface that a store must implement to
--  be able to save and retrieve a data content.
package AWA.Storages.Stores is

   --  ------------------------------
   --  Store Service
   --  ------------------------------
   type Store is limited interface;
   type Store_Access is access all Store'Class;

   --  Save the file represented by the `Path` variable into a store and associate that
   --  content with the storage reference represented by `Into`.
   procedure Save (Storage : in Store;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String) is abstract;

   procedure Load (Storage : in Store;
                   From    : in AWA.Storages.Models.Storage_Ref'Class;
                   Into    : in String) is abstract;

end AWA.Storages.Stores;

Update the documentation

Update the documentation


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

with Ada.Calendar;
with Ada.Command_Line;
with Ada.Text_IO;
with Natools.Time_IO.RFC_3339;
with Natools.Time_Keys;

procedure Timekey is
   procedure Process (Line : in String);
      --  Guess the type of Line and convert it to or from type.

   procedure Process_Input;
      --  Read lines from current input and process them.

   Input_Processed : Boolean := False;
   Empty : Boolean := True;
   Verbose : Boolean := False;

   procedure Process (Line : in String) is
   begin
      if Verbose then
         Ada.Text_IO.Put (Line);
      end if;

      if Natools.Time_Keys.Is_Valid (Line) then
         if Verbose then
            Ada.Text_IO.Put (" => ");
         end if;

         Ada.Text_IO.Put_Line
           (Natools.Time_IO.RFC_3339.Image
              (Natools.Time_Keys.To_Time (Line), Duration'Aft, False));

      elsif Natools.Time_IO.RFC_3339.Is_Valid (Line) then
         if Verbose then
            Ada.Text_IO.Put (" => ");
         end if;

         Ada.Text_IO.Put_Line
           (Natools.Time_Keys.To_Key (Natools.Time_IO.RFC_3339.Value (Line)));
      end if;
   end Process;

   procedure Process_Input is
   begin
      if Input_Processed then
         return;
      else
         Input_Processed := True;
      end if;

      begin
         loop
            Process (Ada.Text_IO.Get_Line);
         end loop;
      exception
         when Ada.Text_IO.End_Error => null;
      end;
   end Process_Input;
begin
   for I in 1 .. Ada.Command_Line.Argument_Count loop
      declare
         Arg : constant String := Ada.Command_Line.Argument (I);
      begin
         if Arg = "-" then
            Empty := False;
            Process_Input;
         elsif Arg = "-v" then
            Verbose := True;
         else
            Empty := False;
            Process (Arg);
         end if;
      end;
   end loop;

   if Empty then
      declare
         Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
      begin
         if Verbose then
            Ada.Text_IO.Put
              (Natools.Time_IO.RFC_3339.Image (Now, Duration'Aft, False)
               & " => ");
         end if;

         Ada.Text_IO.Put_Line (Natools.Time_Keys.To_Key (Now));
      end;
   end if;
end Timekey;

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

with Ada.Calendar;
with Ada.Command_Line;
with Ada.Text_IO;
with Natools.Time_IO.RFC_3339;
with Natools.Time_Keys;

procedure Timekey is
   procedure Process (Line : in String);
      --  Guess the type of Line and convert it to or from type.

   procedure Process_Input;
      --  Read lines from current input and process them.

   Input_Processed : Boolean := False;
   Empty : Boolean := True;
   Verbose : Boolean := False;
   Subsecond_Digits : Natural := Duration'Aft;

   procedure Process (Line : in String) is
   begin
      if Verbose then
         Ada.Text_IO.Put (Line);
      end if;

      if Natools.Time_Keys.Is_Valid (Line) then
         if Verbose then
            Ada.Text_IO.Put (" => ");
         end if;

         Ada.Text_IO.Put_Line
           (Natools.Time_IO.RFC_3339.Image
              (Natools.Time_Keys.To_Time (Line), Subsecond_Digits, False));

      elsif Natools.Time_IO.RFC_3339.Is_Valid (Line) then
         if Verbose then
            Ada.Text_IO.Put (" => ");
         end if;

         Ada.Text_IO.Put_Line
           (Natools.Time_Keys.To_Key (Natools.Time_IO.RFC_3339.Value (Line)));
      end if;
   end Process;

   procedure Process_Input is
   begin
      if Input_Processed then
         return;
      else
         Input_Processed := True;
      end if;

      begin
         loop
            Process (Ada.Text_IO.Get_Line);
         end loop;
      exception
         when Ada.Text_IO.End_Error => null;
      end;
   end Process_Input;
begin
   for I in 1 .. Ada.Command_Line.Argument_Count loop
      declare
         Arg : constant String := Ada.Command_Line.Argument (I);
      begin
         if Arg = "-" then
            Empty := False;
            Process_Input;
         elsif Arg = "-v" then
            Verbose := True;
         else
            Empty := False;
            Process (Arg);
         end if;
      end;
   end loop;

   if Empty then
      declare
         Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
      begin
         if Verbose then
            Ada.Text_IO.Put
              (Natools.Time_IO.RFC_3339.Image (Now, Subsecond_Digits, False)
               & " => ");
         end if;

         Ada.Text_IO.Put_Line (Natools.Time_Keys.To_Key (Now));
      end;
   end if;
end Timekey;

tools/timekey: refactor the number of displayed subsecond digits


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

with Ada.Calendar;
with Ada.Exceptions;

with Util.Properties.Bundles;
with Util.Beans.Objects.Time;
with Util.Dates.Formats;
with Util.Log.Loggers;

with ASF.Applications.Main;
package body ASF.Converters.Dates is

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

   function Get_Date_Format (Mode   : in Style_Type;
                             Bundle : in ASF.Locales.Bundle) return String;
   function Get_Time_Format (Mode   : in Style_Type;
                             Bundle : in ASF.Locales.Bundle) return String;

   --  ------------------------------
   --  Get the format to print the date.
   --  ------------------------------
   function Get_Date_Format (Mode   : in Style_Type;
                             Bundle : in ASF.Locales.Bundle) return String is
   begin
      case Mode is
         when DEFAULT =>
            return Bundle.Get ("faces.dates.default_date_format", "%x");

         when SHORT =>
            return Bundle.Get ("faces.dates.short_date_format", "%d/%m/%Y");

         when MEDIUM =>
            return Bundle.Get ("faces.dates.medium_date_format", "%b %d, %Y");

         when LONG =>
            return Bundle.Get ("faces.dates.long_date_format", "%B %d, %Y");

         when FULL =>
            return Bundle.Get ("faces.dates.full_date_format", "%A, %B %d, %Y");

      end case;
   end Get_Date_Format;

   --  ------------------------------
   --  Get the format to print the time.
   --  ------------------------------
   function Get_Time_Format (Mode   : in Style_Type;
                             Bundle : in ASF.Locales.Bundle) return String is
   begin
      case Mode is
         when DEFAULT =>
            return Bundle.Get ("faces.dates.default_time_format", "%X");

         when SHORT =>
            return Bundle.Get ("faces.dates.short_time_format", "%H:%M");

         when MEDIUM =>
            return Bundle.Get ("faces.dates.medium_time_format", "%H:%M");

         when LONG =>
            return Bundle.Get ("faces.dates.long_time_format", "%H:%M:%S");

         when FULL =>
            return Bundle.Get ("faces.dates.full_time_format", "%H:%M:%S %Z");

      end case;
   end Get_Time_Format;

   --  ------------------------------
   --  Get the date format pattern that must be used for formatting a date on the given component.
   --  ------------------------------
   function Get_Pattern (Convert   : in Date_Converter;
                         Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                         Bundle    : in ASF.Locales.Bundle;
                         Component : in ASF.Components.Base.UIComponent'Class) return String is
   begin
      case Convert.Format is
         when BOTH =>
            return Get_Date_Format (Convert.Time_Style, Bundle);

         when TIME =>
            return Get_Time_Format (Convert.Time_Style, Bundle);

         when DATE =>
            return Get_Date_Format (Convert.Date_Style, Bundle);

         when CONVERTER_PATTERN =>
            return Ada.Strings.Unbounded.To_String (Convert.Pattern);

         when COMPONENT_FORMAT =>
            return Component.Get_Attribute (Context => Context,
                                            Name    => "format",
                                            Default => "%x");

      end case;
   end Get_Pattern;

   --  ------------------------------
   --  Get the locale that must be used to format the date.
   --  ------------------------------
   function Get_Locale (Convert   : in Date_Converter;
                        Context   : in ASF.Contexts.Faces.Faces_Context'Class)
                        return Util.Locales.Locale is
      use type Util.Locales.Locale;
   begin
      if Convert.Locale /= Util.Locales.NULL_LOCALE then
         return Convert.Locale;
      else
         return Context.Get_Locale;
      end if;
   end Get_Locale;

   --  ------------------------------
   --  Convert the object value into a string.  The object value is associated
   --  with the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_String (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in Util.Beans.Objects.Object) return String is
      Locale  : constant Util.Locales.Locale
        := Date_Converter'Class (Convert).Get_Locale (Context);
      Bundle  : ASF.Locales.Bundle;
   begin
      begin
         ASF.Applications.Main.Load_Bundle (Context.Get_Application.all,
                                            Name   => "asf",
                                            Locale => Util.Locales.To_String (Locale),
                                            Bundle => Bundle);

      exception
         when E : Util.Properties.Bundles.NO_BUNDLE =>
            Log.Error ("Cannot localize dates: {0}", Ada.Exceptions.Exception_Message (E));
      end;

      --  Convert the value as a date here so that we can raise an Invalid_Conversion exception.
      declare
         Pattern : constant String
           := Date_Converter'Class (Convert).Get_Pattern (Context, Bundle, Component);
         Date    : constant Ada.Calendar.Time := Util.Beans.Objects.Time.To_Time (Value);
         Result  : constant String := Util.Dates.Formats.Format (Pattern, Date, Bundle);
      begin
         return Result;
      end;
   exception
      when E : others =>
         raise Invalid_Conversion with Ada.Exceptions.Exception_Message (E);
   end To_String;

   --  ------------------------------
   --  Convert the date string into an object for the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_Object (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Convert, Context, Component, Value);
   begin
      Log.Error ("String to date conversion is not yet implemented");
      return Util.Beans.Objects.Null_Object;
   end To_Object;

   --  ------------------------------
   --  Create a date converter.
   --  ------------------------------
   function Create_Date_Converter (Date    : in Style_Type;
                                   Time    : in Style_Type;
                                   Format  : in Format_Type;
                                   Locale  : in String;
                                   Pattern : in String) return Date_Converter_Access is
      use Ada.Strings.Unbounded;

      L : constant Util.Locales.Locale := Util.Locales.Get_Locale (Locale);
   begin
      if Pattern'Length > 0 then
         return new Date_Converter '(Date_Style => Date,
                                     Time_Style => Time,
                                     Locale     => L,
                                     Format     => CONVERTER_PATTERN,
                                     Pattern    => To_Unbounded_String (Pattern));
      else
         return new Date_Converter '(Date_Style => Date,
                                     Time_Style => Time,
                                     Format     => Format,
                                     Locale     => L,
                                     Pattern    => Null_Unbounded_String);
      end if;
   end Create_Date_Converter;

end ASF.Converters.Dates;

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

with Ada.Calendar;
with Ada.Exceptions;

with Util.Properties.Bundles;
with Util.Beans.Objects.Time;
with Util.Dates.Formats;
with Util.Log.Loggers;

with ASF.Applications.Main;
package body ASF.Converters.Dates is

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

   function Get_Date_Format (Mode   : in Style_Type;
                             Bundle : in ASF.Locales.Bundle) return String;
   function Get_Time_Format (Mode   : in Style_Type;
                             Bundle : in ASF.Locales.Bundle) return String;

   --  ------------------------------
   --  Get the format to print the date.
   --  ------------------------------
   function Get_Date_Format (Mode   : in Style_Type;
                             Bundle : in ASF.Locales.Bundle) return String is
   begin
      case Mode is
         when DEFAULT =>
            return Bundle.Get ("faces.dates.default_date_format", "%x");

         when SHORT =>
            return Bundle.Get ("faces.dates.short_date_format", "%d/%m/%Y");

         when MEDIUM =>
            return Bundle.Get ("faces.dates.medium_date_format", "%b %d, %Y");

         when LONG =>
            return Bundle.Get ("faces.dates.long_date_format", "%B %d, %Y");

         when FULL =>
            return Bundle.Get ("faces.dates.full_date_format", "%A, %B %d, %Y");

      end case;
   end Get_Date_Format;

   --  ------------------------------
   --  Get the format to print the time.
   --  ------------------------------
   function Get_Time_Format (Mode   : in Style_Type;
                             Bundle : in ASF.Locales.Bundle) return String is
   begin
      case Mode is
         when DEFAULT =>
            return Bundle.Get ("faces.dates.default_time_format", "%X");

         when SHORT =>
            return Bundle.Get ("faces.dates.short_time_format", "%H:%M");

         when MEDIUM =>
            return Bundle.Get ("faces.dates.medium_time_format", "%H:%M");

         when LONG =>
            return Bundle.Get ("faces.dates.long_time_format", "%H:%M:%S");

         when FULL =>
            return Bundle.Get ("faces.dates.full_time_format", "%H:%M:%S %Z");

      end case;
   end Get_Time_Format;

   --  ------------------------------
   --  Get the date format pattern that must be used for formatting a date on the given component.
   --  ------------------------------
   function Get_Pattern (Convert   : in Date_Converter;
                         Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                         Bundle    : in ASF.Locales.Bundle;
                         Component : in ASF.Components.Base.UIComponent'Class) return String is
   begin
      case Convert.Format is
         when BOTH =>
            return Get_Date_Format (Convert.Time_Style, Bundle);

         when TIME =>
            return Get_Time_Format (Convert.Time_Style, Bundle);

         when DATE =>
            return Get_Date_Format (Convert.Date_Style, Bundle);

         when CONVERTER_PATTERN =>
            return Ada.Strings.Unbounded.To_String (Convert.Pattern);

         when COMPONENT_FORMAT =>
            return Component.Get_Attribute (Context => Context,
                                            Name    => "format",
                                            Default => "%x");

      end case;
   end Get_Pattern;

   --  ------------------------------
   --  Get the locale that must be used to format the date.
   --  ------------------------------
   function Get_Locale (Convert   : in Date_Converter;
                        Context   : in ASF.Contexts.Faces.Faces_Context'Class)
                        return Util.Locales.Locale is
      use type Util.Locales.Locale;
   begin
      if Convert.Locale /= Util.Locales.NULL_LOCALE then
         return Convert.Locale;
      else
         return Context.Get_Locale;
      end if;
   end Get_Locale;

   --  ------------------------------
   --  Convert the object value into a string.  The object value is associated
   --  with the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_String (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in Util.Beans.Objects.Object) return String is
      Locale  : constant Util.Locales.Locale
        := Date_Converter'Class (Convert).Get_Locale (Context);
      Bundle  : ASF.Locales.Bundle;
   begin
      begin
         ASF.Applications.Main.Load_Bundle (Context.Get_Application.all,
                                            Name   => "asf",
                                            Locale => Util.Locales.To_String (Locale),
                                            Bundle => Bundle);

      exception
         when E : Util.Properties.Bundles.NO_BUNDLE =>
            Log.Error ("Cannot localize dates: {0}", Ada.Exceptions.Exception_Message (E));
      end;

      --  Convert the value as a date here so that we can raise an Invalid_Conversion exception.
      declare
         Pattern : constant String
           := Date_Converter'Class (Convert).Get_Pattern (Context, Bundle, Component);
         Date    : constant Ada.Calendar.Time := Util.Beans.Objects.Time.To_Time (Value);
         Result  : constant String := Util.Dates.Formats.Format (Pattern, Date, Bundle);
      begin
         return Result;
      end;
   exception
      when E : others =>
         raise Invalid_Conversion with Ada.Exceptions.Exception_Message (E);
   end To_String;

   --  ------------------------------
   --  Convert the date string into an object for the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_Object (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in String) return Util.Beans.Objects.Object is
      Locale  : constant Util.Locales.Locale
        := Date_Converter'Class (Convert).Get_Locale (Context);
      Bundle  : ASF.Locales.Bundle;
   begin
      begin
         ASF.Applications.Main.Load_Bundle (Context.Get_Application.all,
                                            Name   => "asf",
                                            Locale => Util.Locales.To_String (Locale),
                                            Bundle => Bundle);

      exception
         when E : Util.Properties.Bundles.NO_BUNDLE =>
            Log.Error ("Cannot localize dates: {0}", Ada.Exceptions.Exception_Message (E));
      end;

      --  Convert the string to a date here so that we can raise an Invalid_Conversion exception.
      declare
         Pattern : constant String
           := Date_Converter'Class (Convert).Get_Pattern (Context, Bundle, Component);
         Date    : Util.Dates.Date_Record;
      begin
         Log.Debug ("Date conversion '{0}' with pattern '{1}'", Value, Pattern);
         Date := Util.Dates.Formats.Parse (Pattern => Pattern, Date => Value, Bundle => Bundle);
         return Util.Beans.Objects.Time.To_Object (Date.Date);

      exception
         when E : others =>
            Log.Error ("Date '{0}' does not match pattern '{1}'", Value, Pattern);
            raise Invalid_Conversion with Ada.Exceptions.Exception_Message (E);

      end;
   end To_Object;

   --  ------------------------------
   --  Create a date converter.
   --  ------------------------------
   function Create_Date_Converter (Date    : in Style_Type;
                                   Time    : in Style_Type;
                                   Format  : in Format_Type;
                                   Locale  : in String;
                                   Pattern : in String) return Date_Converter_Access is
      use Ada.Strings.Unbounded;

      L : constant Util.Locales.Locale := Util.Locales.Get_Locale (Locale);
   begin
      if Pattern'Length > 0 then
         return new Date_Converter '(Date_Style => Date,
                                     Time_Style => Time,
                                     Locale     => L,
                                     Format     => CONVERTER_PATTERN,
                                     Pattern    => To_Unbounded_String (Pattern));
      else
         return new Date_Converter '(Date_Style => Date,
                                     Time_Style => Time,
                                     Format     => Format,
                                     Locale     => L,
                                     Pattern    => Null_Unbounded_String);
      end if;
   end Create_Date_Converter;

end ASF.Converters.Dates;

Fix the To_Object function to implement the conversion and parsing of a string into a date


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

with Ada.Strings.Unbounded;

with Util.Log.Loggers;

with ASF.Cookies;
with ASF.Applications.Main;

with Security.Contexts;
with Security.Policies.URLs;
package body ASF.Security.Filters is

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

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out Auth_Filter;
                         Context : in ASF.Servlets.Servlet_Registry'Class) is
      use ASF.Applications.Main;
   begin
      if Context in Application'Class then
         Server.Set_Permission_Manager (Application'Class (Context).Get_Security_Manager);
      end if;
   end Initialize;

   --  ------------------------------
   --  Set the permission manager that must be used to verify the permission.
   --  ------------------------------
   procedure Set_Permission_Manager (Filter  : in out Auth_Filter;
                                     Manager : in Policies.Policy_Manager_Access) is
   begin
      Filter.Manager := Manager;
   end Set_Permission_Manager;

   --  ------------------------------
   --  Filter the request to make sure the user is authenticated.
   --  Invokes the Do_Login procedure if there is no user.
   --  If a permission manager is defined, check that the user has the permission
   --  to view the page.  Invokes the Do_Deny procedure if the permission
   --  is denied.
   --  ------------------------------
   procedure Do_Filter (F        : in Auth_Filter;
                        Request  : in out ASF.Requests.Request'Class;
                        Response : in out ASF.Responses.Response'Class;
                        Chain    : in out ASF.Servlets.Filter_Chain) is
      use Ada.Strings.Unbounded;
      use Policies.URLs;
      use type Policies.Policy_Manager_Access;

      Session : ASF.Sessions.Session;
      SID     : Unbounded_String;
      AID     : Unbounded_String;
      Auth    : ASF.Principals.Principal_Access;

      pragma Unreferenced (SID);

      procedure Fetch_Cookie (Cookie : in ASF.Cookies.Cookie);

      --  ------------------------------
      --  Collect the AID and SID cookies.
      --  ------------------------------
      procedure Fetch_Cookie (Cookie : in ASF.Cookies.Cookie) is
         Name : constant String := ASF.Cookies.Get_Name (Cookie);
      begin
         if Name = SID_COOKIE then
            SID := To_Unbounded_String (ASF.Cookies.Get_Value (Cookie));
         elsif Name = AID_COOKIE then
            AID := To_Unbounded_String (ASF.Cookies.Get_Value (Cookie));
         end if;
      end Fetch_Cookie;

      Context : aliased Contexts.Security_Context;
   begin
      Request.Iterate_Cookies (Fetch_Cookie'Access);
      Session := Request.Get_Session (Create => True);

      --  If the session does not have a principal, try to authenticate the user with
      --  the auto-login cookie.
      Auth := Session.Get_Principal;
      if Auth = null and then Length (AID) > 0 then
         Auth_Filter'Class (F).Authenticate (Request, Response, Session, To_String (AID), Auth);
         if Auth /= null then
            Session.Set_Principal (Auth);
         end if;
      end if;

      --  A permission manager is installed, check that the user can display the page.
      if F.Manager /= null then
         if Auth = null then
            Context.Set_Context (F.Manager, null);
         else
            Context.Set_Context (F.Manager, Auth.all'Access);
         end if;
         declare
            URL  : constant String := Request.Get_Path_Info;
            Perm : constant Policies.URLs.URL_Permission (URL'Length)
              := URL_Permission '(Len => URL'Length, URL => URL);
         begin
            if not F.Manager.Has_Permission (Context, Perm) then
               if Auth = null then
                  --  No permission and no principal, redirect to the login page.
                  Log.Info ("Page need authentication on {0}", URL);
                  Auth_Filter'Class (F).Do_Login (Request, Response);
               else
                  Log.Info ("Deny access on {0}", URL);
                  Auth_Filter'Class (F).Do_Deny (Request, Response);
               end if;
               return;
            end if;
            Log.Debug ("Access granted on {0}", URL);
         end;
      end if;

      --  Request is authorized, proceed to the next filter.
      ASF.Servlets.Do_Filter (Chain    => Chain,
                              Request  => Request,
                              Response => Response);
   end Do_Filter;

   --  ------------------------------
   --  Display or redirects the user to the login page.  This procedure is called when
   --  the user is not authenticated.
   --  ------------------------------
   procedure Do_Login (F        : in Auth_Filter;
                       Request  : in out ASF.Requests.Request'Class;
                       Response : in out ASF.Responses.Response'Class) is
      pragma Unreferenced (F, Request);
   begin
      Response.Send_Error (ASF.Responses.SC_UNAUTHORIZED);
   end Do_Login;

   --  ------------------------------
   --  Display the forbidden access page.  This procedure is called when the user is not
   --  authorized to see the page.  The default implementation returns the SC_FORBIDDEN error.
   --  ------------------------------
   procedure Do_Deny (F        : in Auth_Filter;
                      Request  : in out ASF.Requests.Request'Class;
                      Response : in out ASF.Responses.Response'Class) is
      pragma Unreferenced (F, Request);
   begin
      Response.Set_Status (ASF.Responses.SC_FORBIDDEN);
   end Do_Deny;

   --  ------------------------------
   --  Authenticate a user by using the auto-login cookie.  This procedure is called if the
   --  current session does not have any principal.  Based on the request and the optional
   --  auto-login cookie passed in Auth_Id, it should identify the user and return
   --  a principal object.  The principal object will be freed when the session is closed.
   --  If the user cannot be authenticated, the returned principal should be null.
   --
   --  The default implementation returns a null principal.
   --  ------------------------------
   procedure Authenticate (F        : in Auth_Filter;
                           Request  : in out ASF.Requests.Request'Class;
                           Response : in out ASF.Responses.Response'Class;
                           Session  : in ASF.Sessions.Session;
                           Auth_Id  : in String;
                           Principal : out ASF.Principals.Principal_Access) is
      pragma Unreferenced (F, Request, Response, Session, Auth_Id);
   begin
      Principal := null;
   end Authenticate;

end ASF.Security.Filters;

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

with Ada.Strings.Unbounded;

with Util.Log.Loggers;

with ASF.Cookies;
with ASF.Applications.Main;

with Security.Contexts;
with Security.Policies.URLs;
package body ASF.Security.Filters is

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

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out Auth_Filter;
                         Context : in ASF.Servlets.Servlet_Registry'Class) is
      use ASF.Applications.Main;
   begin
      if Context in Application'Class then
         Server.Set_Permission_Manager (Application'Class (Context).Get_Security_Manager);
      end if;
   end Initialize;

   --  ------------------------------
   --  Set the permission manager that must be used to verify the permission.
   --  ------------------------------
   procedure Set_Permission_Manager (Filter  : in out Auth_Filter;
                                     Manager : in Policies.Policy_Manager_Access) is
   begin
      Filter.Manager := Manager;
   end Set_Permission_Manager;

   --  ------------------------------
   --  Filter the request to make sure the user is authenticated.
   --  Invokes the Do_Login procedure if there is no user.
   --  If a permission manager is defined, check that the user has the permission
   --  to view the page.  Invokes the Do_Deny procedure if the permission
   --  is denied.
   --  ------------------------------
   procedure Do_Filter (F        : in Auth_Filter;
                        Request  : in out ASF.Requests.Request'Class;
                        Response : in out ASF.Responses.Response'Class;
                        Chain    : in out ASF.Servlets.Filter_Chain) is
      use Ada.Strings.Unbounded;
      use Policies.URLs;
      use type Policies.Policy_Manager_Access;

      Session : ASF.Sessions.Session;
      SID     : Unbounded_String;
      AID     : Unbounded_String;
      Auth    : ASF.Principals.Principal_Access;

      pragma Unreferenced (SID);

      procedure Fetch_Cookie (Cookie : in ASF.Cookies.Cookie);

      --  ------------------------------
      --  Collect the AID and SID cookies.
      --  ------------------------------
      procedure Fetch_Cookie (Cookie : in ASF.Cookies.Cookie) is
         Name : constant String := ASF.Cookies.Get_Name (Cookie);
      begin
         if Name = SID_COOKIE then
            SID := To_Unbounded_String (ASF.Cookies.Get_Value (Cookie));
         elsif Name = AID_COOKIE then
            AID := To_Unbounded_String (ASF.Cookies.Get_Value (Cookie));
         end if;
      end Fetch_Cookie;

      Context : aliased Contexts.Security_Context;
   begin
      Request.Iterate_Cookies (Fetch_Cookie'Access);
      Session := Request.Get_Session (Create => True);

      --  If the session does not have a principal, try to authenticate the user with
      --  the auto-login cookie.
      Auth := Session.Get_Principal;
      if Auth = null and then Length (AID) > 0 then
         Auth_Filter'Class (F).Authenticate (Request, Response, Session, To_String (AID), Auth);
         if Auth /= null then
            Session.Set_Principal (Auth);
         end if;
      end if;

      --  A permission manager is installed, check that the user can display the page.
      if F.Manager /= null then
         if Auth = null then
            Context.Set_Context (F.Manager, null);
         else
            Context.Set_Context (F.Manager, Auth.all'Access);
         end if;
         declare
            Servlet : constant String := Request.Get_Servlet_Path;
            URL     : constant String := Servlet & Request.Get_Path_Info;
            Perm    : constant Policies.URLs.URL_Permission (URL'Length)
              := URL_Permission '(Len => URL'Length, URL => URL);
         begin
            if not F.Manager.Has_Permission (Context, Perm) then
               if Auth = null then
                  --  No permission and no principal, redirect to the login page.
                  Log.Info ("Page need authentication on {0}", URL);
                  Auth_Filter'Class (F).Do_Login (Request, Response);
               else
                  Log.Info ("Deny access on {0}", URL);
                  Auth_Filter'Class (F).Do_Deny (Request, Response);
               end if;
               return;
            end if;
            Log.Debug ("Access granted on {0}", URL);
         end;
      end if;

      --  Request is authorized, proceed to the next filter.
      ASF.Servlets.Do_Filter (Chain    => Chain,
                              Request  => Request,
                              Response => Response);
   end Do_Filter;

   --  ------------------------------
   --  Display or redirects the user to the login page.  This procedure is called when
   --  the user is not authenticated.
   --  ------------------------------
   procedure Do_Login (F        : in Auth_Filter;
                       Request  : in out ASF.Requests.Request'Class;
                       Response : in out ASF.Responses.Response'Class) is
      pragma Unreferenced (F, Request);
   begin
      Response.Send_Error (ASF.Responses.SC_UNAUTHORIZED);
   end Do_Login;

   --  ------------------------------
   --  Display the forbidden access page.  This procedure is called when the user is not
   --  authorized to see the page.  The default implementation returns the SC_FORBIDDEN error.
   --  ------------------------------
   procedure Do_Deny (F        : in Auth_Filter;
                      Request  : in out ASF.Requests.Request'Class;
                      Response : in out ASF.Responses.Response'Class) is
      pragma Unreferenced (F, Request);
   begin
      Response.Set_Status (ASF.Responses.SC_FORBIDDEN);
   end Do_Deny;

   --  ------------------------------
   --  Authenticate a user by using the auto-login cookie.  This procedure is called if the
   --  current session does not have any principal.  Based on the request and the optional
   --  auto-login cookie passed in Auth_Id, it should identify the user and return
   --  a principal object.  The principal object will be freed when the session is closed.
   --  If the user cannot be authenticated, the returned principal should be null.
   --
   --  The default implementation returns a null principal.
   --  ------------------------------
   procedure Authenticate (F        : in Auth_Filter;
                           Request  : in out ASF.Requests.Request'Class;
                           Response : in out ASF.Responses.Response'Class;
                           Session  : in ASF.Sessions.Session;
                           Auth_Id  : in String;
                           Principal : out ASF.Principals.Principal_Access) is
      pragma Unreferenced (F, Request, Response, Session, Auth_Id);
   begin
      Principal := null;
   end Authenticate;

end ASF.Security.Filters;

Add the servlet path in the URL to check the permission


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

--  The Util.Streams.Sockets package defines a socket stream.
package Util.Streams.Sockets is

   --  -----------------------
   --  Socket stream
   --  -----------------------
   --  The Socket_Stream is an output/input stream that reads or writes
   --  to or from a socket.
   type Socket_Stream is limited new Output_Stream and Input_Stream with private;

   --  Initialize the socket stream.
   procedure Open (Stream  : in out Socket_Stream;
                   Socket  : in GNAT.Sockets.Socket_Type);

   --  Initialize the socket stream by opening a connection to the server defined in Server.
   procedure Connect (Stream : in out Socket_Stream;
                      Server : in GNAT.Sockets.Sock_Addr_Type);

   --  Close the socket stream.
   overriding
   procedure Close (Stream : in out Socket_Stream);

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Socket_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   overriding
   procedure Read (Stream : in out Socket_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset);

private

   use Ada.Streams;

   type Socket_Stream is new Ada.Finalization.Limited_Controlled
     and Output_Stream and Input_Stream with record
      Sock : GNAT.Sockets.Socket_Type := GNAT.Sockets.No_Socket;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Socket_Stream);

end Util.Streams.Sockets;

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

--  The Util.Streams.Sockets package defines a socket stream.
package Util.Streams.Sockets is

   --  -----------------------
   --  Socket stream
   --  -----------------------
   --  The Socket_Stream is an output/input stream that reads or writes
   --  to or from a socket.
   type Socket_Stream is limited new Output_Stream and Input_Stream with private;

   --  Initialize the socket stream.
   procedure Open (Stream  : in out Socket_Stream;
                   Socket  : in GNAT.Sockets.Socket_Type);

   --  Initialize the socket stream by opening a connection to the server defined in Server.
   procedure Connect (Stream : in out Socket_Stream;
                      Server : in GNAT.Sockets.Sock_Addr_Type);

   --  Close the socket stream.
   overriding
   procedure Close (Stream : in out Socket_Stream);

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Socket_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   overriding
   procedure Read (Stream : in out Socket_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset);

private

   use Ada.Streams;

   type Socket_Stream is limited new Ada.Finalization.Limited_Controlled
     and Output_Stream and Input_Stream with record
      Sock : GNAT.Sockets.Socket_Type := GNAT.Sockets.No_Socket;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Socket_Stream);

end Util.Streams.Sockets;

Fix compilation error with GNAT 2015

Fix compilation error with GNAT 2015


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

   overriding
   procedure Bind (Mapper : in out Default_Variable_Mapper;
                   Name   : in String;
                   Value  : in EL.Objects.Object) is
      Expr : constant EL.Expressions.Value_Expression
        := EL.Expressions.Create_ValueExpression (Value);
   begin
      Mapper.Map.Include (Key      => To_Unbounded_String (Name),
                          New_Item => EL.Expressions.Expression (Expr));
   end Bind;

   overriding
   function Get_Variable (Mapper : Default_Variable_Mapper;
                          Name   : Unbounded_String)
                          return EL.Expressions.Expression is
      C : constant Variable_Maps.Cursor := Mapper.Map.Find (Name);
   begin
      if not Variable_Maps.Has_Element (C) then
         if Mapper.Next_Mapper /= null then
            return Mapper.Next_Mapper.Get_Variable (Name);
         end if;
         --  Avoid raising an exception if we can't resolve a variable.
         --  Instead, return a null expression.  This speeds up the resolution and
         --  creation of Ada bean in ASF framework (cost of exception is high compared to this).
         return E : EL.Expressions.Expression;
      end if;
      return Variable_Maps.Element (C);
   end Get_Variable;

   overriding
   procedure Set_Variable (Mapper : in out Default_Variable_Mapper;
                           Name   : in Unbounded_String;
                           Value  : in EL.Expressions.Expression) is
   begin
      Mapper.Map.Include (Key      => Name,
                          New_Item => Value);
   end Set_Variable;

   --  ------------------------------
   --  Set the next variable mapper that will be used to resolve a variable if
   --  the current variable mapper does not find a variable.
   --  ------------------------------
   procedure Set_Next_Variable_Mapper (Mapper      : in out Default_Variable_Mapper;
                                       Next_Mapper : in Variable_Mapper_Access) is
   begin
      Mapper.Next_Mapper := Next_Mapper;
   end Set_Next_Variable_Mapper;

end EL.Variables.Default;

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

   overriding
   procedure Bind (Mapper : in out Default_Variable_Mapper;
                   Name   : in String;
                   Value  : in EL.Objects.Object) is
      Expr : constant EL.Expressions.Value_Expression
        := EL.Expressions.Create_ValueExpression (Value);
   begin
      Mapper.Map.Include (Key      => To_Unbounded_String (Name),
                          New_Item => EL.Expressions.Expression (Expr));
   end Bind;

   overriding
   function Get_Variable (Mapper : Default_Variable_Mapper;
                          Name   : Unbounded_String)
                          return EL.Expressions.Expression is
      C : constant Variable_Maps.Cursor := Mapper.Map.Find (Name);
   begin
      if not Variable_Maps.Has_Element (C) then
         if Mapper.Next_Mapper /= null then
            return Mapper.Next_Mapper.all.Get_Variable (Name);
         end if;
         --  Avoid raising an exception if we can't resolve a variable.
         --  Instead, return a null expression.  This speeds up the resolution and
         --  creation of Ada bean in ASF framework (cost of exception is high compared to this).
         return E : EL.Expressions.Expression;
      end if;
      return Variable_Maps.Element (C);
   end Get_Variable;

   overriding
   procedure Set_Variable (Mapper : in out Default_Variable_Mapper;
                           Name   : in Unbounded_String;
                           Value  : in EL.Expressions.Expression) is
   begin
      Mapper.Map.Include (Key      => Name,
                          New_Item => Value);
   end Set_Variable;

   --  ------------------------------
   --  Set the next variable mapper that will be used to resolve a variable if
   --  the current variable mapper does not find a variable.
   --  ------------------------------
   procedure Set_Next_Variable_Mapper (Mapper      : in out Default_Variable_Mapper;
                                       Next_Mapper : in Variable_Mapper_Access) is
   begin
      Mapper.Next_Mapper := Next_Mapper;
   end Set_Next_Variable_Mapper;

end EL.Variables.Default;

Fix Issue 1:build failed with gcc 4.7

Fix Issue 1:build failed with gcc 4.7


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

with Ada.Text_IO;
with AUnit.Reporter.Text;
with AUnit.Run;
with Util.Testsuite;
with Util.Measures;

procedure Util_Harness is
   procedure Runner is new AUnit.Run.Test_Runner (Util.Testsuite.Suite);
   Reporter : AUnit.Reporter.Text.Text_Reporter;

   Perf : aliased Util.Measures.Measure_Set;
begin
   Util.Measures.Set_Current (Perf'Unchecked_Access);
   Runner (Reporter);
   Util.Measures.Write (Perf, "Util measures", Ada.Text_IO.Standard_Output);
end Util_Harness;

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

with Ada.Command_Line;
with Ada.Text_IO;
with AUnit;
with AUnit.Reporter.Text;
with AUnit.Run;
with Util.Testsuite;
with Util.Measures;

procedure Util_Harness is
   use type AUnit.Status;

   function Runner is new AUnit.Run.Test_Runner_With_Status (Util.Testsuite.Suite);

   Reporter : AUnit.Reporter.Text.Text_Reporter;
   Perf     : aliased Util.Measures.Measure_Set;
   Result   : AUnit.Status;
begin
   Util.Measures.Set_Current (Perf'Unchecked_Access);
   Result := Runner (Reporter, True);
   Util.Measures.Write (Perf, "Util measures", Ada.Text_IO.Standard_Output);

   --  Program exit status reflects the testsuite result
   if Result /= AUnit.Success then
      Ada.Command_Line.Set_Exit_Status (1);
   else
      Ada.Command_Line.Set_Exit_Status (0);
   end if;
end Util_Harness;

Fix exit status of unit test tool

Fix exit status of unit test tool