-----------------------------------------------------------------------
--  ADO Sequences Hilo-- HiLo Database sequence generator
--  Copyright (C) 2009, 2010, 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.
-----------------------------------------------------------------------

--  === HiLo Sequence Generator ===
--  The HiLo sequence generator.  This sequence generator uses a database table
--  sequence to allocate blocks of identifiers for a given sequence name.
--  The sequence table contains one row for each sequence.  It keeps track of
--  the next available sequence identifier (in the value column).
--
--  To allocate a sequence block, the HiLo generator obtains the next available
--  sequence identified and updates it by adding the sequence block size.  The
--  HiLo sequence generator will allocate the identifiers until the block is
--  full after which a new block will be allocated.

package ADO.Sequences.Hilo is

   --  ------------------------------
   --  High Low sequence generator
   --  ------------------------------
   type HiLoGenerator is new Generator with private;

   DEFAULT_BLOCK_SIZE : constant Identifier := 100;

   --  Allocate an identifier using the generator.
   --  The generator allocates blocks of sequences by using a sequence
   --  table stored in the database.  One database access is necessary
   --  every N allocations.
   overriding
   procedure Allocate (Gen : in out HiLoGenerator;
                       Id  : in out Objects.Object_Record'Class);

   --  Allocate a new sequence block.
   procedure Allocate_Sequence (Gen : in out HiLoGenerator);

   function Create_HiLo_Generator
     (Sess_Factory : in Session_Factory_Access)
      return Generator_Access;

private

   type HiLoGenerator is new Generator with record
      Last_Id    : Identifier := NO_IDENTIFIER;
      Next_Id    : Identifier := NO_IDENTIFIER;
      Block_Size : Identifier := DEFAULT_BLOCK_SIZE;
   end record;

end ADO.Sequences.Hilo;

-----------------------------------------------------------------------
--  ADO Sequences Hilo-- HiLo Database sequence generator
--  Copyright (C) 2009, 2010, 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.
-----------------------------------------------------------------------

--  === HiLo Sequence Generator ===
--  The HiLo sequence generator.  This sequence generator uses a database table
--  `sequence` to allocate blocks of identifiers for a given sequence name.
--  The sequence table contains one row for each sequence.  It keeps track of
--  the next available sequence identifier (in the `value column).
--
--  To allocate a sequence block, the HiLo generator obtains the next available
--  sequence identified and updates it by adding the sequence block size.  The
--  HiLo sequence generator will allocate the identifiers until the block is
--  full after which a new block will be allocated.
package ADO.Sequences.Hilo is

   --  ------------------------------
   --  High Low sequence generator
   --  ------------------------------
   type HiLoGenerator is new Generator with private;

   DEFAULT_BLOCK_SIZE : constant Identifier := 100;

   --  Allocate an identifier using the generator.
   --  The generator allocates blocks of sequences by using a sequence
   --  table stored in the database.  One database access is necessary
   --  every N allocations.
   overriding
   procedure Allocate (Gen : in out HiLoGenerator;
                       Id  : in out Objects.Object_Record'Class);

   --  Allocate a new sequence block.
   procedure Allocate_Sequence (Gen : in out HiLoGenerator);

   function Create_HiLo_Generator
     (Sess_Factory : in Session_Factory_Access)
      return Generator_Access;

private

   type HiLoGenerator is new Generator with record
      Last_Id    : Identifier := NO_IDENTIFIER;
      Next_Id    : Identifier := NO_IDENTIFIER;
      Block_Size : Identifier := DEFAULT_BLOCK_SIZE;
   end record;

end ADO.Sequences.Hilo;

Add some documentation

Add some documentation


-----------------------------------------------------------------------
--  asf-models-selects -- Data model for UISelectOne and UISelectMany
--  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.Characters.Conversions;
package body ASF.Models.Selects is

   --  ------------------------------
   --  Return an Object from the select item record.
   --  Returns a NULL object if the item is empty.
   --  ------------------------------
   function To_Object (Item : in Select_Item) return Util.Beans.Objects.Object is
   begin
      if Item.Item.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         declare
            Bean : constant Select_Item_Access := new Select_Item;
         begin
            Bean.all := Item;
            return Util.Beans.Objects.To_Object (Bean.all'Access);
         end;
      end if;
   end To_Object;

   --  ------------------------------
   --  Return the Select_Item instance from a generic bean object.
   --  Returns an empty item if the object does not hold a Select_Item.
   --  ------------------------------
   function To_Select_Item (Object : in Util.Beans.Objects.Object) return Select_Item is
      Bean   : constant access Util.Beans.Basic.Readonly_Bean'Class
        := Util.Beans.Objects.To_Bean (Object);
      Result : Select_Item;
   begin
      if Bean = null then
         return Result;
      end if;
      if not (Bean.all in Select_Item'Class) then
         return Result;
      end if;
      Result := Select_Item (Bean.all);
      return Result;
   end To_Select_Item;

   --  ------------------------------
   --  Creates a Select_Item with the specified label and value.
   --  ------------------------------
   function Create_Select_Item (Label       : in String;
                                Value       : in String;
                                Description : in String := "";
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item is
      use Ada.Characters.Conversions;

      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Access := Result.Item.Value;
      begin
         Item.Label       := To_Unbounded_Wide_Wide_String (To_Wide_Wide_String (Label));
         Item.Value       := To_Unbounded_Wide_Wide_String (To_Wide_Wide_String (Value));
         Item.Description := To_Unbounded_Wide_Wide_String (To_Wide_Wide_String (Description));
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item;

   --  ------------------------------
   --  Creates a Select_Item with the specified label and value.
   --  ------------------------------
   function Create_Select_Item_Wide (Label       : in Wide_Wide_String;
                                     Value       : in Wide_Wide_String;
                                     Description : in Wide_Wide_String := "";
                                     Disabled    : in Boolean := False;
                                     Escaped     : in Boolean := True) return Select_Item is
      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Access := Result.Item.Value;
      begin
         Item.Label       := To_Unbounded_Wide_Wide_String (Label);
         Item.Value       := To_Unbounded_Wide_Wide_String (Value);
         Item.Description := To_Unbounded_Wide_Wide_String (Description);
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item_Wide;

   --  ------------------------------
   --  Creates a Select_Item with the specified label, value and description.
   --  The objects are converted to a wide wide string.  The empty string is used if they
   --  are null.
   --  ------------------------------
   function Create_Select_Item (Label       : in Util.Beans.Objects.Object;
                                Value       : in Util.Beans.Objects.Object;
                                Description : in Util.Beans.Objects.Object;
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item is
      use Util.Beans.Objects;

      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Access := Result.Item.Value;
      begin
         if not Is_Null (Label) then
            Item.Label       := To_Unbounded_Wide_Wide_String (Label);
         end if;
         if not Is_Null (Value) then
            Item.Value       := To_Unbounded_Wide_Wide_String (Value);
         end if;
         if not Is_Null (Description) then
            Item.Description := To_Unbounded_Wide_Wide_String (Description);
         end if;
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item;

   --  ------------------------------
   --  Get the item label.
   --  ------------------------------
   function Get_Label (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Label);
      end if;
   end Get_Label;

   --  ------------------------------
   --  Get the item value.
   --  ------------------------------
   function Get_Value (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Value);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the item description.
   --  ------------------------------
   function Get_Description (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Description);
      end if;
   end Get_Description;

   --  ------------------------------
   --  Returns true if the item is disabled.
   --  ------------------------------
   function Is_Disabled (Item : in Select_Item) return Boolean is
   begin
      if Item.Item.Is_Null then
         return False;
      else
         return Item.Item.Value.Disabled;
      end if;
   end Is_Disabled;

   --  ------------------------------
   --  Returns true if the label must be escaped using HTML escape rules.
   --  ------------------------------
   function Is_Escaped (Item : in Select_Item) return Boolean is
   begin
      if Item.Item.Is_Null then
         return False;
      else
         return Item.Item.Value.Escape;
      end if;
   end Is_Escaped;

   --  ------------------------------
   --  Returns true if the select item component is empty.
   --  ------------------------------
   function Is_Empty (Item : in Select_Item) return Boolean is
   begin
      return Item.Item.Is_Null;
   end Is_Empty;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Select_Item;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Item.Is_Null then
         return Util.Beans.Objects.Null_Object;
      end if;
      declare
         Item : constant Select_Item_Record_Access := From.Item.Value;
      begin
         if Name = "name" then
            return Util.Beans.Objects.To_Object (Item.Label);
         elsif Name = "value" then
            return Util.Beans.Objects.To_Object (Item.Value);
         elsif Name = "description" then
            return Util.Beans.Objects.To_Object (Item.Description);
         elsif Name = "disabled" then
            return Util.Beans.Objects.To_Object (Item.Disabled);
         elsif Name = "escaped" then
            return Util.Beans.Objects.To_Object (Item.Escape);
         else
            return Util.Beans.Objects.Null_Object;
         end if;
      end;
   end Get_Value;

   --  ------------------------------
   --  Select Item List
   --  ------------------------------

   --  ------------------------------
   --  Return an Object from the select item list.
   --  Returns a NULL object if the list is empty.
   --  ------------------------------
   function To_Object (Item : in Select_Item_List) return Util.Beans.Objects.Object is
   begin
      if Item.List.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         declare
            Bean : constant Select_Item_List_Access := new Select_Item_List;
         begin
            Bean.all := Item;
            return Util.Beans.Objects.To_Object (Bean.all'Access);
         end;
      end if;
   end To_Object;

   --  ------------------------------
   --  Return the Select_Item_List instance from a generic bean object.
   --  Returns an empty list if the object does not hold a Select_Item_List.
   --  ------------------------------
   function To_Select_Item_List (Object : in Util.Beans.Objects.Object) return Select_Item_List is
      Bean : constant access Util.Beans.Basic.Readonly_Bean'Class
        := Util.Beans.Objects.To_Bean (Object);
      Result : Select_Item_List;
   begin
      if Bean = null then
         return Result;
      end if;
      if not (Bean.all in Select_Item_List'Class) then
         return Result;
      end if;
      Result := Select_Item_List (Bean.all);
      return Result;
   end To_Select_Item_List;

   --  ------------------------------
   --  Get the number of elements in the list.
   --  ------------------------------
   overriding
   function Get_Count (From : in Select_Item_List) return Natural is
   begin
      return From.Length;
   end Get_Count;

   --  ------------------------------
   --  Set the current row index.  Valid row indexes start at 1.
   --  ------------------------------
   overriding
   procedure Set_Row_Index (From  : in out Select_Item_List;
                            Index : in Natural) is
   begin
      From.Current := From.Get_Select_Item (Index);
      From.Row     := Util.Beans.Objects.To_Object (From.Current'Unchecked_Access,
                                                    Util.Beans.Objects.STATIC);
   end Set_Row_Index;

   --  ------------------------------
   --  Get the element at the current row index.
   --  ------------------------------
   overriding
   function Get_Row (From  : in Select_Item_List) return Util.Beans.Objects.Object is
   begin
      return From.Row;
   end Get_Row;

   --  ------------------------------
   --  Get the number of items in the list.
   --  ------------------------------
   function Length (List : in Select_Item_List) return Natural is
   begin
      if List.List.Is_Null then
         return 0;
      else
         return Natural (List.List.Value.List.Length);
      end if;
   end Length;

   --  ------------------------------
   --  Get the select item from the list
   --  ------------------------------
   function Get_Select_Item (List : in Select_Item_List'Class;
                             Pos  : in Positive) return Select_Item is
   begin
      if List.List.Is_Null then
         raise Constraint_Error with "Select item list is empty";
      end if;
      return List.List.Value.List.Element (Pos);
   end Get_Select_Item;

   --  ------------------------------
   --  Add the item at the end of the list.
   --  ------------------------------
   procedure Append (List : in out Select_Item_List;
                     Item : in Select_Item'Class) is
   begin
      if List.List.Is_Null then
         List.List := Select_Item_Vector_Refs.Create;
      end if;
      List.List.Value.all.List.Append (Select_Item (Item));
   end Append;

   --  ------------------------------
   --  Add the item at the end of the list.  This is a shortcut for
   --  Append (Create_List_Item (Label, Value))
   --  ------------------------------
   procedure Append (List  : in out Select_Item_List;
                     Label : in String;
                     Value : in String) is
   begin
      List.Append (Create_Select_Item (Label, Value));
   end Append;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Select_Item_List;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (From, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

end ASF.Models.Selects;

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

with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
package body ASF.Models.Selects is

   function UTF8_Decode (S : in String) return Wide_Wide_String
      renames Ada.Strings.UTF_Encoding.Wide_Wide_Strings.Decode;

   --  ------------------------------
   --  Return an Object from the select item record.
   --  Returns a NULL object if the item is empty.
   --  ------------------------------
   function To_Object (Item : in Select_Item) return Util.Beans.Objects.Object is
   begin
      if Item.Item.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         declare
            Bean : constant Select_Item_Access := new Select_Item;
         begin
            Bean.all := Item;
            return Util.Beans.Objects.To_Object (Bean.all'Access);
         end;
      end if;
   end To_Object;

   --  ------------------------------
   --  Return the Select_Item instance from a generic bean object.
   --  Returns an empty item if the object does not hold a Select_Item.
   --  ------------------------------
   function To_Select_Item (Object : in Util.Beans.Objects.Object) return Select_Item is
      Bean   : constant access Util.Beans.Basic.Readonly_Bean'Class
        := Util.Beans.Objects.To_Bean (Object);
      Result : Select_Item;
   begin
      if Bean = null then
         return Result;
      end if;
      if not (Bean.all in Select_Item'Class) then
         return Result;
      end if;
      Result := Select_Item (Bean.all);
      return Result;
   end To_Select_Item;

   --  ------------------------------
   --  Creates a Select_Item with the specified label and value.
   --  ------------------------------
   function Create_Select_Item (Label       : in String;
                                Value       : in String;
                                Description : in String := "";
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item is
      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Access := Result.Item.Value;
      begin
         Item.Label       := To_Unbounded_Wide_Wide_String (UTF8_Decode (Label));
         Item.Value       := To_Unbounded_Wide_Wide_String (UTF8_Decode (Value));
         Item.Description := To_Unbounded_Wide_Wide_String (UTF8_Decode (Description));
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item;

   --  ------------------------------
   --  Creates a Select_Item with the specified label and value.
   --  ------------------------------
   function Create_Select_Item_Wide (Label       : in Wide_Wide_String;
                                     Value       : in Wide_Wide_String;
                                     Description : in Wide_Wide_String := "";
                                     Disabled    : in Boolean := False;
                                     Escaped     : in Boolean := True) return Select_Item is
      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Access := Result.Item.Value;
      begin
         Item.Label       := To_Unbounded_Wide_Wide_String (Label);
         Item.Value       := To_Unbounded_Wide_Wide_String (Value);
         Item.Description := To_Unbounded_Wide_Wide_String (Description);
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item_Wide;

   --  ------------------------------
   --  Creates a Select_Item with the specified label, value and description.
   --  The objects are converted to a wide wide string.  The empty string is used if they
   --  are null.
   --  ------------------------------
   function Create_Select_Item (Label       : in Util.Beans.Objects.Object;
                                Value       : in Util.Beans.Objects.Object;
                                Description : in Util.Beans.Objects.Object;
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item is
      use Util.Beans.Objects;

      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Access := Result.Item.Value;
      begin
         if not Is_Null (Label) then
            Item.Label       := To_Unbounded_Wide_Wide_String (Label);
         end if;
         if not Is_Null (Value) then
            Item.Value       := To_Unbounded_Wide_Wide_String (Value);
         end if;
         if not Is_Null (Description) then
            Item.Description := To_Unbounded_Wide_Wide_String (Description);
         end if;
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item;

   --  ------------------------------
   --  Get the item label.
   --  ------------------------------
   function Get_Label (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Label);
      end if;
   end Get_Label;

   --  ------------------------------
   --  Get the item value.
   --  ------------------------------
   function Get_Value (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Value);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the item description.
   --  ------------------------------
   function Get_Description (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Description);
      end if;
   end Get_Description;

   --  ------------------------------
   --  Returns true if the item is disabled.
   --  ------------------------------
   function Is_Disabled (Item : in Select_Item) return Boolean is
   begin
      if Item.Item.Is_Null then
         return False;
      else
         return Item.Item.Value.Disabled;
      end if;
   end Is_Disabled;

   --  ------------------------------
   --  Returns true if the label must be escaped using HTML escape rules.
   --  ------------------------------
   function Is_Escaped (Item : in Select_Item) return Boolean is
   begin
      if Item.Item.Is_Null then
         return False;
      else
         return Item.Item.Value.Escape;
      end if;
   end Is_Escaped;

   --  ------------------------------
   --  Returns true if the select item component is empty.
   --  ------------------------------
   function Is_Empty (Item : in Select_Item) return Boolean is
   begin
      return Item.Item.Is_Null;
   end Is_Empty;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Select_Item;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Item.Is_Null then
         return Util.Beans.Objects.Null_Object;
      end if;
      declare
         Item : constant Select_Item_Record_Access := From.Item.Value;
      begin
         if Name = "name" then
            return Util.Beans.Objects.To_Object (Item.Label);
         elsif Name = "value" then
            return Util.Beans.Objects.To_Object (Item.Value);
         elsif Name = "description" then
            return Util.Beans.Objects.To_Object (Item.Description);
         elsif Name = "disabled" then
            return Util.Beans.Objects.To_Object (Item.Disabled);
         elsif Name = "escaped" then
            return Util.Beans.Objects.To_Object (Item.Escape);
         else
            return Util.Beans.Objects.Null_Object;
         end if;
      end;
   end Get_Value;

   --  ------------------------------
   --  Select Item List
   --  ------------------------------

   --  ------------------------------
   --  Return an Object from the select item list.
   --  Returns a NULL object if the list is empty.
   --  ------------------------------
   function To_Object (Item : in Select_Item_List) return Util.Beans.Objects.Object is
   begin
      if Item.List.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         declare
            Bean : constant Select_Item_List_Access := new Select_Item_List;
         begin
            Bean.all := Item;
            return Util.Beans.Objects.To_Object (Bean.all'Access);
         end;
      end if;
   end To_Object;

   --  ------------------------------
   --  Return the Select_Item_List instance from a generic bean object.
   --  Returns an empty list if the object does not hold a Select_Item_List.
   --  ------------------------------
   function To_Select_Item_List (Object : in Util.Beans.Objects.Object) return Select_Item_List is
      Bean : constant access Util.Beans.Basic.Readonly_Bean'Class
        := Util.Beans.Objects.To_Bean (Object);
      Result : Select_Item_List;
   begin
      if Bean = null then
         return Result;
      end if;
      if not (Bean.all in Select_Item_List'Class) then
         return Result;
      end if;
      Result := Select_Item_List (Bean.all);
      return Result;
   end To_Select_Item_List;

   --  ------------------------------
   --  Get the number of elements in the list.
   --  ------------------------------
   overriding
   function Get_Count (From : in Select_Item_List) return Natural is
   begin
      return From.Length;
   end Get_Count;

   --  ------------------------------
   --  Set the current row index.  Valid row indexes start at 1.
   --  ------------------------------
   overriding
   procedure Set_Row_Index (From  : in out Select_Item_List;
                            Index : in Natural) is
   begin
      From.Current := From.Get_Select_Item (Index);
      From.Row     := Util.Beans.Objects.To_Object (From.Current'Unchecked_Access,
                                                    Util.Beans.Objects.STATIC);
   end Set_Row_Index;

   --  ------------------------------
   --  Get the element at the current row index.
   --  ------------------------------
   overriding
   function Get_Row (From  : in Select_Item_List) return Util.Beans.Objects.Object is
   begin
      return From.Row;
   end Get_Row;

   --  ------------------------------
   --  Get the number of items in the list.
   --  ------------------------------
   function Length (List : in Select_Item_List) return Natural is
   begin
      if List.List.Is_Null then
         return 0;
      else
         return Natural (List.List.Value.List.Length);
      end if;
   end Length;

   --  ------------------------------
   --  Get the select item from the list
   --  ------------------------------
   function Get_Select_Item (List : in Select_Item_List'Class;
                             Pos  : in Positive) return Select_Item is
   begin
      if List.List.Is_Null then
         raise Constraint_Error with "Select item list is empty";
      end if;
      return List.List.Value.List.Element (Pos);
   end Get_Select_Item;

   --  ------------------------------
   --  Add the item at the end of the list.
   --  ------------------------------
   procedure Append (List : in out Select_Item_List;
                     Item : in Select_Item'Class) is
   begin
      if List.List.Is_Null then
         List.List := Select_Item_Vector_Refs.Create;
      end if;
      List.List.Value.all.List.Append (Select_Item (Item));
   end Append;

   --  ------------------------------
   --  Add the item at the end of the list.  This is a shortcut for
   --  Append (Create_List_Item (Label, Value))
   --  ------------------------------
   procedure Append (List  : in out Select_Item_List;
                     Label : in String;
                     Value : in String) is
   begin
      List.Append (Create_Select_Item (Label, Value));
   end Append;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Select_Item_List;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (From, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

end ASF.Models.Selects;

Use Ada.Strings.UTF_Encoding.Wide_Wide_Strings.Decode for the String to Wide_Wide_String conversion so that UTF-8 sequences are converted correctly


-----------------------------------------------------------------------
--  asf-models-selects -- Data model for UISelectOne and UISelectMany
--  Copyright (C) 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 Ada.Containers.Vectors;
with Ada.Strings.Wide_Wide_Unbounded;

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

package ASF.Models.Selects is

   --  ------------------------------
   --  Select Item
   --  ------------------------------
   --  The Select_Item type describes a single option of a list of options
   --  used by the UISelectOne or UISelectMany components.
   --  The select item contains:
   --

   --
A label
   --
A value
   --
A description
   --
Whether the select item is disabled or not
   --
Whether the label is escaped or not
   --

   --  An application creates the Select_Item instances and passes them
   --  to the ASF components through an Util.Beans.Objects.Object value.
   type Select_Item is new Util.Beans.Basic.Readonly_Bean with private;
   type Select_Item_Access is access all Select_Item;

   --  Return an Object from the select item record.
   --  Returns a NULL object if the item is empty.
   function To_Object (Item : in Select_Item) return Util.Beans.Objects.Object;

   --  Return the Select_Item instance from a generic bean object.
   --  Returns an empty item if the object does not hold a Select_Item.
   function To_Select_Item (Object : in Util.Beans.Objects.Object) return Select_Item;

   --  Creates a Select_Item with the specified label and value.
   function Create_Select_Item (Label       : in String;
                                Value       : in String;
                                Description : in String := "";
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item;

   --  Creates a Select_Item with the specified label and value.
   function Create_Select_Item_Wide (Label       : in Wide_Wide_String;
                                     Value       : in Wide_Wide_String;
                                     Description : in Wide_Wide_String := "";
                                     Disabled    : in Boolean := False;
                                     Escaped     : in Boolean := True) return Select_Item;

   --  Creates a Select_Item with the specified label, value and description.
   --  The objects are converted to a wide wide string.  The empty string is used if they
   --  are null.
   function Create_Select_Item (Label       : in Util.Beans.Objects.Object;
                                Value       : in Util.Beans.Objects.Object;
                                Description : in Util.Beans.Objects.Object;
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item;

   --  Get the item label.
   function Get_Label (Item : in Select_Item) return Wide_Wide_String;

   --  Get the item value.
   function Get_Value (Item : in Select_Item) return Wide_Wide_String;

   --  Get the item description.
   function Get_Description (Item : in Select_Item) return Wide_Wide_String;

   --  Returns true if the item is disabled.
   function Is_Disabled (Item : in Select_Item) return Boolean;

   --  Returns true if the label must be escaped using HTML escape rules.
   function Is_Escaped (Item : in Select_Item) return Boolean;

   --  Returns true if the select item component is empty.
   function Is_Empty (Item : in Select_Item) return Boolean;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Select_Item;
                       Name : in String) return Util.Beans.Objects.Object;

   --  ------------------------------
   --  Select Item List
   --  ------------------------------
   --  The Select_Item_List type holds a list of Select_Item.
   --  Similar to Select_Item, an application builds the list items and gives it
   --  to the ASF components through an Util.Beans.Objects.Object instance.
   type Select_Item_List is new Util.Beans.Basic.Readonly_Bean with private;
   type Select_Item_List_Access is access all Select_Item_List;

   --  Return an Object from the select item list.
   --  Returns a NULL object if the list is empty.
   function To_Object (Item : in Select_Item_List) return Util.Beans.Objects.Object;

   --  Return the Select_Item_List instance from a generic bean object.
   --  Returns an empty list if the object does not hold a Select_Item_List.
   function To_Select_Item_List (Object : in Util.Beans.Objects.Object) return Select_Item_List;

   --  Get the number of items in the list.
   function Length (List : in Select_Item_List) return Natural;

   --  Get the select item from the list
   function Get_Select_Item (List : in Select_Item_List'Class;
                             Pos  : in Positive) return Select_Item;

   --  Add the item at the end of the list.
   procedure Append (List : in out Select_Item_List;
                     Item : in Select_Item'Class);

   --  Add the item at the end of the list.  This is a shortcut for
   --  Append (Create_List_Item (Label, Value))
   procedure Append (List  : in out Select_Item_List;
                     Label : in String;
                     Value : in String);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   type Select_Item_Record is new Util.Refs.Ref_Entity with record
      Label       : Unbounded_Wide_Wide_String;
      Value       : Unbounded_Wide_Wide_String;
      Description : Unbounded_Wide_Wide_String;
      Disabled    : Boolean := False;
      Escape      : Boolean := False;
   end record;
   type Select_Item_Record_Access is access all Select_Item_Record;

   package Select_Item_Refs is
      new Util.Refs.References (Element_Type   => Select_Item_Record,
                                Element_Access => Select_Item_Record_Access);

   type Select_Item is new Util.Beans.Basic.Readonly_Bean with record
      Item : Select_Item_Refs.Ref;
   end record;

   package Select_Item_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Select_Item);

   type Select_Item_Vector is new Util.Refs.Ref_Entity with record
      List : Select_Item_Vectors.Vector;
   end record;
   type Select_Item_Vector_Access is access all Select_Item_Vector;

   package Select_Item_Vector_Refs is
      new Util.Refs.References (Element_Type   => Select_Item_Vector,
                                Element_Access => Select_Item_Vector_Access);

   type Select_Item_List is new Util.Beans.Basic.Readonly_Bean with record
      List : Select_Item_Vector_Refs.Ref;
   end record;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Select_Item_List;
                       Name : in String) return Util.Beans.Objects.Object;

end ASF.Models.Selects;

-----------------------------------------------------------------------
--  asf-models-selects -- Data model for UISelectOne and UISelectMany
--  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.Containers.Vectors;
with Ada.Strings.Wide_Wide_Unbounded;

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

package ASF.Models.Selects is

   --  ------------------------------
   --  Select Item
   --  ------------------------------
   --  The Select_Item type describes a single option of a list of options
   --  used by the UISelectOne or UISelectMany components.
   --  The select item contains:
   --

   --
A label
   --
A value
   --
A description
   --
Whether the select item is disabled or not
   --
Whether the label is escaped or not
   --

   --  An application creates the Select_Item instances and passes them
   --  to the ASF components through an Util.Beans.Objects.Object value.
   type Select_Item is new Util.Beans.Basic.Readonly_Bean with private;
   type Select_Item_Access is access all Select_Item;

   --  Return an Object from the select item record.
   --  Returns a NULL object if the item is empty.
   function To_Object (Item : in Select_Item) return Util.Beans.Objects.Object;

   --  Return the Select_Item instance from a generic bean object.
   --  Returns an empty item if the object does not hold a Select_Item.
   function To_Select_Item (Object : in Util.Beans.Objects.Object) return Select_Item;

   --  Creates a Select_Item with the specified label and value.
   function Create_Select_Item (Label       : in String;
                                Value       : in String;
                                Description : in String := "";
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item;

   --  Creates a Select_Item with the specified label and value.
   function Create_Select_Item_Wide (Label       : in Wide_Wide_String;
                                     Value       : in Wide_Wide_String;
                                     Description : in Wide_Wide_String := "";
                                     Disabled    : in Boolean := False;
                                     Escaped     : in Boolean := True) return Select_Item;

   --  Creates a Select_Item with the specified label, value and description.
   --  The objects are converted to a wide wide string.  The empty string is used if they
   --  are null.
   function Create_Select_Item (Label       : in Util.Beans.Objects.Object;
                                Value       : in Util.Beans.Objects.Object;
                                Description : in Util.Beans.Objects.Object;
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item;

   --  Get the item label.
   function Get_Label (Item : in Select_Item) return Wide_Wide_String;

   --  Get the item value.
   function Get_Value (Item : in Select_Item) return Wide_Wide_String;

   --  Get the item description.
   function Get_Description (Item : in Select_Item) return Wide_Wide_String;

   --  Returns true if the item is disabled.
   function Is_Disabled (Item : in Select_Item) return Boolean;

   --  Returns true if the label must be escaped using HTML escape rules.
   function Is_Escaped (Item : in Select_Item) return Boolean;

   --  Returns true if the select item component is empty.
   function Is_Empty (Item : in Select_Item) return Boolean;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Select_Item;
                       Name : in String) return Util.Beans.Objects.Object;

   --  ------------------------------
   --  Select Item List
   --  ------------------------------
   --  The Select_Item_List type holds a list of Select_Item.
   --  Similar to Select_Item, an application builds the list items and gives it
   --  to the ASF components through an Util.Beans.Objects.Object instance.
   type Select_Item_List is new Util.Beans.Basic.List_Bean with private;
   type Select_Item_List_Access is access all Select_Item_List;

   --  Return an Object from the select item list.
   --  Returns a NULL object if the list is empty.
   function To_Object (Item : in Select_Item_List) return Util.Beans.Objects.Object;

   --  Return the Select_Item_List instance from a generic bean object.
   --  Returns an empty list if the object does not hold a Select_Item_List.
   function To_Select_Item_List (Object : in Util.Beans.Objects.Object) return Select_Item_List;

   --  Get the number of elements in the list.
   overriding
   function Get_Count (From : in Select_Item_List) return Natural;

   --  Set the current row index.  Valid row indexes start at 1.
   overriding
   procedure Set_Row_Index (From  : in out Select_Item_List;
                            Index : in Natural);

   --  Get the element at the current row index.
   overriding
   function Get_Row (From  : in Select_Item_List) return Util.Beans.Objects.Object;

   --  Get the number of items in the list.
   function Length (List : in Select_Item_List) return Natural;

   --  Get the select item from the list
   function Get_Select_Item (List : in Select_Item_List'Class;
                             Pos  : in Positive) return Select_Item;

   --  Add the item at the end of the list.
   procedure Append (List : in out Select_Item_List;
                     Item : in Select_Item'Class);

   --  Add the item at the end of the list.  This is a shortcut for
   --  Append (Create_List_Item (Label, Value))
   procedure Append (List  : in out Select_Item_List;
                     Label : in String;
                     Value : in String);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   type Select_Item_Record is new Util.Refs.Ref_Entity with record
      Label       : Unbounded_Wide_Wide_String;
      Value       : Unbounded_Wide_Wide_String;
      Description : Unbounded_Wide_Wide_String;
      Disabled    : Boolean := False;
      Escape      : Boolean := False;
   end record;
   type Select_Item_Record_Access is access all Select_Item_Record;

   package Select_Item_Refs is
      new Util.Refs.References (Element_Type   => Select_Item_Record,
                                Element_Access => Select_Item_Record_Access);

   type Select_Item is new Util.Beans.Basic.Readonly_Bean with record
      Item : Select_Item_Refs.Ref;
   end record;

   package Select_Item_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Select_Item);

   type Select_Item_Vector is new Util.Refs.Ref_Entity with record
      List  : Select_Item_Vectors.Vector;
   end record;
   type Select_Item_Vector_Access is access all Select_Item_Vector;

   package Select_Item_Vector_Refs is
      new Util.Refs.References (Element_Type   => Select_Item_Vector,
                                Element_Access => Select_Item_Vector_Access);

   type Select_Item_List is new Util.Beans.Basic.List_Bean with record
      List    : Select_Item_Vector_Refs.Ref;
      Current : aliased Select_Item;
      Row     : Util.Beans.Objects.Object;
   end record;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Select_Item_List;
                       Name : in String) return Util.Beans.Objects.Object;

end ASF.Models.Selects;

Change the Select_List_Item to implement the List_Bean interface so that a select list can be used as general purpose lists also


-----------------------------------------------------------------------
--  applications -- Ada Web Application
--  Copyright (C) 2009, 2010, 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 Util.Beans.Basic;
with Util.Locales;

with EL.Objects;
with EL.Contexts;
with EL.Functions;
with EL.Functions.Default;
with EL.Expressions;
with EL.Variables.Default;
with Ada.Strings.Unbounded;

with ASF.Locales;
with ASF.Factory;
with ASF.Converters;
with ASF.Validators;
with ASF.Contexts.Faces;
with ASF.Contexts.Exceptions;
with ASF.Lifecycles;
with ASF.Applications.Views;
with ASF.Navigations;
with ASF.Beans;
with ASF.Requests;
with ASF.Responses;
with ASF.Servlets;
with ASF.Events.Faces.Actions;
with Security.Policies;  use Security;
with Security.OAuth.Servers;

package ASF.Applications.Main is

   use ASF.Beans;

   --  ------------------------------
   --  Factory for creation of lifecycle, view handler
   --  ------------------------------
   type Application_Factory is tagged limited private;

   --  Create the lifecycle handler.  The lifecycle handler is created during
   --  the initialization phase of the application.  The default implementation
   --  creates an ASF.Lifecycles.Default.Default_Lifecycle object.
   --  It can be overriden to change the behavior of the ASF request lifecycle.
   function Create_Lifecycle_Handler (App : in Application_Factory)
                                      return ASF.Lifecycles.Lifecycle_Access;

   --  Create the view handler.  The view handler is created during
   --  the initialization phase of the application.  The default implementation
   --  creates an ASF.Applications.Views.View_Handler object.
   --  It can be overriden to change the views associated with the application.
   function Create_View_Handler (App : in Application_Factory)
                                 return ASF.Applications.Views.View_Handler_Access;

   --  Create the navigation handler.  The navigation handler is created during
   --  the initialization phase of the application.  The default implementation
   --  creates an ASF.Navigations.Navigation_Handler object.
   --  It can be overriden to change the navigations associated with the application.
   function Create_Navigation_Handler (App : in Application_Factory)
                                       return ASF.Navigations.Navigation_Handler_Access;

   --  Create the security policy manager.  The security policy manager is created during
   --  the initialization phase of the application.  The default implementation
   --  creates a Security.Policies.Policy_Manager object.
   function Create_Security_Manager (App : in Application_Factory)
                                       return Security.Policies.Policy_Manager_Access;

   --  Create the OAuth application manager.  The OAuth application manager is created
   --  during the initialization phase of the application.  The default implementation
   --  creates a Security.OAuth.Servers.Auth_Manager object.
   function Create_OAuth_Manager (App : in Application_Factory)
                                  return Security.OAuth.Servers.Auth_Manager_Access;

   --  Create the exception handler.  The exception handler is created during
   --  the initialization phase of the application.  The default implementation
   --  creates a ASF.Contexts.Exceptions.Exception_Handler object.
   function Create_Exception_Handler (App : in Application_Factory)
                                      return ASF.Contexts.Exceptions.Exception_Handler_Access;

   --  ------------------------------
   --  Application
   --  ------------------------------
   type Application is new ASF.Servlets.Servlet_Registry
     and ASF.Events.Faces.Actions.Action_Listener with private;
   type Application_Access is access all Application'Class;

   --  Get the application view handler.
   function Get_View_Handler (App : access Application)
                              return access Views.View_Handler'Class;

   --  Get the lifecycle handler.
   function Get_Lifecycle_Handler (App : in Application)
                                   return ASF.Lifecycles.Lifecycle_Access;

   --  Get the navigation handler.
   function Get_Navigation_Handler (App : in Application)
                                    return ASF.Navigations.Navigation_Handler_Access;

   --  Get the permission manager associated with this application.
   function Get_Security_Manager (App : in Application)
                                    return Security.Policies.Policy_Manager_Access;

   --  Get the action event listener responsible for processing action
   --  events and triggering the navigation to the next view using the
   --  navigation handler.
   function Get_Action_Listener (App : in Application)
                                 return ASF.Events.Faces.Actions.Action_Listener_Access;

   --  Process the action associated with the action event.  The action returns
   --  and outcome which is then passed to the navigation handler to navigate to
   --  the next view.
   overriding
   procedure Process_Action (Listener : in Application;
                             Event    : in ASF.Events.Faces.Actions.Action_Event'Class;
                             Context  : in out Contexts.Faces.Faces_Context'Class);

   --  Execute the action method.  The action returns and outcome which is then passed
   --  to the navigation handler to navigate to the next view.
   procedure Process_Action (Listener : in Application;
                             Method   : in EL.Expressions.Method_Info;
                             Context  : in out Contexts.Faces.Faces_Context'Class);

   --  Initialize the application
   procedure Initialize (App     : in out Application;
                         Conf    : in Config;
                         Factory : in out Application_Factory'Class);

   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   procedure Initialize_Components (App : in out Application);

   --  Initialize the application configuration properties.  Properties defined in Conf
   --  are expanded by using the EL expression resolver.
   procedure Initialize_Config (App  : in out Application;
                                Conf : in out Config);

   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   procedure Initialize_Servlets (App : in out Application);

   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   procedure Initialize_Filters (App : in out Application);

   --  Finalizes the application, freeing the memory.
   overriding
   procedure Finalize (App : in out Application);

   --  Get the configuration parameter;
   function Get_Config (App   : Application;
                        Param : Config_Param) return String;

   --  Set a global variable in the global EL contexts.
   procedure Set_Global (App     : in out Application;
                         Name    : in String;
                         Value   : in String);

   procedure Set_Global (App     : in out Application;
                         Name    : in String;
                         Value   : in EL.Objects.Object);

   --  Resolve a global variable and return its value.
   --  Raises the EL.Functions.No_Variable exception if the variable does not exist.
   function Get_Global (App : in Application;
                        Name : in Ada.Strings.Unbounded.Unbounded_String;
                        Context : in EL.Contexts.ELContext'Class)
                        return EL.Objects.Object;

   --  Get the list of supported locales for this application.
   function Get_Supported_Locales (App : in Application)
                                   return Util.Locales.Locale_Array;

   --  Add the locale to the list of supported locales.
   procedure Add_Supported_Locale (App    : in out Application;
                                   Locale : in Util.Locales.Locale);

   --  Get the default locale defined by the application.
   function Get_Default_Locale (App : in Application) return Util.Locales.Locale;

   --  Set the default locale defined by the application.
   procedure Set_Default_Locale (App    : in out Application;
                                 Locale : in Util.Locales.Locale);

   --  Compute the locale that must be used according to the Accept-Language request
   --  header and the application supported locales.
   function Calculate_Locale (Handler : in Application;
                              Context : in ASF.Contexts.Faces.Faces_Context'Class)
                              return Util.Locales.Locale;

   --  Register a bundle and bind it to a facelet variable.
   procedure Register (App    : in out Application;
                       Name   : in String;
                       Bundle : in String);

   --  Register the bean identified by Name and associated with the class Class.
   --  The class must have been registered by using the Register class operation.
   --  The scope defines the scope of the bean.
   procedure Register (App     : in out Application;
                       Name    : in String;
                       Class   : in String;
                       Params  : in Parameter_Bean_Ref.Ref;
                       Scope   : in Scope_Type := REQUEST_SCOPE);

   --  Register under the name identified by Name the class instance Class.
   procedure Register_Class (App     : in out Application;
                             Name    : in String;
                             Class   : in ASF.Beans.Class_Binding_Access);

   --  Register under the name identified by Name a function to create a bean.
   --  This is a simplified class registration.
   procedure Register_Class (App     : in out Application;
                             Name    : in String;
                             Handler : in ASF.Beans.Create_Bean_Access);

   --  Create a bean by using the create operation registered for the name
   procedure Create (App     : in Application;
                     Name    : in Ada.Strings.Unbounded.Unbounded_String;
                     Context : in EL.Contexts.ELContext'Class;
                     Result  : out Util.Beans.Basic.Readonly_Bean_Access;
                     Scope   : out Scope_Type);

   --  Add a converter in the application.  The converter is referenced by
   --  the specified name in the XHTML files.
   procedure Add_Converter (App       : in out Application;
                            Name      : in String;
                            Converter : in ASF.Converters.Converter_Access);

   --  Register a binding library in the factory.
   procedure Add_Components (App      : in out Application;
                             Bindings : in ASF.Factory.Factory_Bindings_Access);

   --  Closes the application
   procedure Close (App : in out Application);

   --  Set the current faces context before processing a view.
   procedure Set_Context (App     : in out Application;
                          Context : in ASF.Contexts.Faces.Faces_Context_Access);

   --  Execute the lifecycle phases on the faces context.
   procedure Execute_Lifecycle (App     : in Application;
                                Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  Dispatch the request received on a page.
   procedure Dispatch (App      : in out Application;
                       Page     : in String;
                       Request  : in out ASF.Requests.Request'Class;
                       Response : in out ASF.Responses.Response'Class);

   --  Dispatch a bean action request.
   --  1. Find the bean object identified by Name, create it if necessary.
   --  2. Resolve the bean method identified by Operation.
   --  3. If the method is an action method (see ASF.Events.Actions), call that method.
   --  4. Using the outcome action result, decide using the navigation handler what
   --     is the result view.
   --  5. Render the result view resolved by the navigation handler.
   procedure Dispatch (App       : in out Application;
                       Name      : in String;
                       Operation : in String;
                       Request   : in out ASF.Requests.Request'Class;
                       Response  : in out ASF.Responses.Response'Class;
                       Prepare   : access procedure (Bean : access Util.Beans.Basic.Bean'Class));

   --  Find the converter instance that was registered under the given name.
   --  Returns null if no such converter exist.
   function Find (App  : in Application;
                  Name : in EL.Objects.Object) return ASF.Converters.Converter_Access;

   --  Find the validator instance that was registered under the given name.
   --  Returns null if no such validator exist.
   function Find_Validator (App  : in Application;
                            Name : in EL.Objects.Object)
                            return ASF.Validators.Validator_Access;

   --  Register some functions
   generic
      with procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class);
   procedure Register_Functions (App : in out Application'Class);

   --  Register some bean definitions.
   generic
      with procedure Set_Beans (Factory : in out ASF.Beans.Bean_Factory);
   procedure Register_Beans (App : in out Application'Class);

   --  Load the resource bundle identified by the Name and for the given
   --  Locale.
   procedure Load_Bundle (App    : in out Application;
                          Name   : in String;
                          Locale : in String;
                          Bundle : out ASF.Locales.Bundle);

private

   type Application_Factory is tagged limited null record;

   type Application is new ASF.Servlets.Servlet_Registry
     and ASF.Events.Faces.Actions.Action_Listener with record
      View    : aliased ASF.Applications.Views.View_Handler;
      Lifecycle : ASF.Lifecycles.Lifecycle_Access;
      Factory : aliased ASF.Beans.Bean_Factory;
      Locales : ASF.Locales.Factory;
      Globals : aliased EL.Variables.Default.Default_Variable_Mapper;

      Functions : aliased EL.Functions.Default.Default_Function_Mapper;

      --  The component factory
      Components : aliased ASF.Factory.Component_Factory;

      --  The action listener.
      Action_Listener : ASF.Events.Faces.Actions.Action_Listener_Access;

      --  The navigation handler.
      Navigation      : ASF.Navigations.Navigation_Handler_Access := null;

      --  The permission manager.
      Permissions     : Security.Policies.Policy_Manager_Access := null;

   end record;

end ASF.Applications.Main;

-----------------------------------------------------------------------
--  applications -- Ada Web Application
--  Copyright (C) 2009, 2010, 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 Util.Beans.Basic;
with Util.Locales;

with EL.Objects;
with EL.Contexts;
with EL.Functions;
with EL.Functions.Default;
with EL.Expressions;
with EL.Variables.Default;
with Ada.Strings.Unbounded;

with ASF.Locales;
with ASF.Factory;
with ASF.Converters;
with ASF.Validators;
with ASF.Contexts.Faces;
with ASF.Contexts.Exceptions;
with ASF.Lifecycles;
with ASF.Applications.Views;
with ASF.Navigations;
with ASF.Beans;
with ASF.Requests;
with ASF.Responses;
with ASF.Servlets;
with ASF.Events.Faces.Actions;
with Security.Policies;  use Security;
with Security.OAuth.Servers;

package ASF.Applications.Main is

   use ASF.Beans;

   --  ------------------------------
   --  Factory for creation of lifecycle, view handler
   --  ------------------------------
   type Application_Factory is tagged limited private;

   --  Create the lifecycle handler.  The lifecycle handler is created during
   --  the initialization phase of the application.  The default implementation
   --  creates an ASF.Lifecycles.Default.Default_Lifecycle object.
   --  It can be overriden to change the behavior of the ASF request lifecycle.
   function Create_Lifecycle_Handler (App : in Application_Factory)
                                      return ASF.Lifecycles.Lifecycle_Access;

   --  Create the view handler.  The view handler is created during
   --  the initialization phase of the application.  The default implementation
   --  creates an ASF.Applications.Views.View_Handler object.
   --  It can be overriden to change the views associated with the application.
   function Create_View_Handler (App : in Application_Factory)
                                 return ASF.Applications.Views.View_Handler_Access;

   --  Create the navigation handler.  The navigation handler is created during
   --  the initialization phase of the application.  The default implementation
   --  creates an ASF.Navigations.Navigation_Handler object.
   --  It can be overriden to change the navigations associated with the application.
   function Create_Navigation_Handler (App : in Application_Factory)
                                       return ASF.Navigations.Navigation_Handler_Access;

   --  Create the security policy manager.  The security policy manager is created during
   --  the initialization phase of the application.  The default implementation
   --  creates a Security.Policies.Policy_Manager object.
   function Create_Security_Manager (App : in Application_Factory)
                                       return Security.Policies.Policy_Manager_Access;

   --  Create the OAuth application manager.  The OAuth application manager is created
   --  during the initialization phase of the application.  The default implementation
   --  creates a Security.OAuth.Servers.Auth_Manager object.
   function Create_OAuth_Manager (App : in Application_Factory)
                                  return Security.OAuth.Servers.Auth_Manager_Access;

   --  Create the exception handler.  The exception handler is created during
   --  the initialization phase of the application.  The default implementation
   --  creates a ASF.Contexts.Exceptions.Exception_Handler object.
   function Create_Exception_Handler (App : in Application_Factory)
                                      return ASF.Contexts.Exceptions.Exception_Handler_Access;

   --  ------------------------------
   --  Application
   --  ------------------------------
   type Application is new ASF.Servlets.Servlet_Registry
     and ASF.Events.Faces.Actions.Action_Listener with private;
   type Application_Access is access all Application'Class;

   --  Get the application view handler.
   function Get_View_Handler (App : access Application)
                              return access Views.View_Handler'Class;

   --  Get the lifecycle handler.
   function Get_Lifecycle_Handler (App : in Application)
                                   return ASF.Lifecycles.Lifecycle_Access;

   --  Get the navigation handler.
   function Get_Navigation_Handler (App : in Application)
                                    return ASF.Navigations.Navigation_Handler_Access;

   --  Get the permission manager associated with this application.
   function Get_Security_Manager (App : in Application)
                                    return Security.Policies.Policy_Manager_Access;

   --  Get the OAuth application manager associated with this application.
   function Get_OAuth_Manager (App : in Application)
                               return Security.OAuth.Servers.Auth_Manager_Access;

   --  Get the action event listener responsible for processing action
   --  events and triggering the navigation to the next view using the
   --  navigation handler.
   function Get_Action_Listener (App : in Application)
                                 return ASF.Events.Faces.Actions.Action_Listener_Access;

   --  Process the action associated with the action event.  The action returns
   --  and outcome which is then passed to the navigation handler to navigate to
   --  the next view.
   overriding
   procedure Process_Action (Listener : in Application;
                             Event    : in ASF.Events.Faces.Actions.Action_Event'Class;
                             Context  : in out Contexts.Faces.Faces_Context'Class);

   --  Execute the action method.  The action returns and outcome which is then passed
   --  to the navigation handler to navigate to the next view.
   procedure Process_Action (Listener : in Application;
                             Method   : in EL.Expressions.Method_Info;
                             Context  : in out Contexts.Faces.Faces_Context'Class);

   --  Initialize the application
   procedure Initialize (App     : in out Application;
                         Conf    : in Config;
                         Factory : in out Application_Factory'Class);

   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   procedure Initialize_Components (App : in out Application);

   --  Initialize the application configuration properties.  Properties defined in Conf
   --  are expanded by using the EL expression resolver.
   procedure Initialize_Config (App  : in out Application;
                                Conf : in out Config);

   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   procedure Initialize_Servlets (App : in out Application);

   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   procedure Initialize_Filters (App : in out Application);

   --  Finalizes the application, freeing the memory.
   overriding
   procedure Finalize (App : in out Application);

   --  Get the configuration parameter;
   function Get_Config (App   : Application;
                        Param : Config_Param) return String;

   --  Set a global variable in the global EL contexts.
   procedure Set_Global (App     : in out Application;
                         Name    : in String;
                         Value   : in String);

   procedure Set_Global (App     : in out Application;
                         Name    : in String;
                         Value   : in EL.Objects.Object);

   --  Resolve a global variable and return its value.
   --  Raises the EL.Functions.No_Variable exception if the variable does not exist.
   function Get_Global (App : in Application;
                        Name : in Ada.Strings.Unbounded.Unbounded_String;
                        Context : in EL.Contexts.ELContext'Class)
                        return EL.Objects.Object;

   --  Get the list of supported locales for this application.
   function Get_Supported_Locales (App : in Application)
                                   return Util.Locales.Locale_Array;

   --  Add the locale to the list of supported locales.
   procedure Add_Supported_Locale (App    : in out Application;
                                   Locale : in Util.Locales.Locale);

   --  Get the default locale defined by the application.
   function Get_Default_Locale (App : in Application) return Util.Locales.Locale;

   --  Set the default locale defined by the application.
   procedure Set_Default_Locale (App    : in out Application;
                                 Locale : in Util.Locales.Locale);

   --  Compute the locale that must be used according to the Accept-Language request
   --  header and the application supported locales.
   function Calculate_Locale (Handler : in Application;
                              Context : in ASF.Contexts.Faces.Faces_Context'Class)
                              return Util.Locales.Locale;

   --  Register a bundle and bind it to a facelet variable.
   procedure Register (App    : in out Application;
                       Name   : in String;
                       Bundle : in String);

   --  Register the bean identified by Name and associated with the class Class.
   --  The class must have been registered by using the Register class operation.
   --  The scope defines the scope of the bean.
   procedure Register (App     : in out Application;
                       Name    : in String;
                       Class   : in String;
                       Params  : in Parameter_Bean_Ref.Ref;
                       Scope   : in Scope_Type := REQUEST_SCOPE);

   --  Register under the name identified by Name the class instance Class.
   procedure Register_Class (App     : in out Application;
                             Name    : in String;
                             Class   : in ASF.Beans.Class_Binding_Access);

   --  Register under the name identified by Name a function to create a bean.
   --  This is a simplified class registration.
   procedure Register_Class (App     : in out Application;
                             Name    : in String;
                             Handler : in ASF.Beans.Create_Bean_Access);

   --  Create a bean by using the create operation registered for the name
   procedure Create (App     : in Application;
                     Name    : in Ada.Strings.Unbounded.Unbounded_String;
                     Context : in EL.Contexts.ELContext'Class;
                     Result  : out Util.Beans.Basic.Readonly_Bean_Access;
                     Scope   : out Scope_Type);

   --  Add a converter in the application.  The converter is referenced by
   --  the specified name in the XHTML files.
   procedure Add_Converter (App       : in out Application;
                            Name      : in String;
                            Converter : in ASF.Converters.Converter_Access);

   --  Register a binding library in the factory.
   procedure Add_Components (App      : in out Application;
                             Bindings : in ASF.Factory.Factory_Bindings_Access);

   --  Closes the application
   procedure Close (App : in out Application);

   --  Set the current faces context before processing a view.
   procedure Set_Context (App     : in out Application;
                          Context : in ASF.Contexts.Faces.Faces_Context_Access);

   --  Execute the lifecycle phases on the faces context.
   procedure Execute_Lifecycle (App     : in Application;
                                Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  Dispatch the request received on a page.
   procedure Dispatch (App      : in out Application;
                       Page     : in String;
                       Request  : in out ASF.Requests.Request'Class;
                       Response : in out ASF.Responses.Response'Class);

   --  Dispatch a bean action request.
   --  1. Find the bean object identified by Name, create it if necessary.
   --  2. Resolve the bean method identified by Operation.
   --  3. If the method is an action method (see ASF.Events.Actions), call that method.
   --  4. Using the outcome action result, decide using the navigation handler what
   --     is the result view.
   --  5. Render the result view resolved by the navigation handler.
   procedure Dispatch (App       : in out Application;
                       Name      : in String;
                       Operation : in String;
                       Request   : in out ASF.Requests.Request'Class;
                       Response  : in out ASF.Responses.Response'Class;
                       Prepare   : access procedure (Bean : access Util.Beans.Basic.Bean'Class));

   --  Find the converter instance that was registered under the given name.
   --  Returns null if no such converter exist.
   function Find (App  : in Application;
                  Name : in EL.Objects.Object) return ASF.Converters.Converter_Access;

   --  Find the validator instance that was registered under the given name.
   --  Returns null if no such validator exist.
   function Find_Validator (App  : in Application;
                            Name : in EL.Objects.Object)
                            return ASF.Validators.Validator_Access;

   --  Register some functions
   generic
      with procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class);
   procedure Register_Functions (App : in out Application'Class);

   --  Register some bean definitions.
   generic
      with procedure Set_Beans (Factory : in out ASF.Beans.Bean_Factory);
   procedure Register_Beans (App : in out Application'Class);

   --  Load the resource bundle identified by the Name and for the given
   --  Locale.
   procedure Load_Bundle (App    : in out Application;
                          Name   : in String;
                          Locale : in String;
                          Bundle : out ASF.Locales.Bundle);

private

   type Application_Factory is tagged limited null record;

   type Application is new ASF.Servlets.Servlet_Registry
     and ASF.Events.Faces.Actions.Action_Listener with record
      View    : aliased ASF.Applications.Views.View_Handler;
      Lifecycle : ASF.Lifecycles.Lifecycle_Access;
      Factory : aliased ASF.Beans.Bean_Factory;
      Locales : ASF.Locales.Factory;
      Globals : aliased EL.Variables.Default.Default_Variable_Mapper;

      Functions : aliased EL.Functions.Default.Default_Function_Mapper;

      --  The component factory
      Components : aliased ASF.Factory.Component_Factory;

      --  The action listener.
      Action_Listener : ASF.Events.Faces.Actions.Action_Listener_Access;

      --  The navigation handler.
      Navigation      : ASF.Navigations.Navigation_Handler_Access;

      --  The permission manager.
      Permissions     : Security.Policies.Policy_Manager_Access;

      --  The OAuth application manager.
      OAuth           : Security.OAuth.Servers.Auth_Manager_Access;
   end record;

end ASF.Applications.Main;

Declare the Get_OAuth_Manager function to retrieve the OAuth manager


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

package body Util.Stacks is

   procedure Free is
     new Ada.Unchecked_Deallocation (Element_Type_Array,
                                     Element_Type_Array_Access);

   --  ------------------------------
   --  Get access to the current stack element.
   --  ------------------------------
   function Current (Container : in Stack) return Element_Type_Access is
   begin
      return Container.Current;
   end Current;

   --  ------------------------------
   --  Push an element on top of the stack making the new element the current one.
   --  ------------------------------
   procedure Push (Container : in out Stack) is
   begin
      if Container.Stack = null then
         Container.Stack := new Element_Type_Array (1 .. 100);
         Container.Pos := Container.Stack'First;
      elsif Container.Pos = Container.Stack'Last then
         declare
            Old : Element_Type_Array_Access := Container.Stack;
         begin
            Container.Stack := new Element_Type_Array (1 .. Old'Last + 100);
            Container.Stack (1 .. Old'Last) := Old (1 .. Old'Last);
            Free (Old);
         end;
      end if;
      if Container.Pos /= Container.Stack'First then
         Container.Stack (Container.Pos + 1) := Container.Stack (Container.Pos);
      end if;
      Container.Pos := Container.Pos + 1;
      Container.Current := Container.Stack (Container.Pos)'Access;
   end Push;

   --  ------------------------------
   --  Pop the top element.
   --  ------------------------------
   procedure Pop (Container : in out Stack) is
   begin
      Container.Pos := Container.Pos - 1;
      Container.Current   := Container.Stack (Container.Pos)'Access;
   end Pop;

   --  ------------------------------
   --  Clear the stack.
   --  ------------------------------
   procedure Clear (Container : in out Stack) is
   begin
      if Container.Stack /= null then
         Container.Pos := Container.Stack'First;
      end if;
      Container.Current := null;
   end Clear;

   --  ------------------------------
   --  Release the stack
   --  ------------------------------
   overriding
   procedure Finalize (Obj : in out Stack) is
   begin
      Free (Obj.Stack);
   end Finalize;

end Util.Stacks;

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

package body Util.Stacks is

   procedure Free is
     new Ada.Unchecked_Deallocation (Element_Type_Array,
                                     Element_Type_Array_Access);

   --  ------------------------------
   --  Get access to the current stack element.
   --  ------------------------------
   function Current (Container : in Stack) return Element_Type_Access is
   begin
      return Container.Current;
   end Current;

   --  ------------------------------
   --  Push an element on top of the stack making the new element the current one.
   --  ------------------------------
   procedure Push (Container : in out Stack) is
   begin
      if Container.Stack = null then
         Container.Stack := new Element_Type_Array (1 .. 100);
         Container.Pos := Container.Stack'First;
      elsif Container.Pos = Container.Stack'Last then
         declare
            Old : Element_Type_Array_Access := Container.Stack;
         begin
            Container.Stack := new Element_Type_Array (1 .. Old'Last + 100);
            Container.Stack (1 .. Old'Last) := Old (1 .. Old'Last);
            Free (Old);
         end;
      end if;
      if Container.Pos /= Container.Stack'First then
         Container.Stack (Container.Pos + 1) := Container.Stack (Container.Pos);
      end if;
      Container.Pos := Container.Pos + 1;
      Container.Current := Container.Stack (Container.Pos)'Access;
   end Push;

   --  ------------------------------
   --  Pop the top element.
   --  ------------------------------
   procedure Pop (Container : in out Stack) is
   begin
      if Container.Pos > Container.Stack'First then
         Container.Pos := Container.Pos - 1;
         Container.Current   := Container.Stack (Container.Pos)'Access;
      else
         Container.Current := null;
      end if;
   end Pop;

   --  ------------------------------
   --  Clear the stack.
   --  ------------------------------
   procedure Clear (Container : in out Stack) is
   begin
      if Container.Stack /= null then
         Container.Pos := Container.Stack'First;
      end if;
      Container.Current := null;
   end Clear;

   --  ------------------------------
   --  Returns true if the stack is empty.
   --  ------------------------------
   function Is_Empty (Container : in out Stack) return Boolean is
   begin
      return Container.Stack = null or else Container.Pos = Container.Stack'First;
   end Is_Empty;

   --  ------------------------------
   --  Release the stack
   --  ------------------------------
   overriding
   procedure Finalize (Obj : in out Stack) is
   begin
      Free (Obj.Stack);
   end Finalize;

end Util.Stacks;

Add Is_Empty function and fix Pop when the last element is popped


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

with ASF.Applications.Main;

package ASF.Servlets.Faces is

   --  The <b>Servlet</b> represents the component that will handle
   --  an HTTP request received by the server.
   type Faces_Servlet is new Servlet with private;

   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   overriding
   procedure Initialize (Server  : in out Faces_Servlet;
                         Context : in Servlet_Registry'Class);

   --  Called by the server (via the service method) to allow a servlet to handle
   --  a GET request.
   --
   --  Overriding this method to support a GET request also automatically supports
   --  an HTTP HEAD request. A HEAD request is a GET request that returns no body
   --  in the response, only the request header fields.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding.
   --  When using a PrintWriter object to return the response, set the content type
   --  before accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container
   --  to use a persistent connection to return its response to the client,
   --  improving performance. The content length is automatically set if the entire
   --  response fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  The GET method should be safe, that is, without any side effects for which
   --  users are held responsible. For example, most form queries have no side effects.
   --  If a client request is intended to change stored data, the request should use
   --  some other HTTP method.
   --
   --  The GET method should also be idempotent, meaning that it can be safely repeated.
   --  Sometimes making a method safe also makes it idempotent. For example, repeating
   --  queries is both safe and idempotent, but buying a product online or modifying
   --  data is neither safe nor idempotent.
   --
   --  If the request is incorrectly formatted, Do_Get  returns an HTTP "Bad Request"
   procedure Do_Get (Server   : in Faces_Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class);

   --  Called by the server (via the service method) to allow a servlet to handle
   --  a POST request. The HTTP POST method allows the client to send data of unlimited
   --  length to the Web server a single time and is useful when posting information
   --  such as credit card numbers.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding. When using
   --  a PrintWriter object to return the response, set the content type before
   --  accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container to use
   --  a persistent connection to return its response to the client, improving
   --  performance. The content length is automatically set if the entire response
   --  fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  This method does not need to be either safe or idempotent. Operations
   --  requested through POST can have side effects for which the user can be held
   --  accountable, for example, updating stored data or buying items online.
   --
   --  If the HTTP POST request is incorrectly formatted, doPost returns
   --  an HTTP "Bad Request" message.
   procedure Do_Post (Server   : in Faces_Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class);

private

   type Faces_Servlet is new Servlet with record
      App    : ASF.Applications.Main.Application_Access;
   end record;

end ASF.Servlets.Faces;

-----------------------------------------------------------------------
--  asf.servlets.faces -- Faces servlet
--  Copyright (C) 2010, 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 Servlet.Core;
with ASF.Requests;
with ASF.Responses;
with ASF.Applications.Main;

package ASF.Servlets.Faces is

   --  The <b>Servlet</b> represents the component that will handle
   --  an HTTP request received by the server.
   type Faces_Servlet is new Servlet.Core.Servlet with private;

   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   overriding
   procedure Initialize (Server  : in out Faces_Servlet;
                         Context : in Servlet_Registry'Class);

   --  Called by the server (via the service method) to allow a servlet to handle
   --  a GET request.
   --
   --  Overriding this method to support a GET request also automatically supports
   --  an HTTP HEAD request. A HEAD request is a GET request that returns no body
   --  in the response, only the request header fields.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding.
   --  When using a PrintWriter object to return the response, set the content type
   --  before accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container
   --  to use a persistent connection to return its response to the client,
   --  improving performance. The content length is automatically set if the entire
   --  response fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  The GET method should be safe, that is, without any side effects for which
   --  users are held responsible. For example, most form queries have no side effects.
   --  If a client request is intended to change stored data, the request should use
   --  some other HTTP method.
   --
   --  The GET method should also be idempotent, meaning that it can be safely repeated.
   --  Sometimes making a method safe also makes it idempotent. For example, repeating
   --  queries is both safe and idempotent, but buying a product online or modifying
   --  data is neither safe nor idempotent.
   --
   --  If the request is incorrectly formatted, Do_Get  returns an HTTP "Bad Request"
   procedure Do_Get (Server   : in Faces_Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class);

   --  Called by the server (via the service method) to allow a servlet to handle
   --  a POST request. The HTTP POST method allows the client to send data of unlimited
   --  length to the Web server a single time and is useful when posting information
   --  such as credit card numbers.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding. When using
   --  a PrintWriter object to return the response, set the content type before
   --  accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container to use
   --  a persistent connection to return its response to the client, improving
   --  performance. The content length is automatically set if the entire response
   --  fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  This method does not need to be either safe or idempotent. Operations
   --  requested through POST can have side effects for which the user can be held
   --  accountable, for example, updating stored data or buying items online.
   --
   --  If the HTTP POST request is incorrectly formatted, doPost returns
   --  an HTTP "Bad Request" message.
   procedure Do_Post (Server   : in Faces_Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class);

private

   type Faces_Servlet is new Servlet.Core.Servlet with record
      App    : ASF.Applications.Main.Application_Access;
   end record;

end ASF.Servlets.Faces;

Package ASF.Servlets moved to Servlet.Core