-----------------------------------------------------------------------
--  wiki-render-wiki -- Wiki to Wiki renderer
--  Copyright (C) 2015, 2016, 2020, 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.Strings.Wide_Wide_Maps;
with Ada.Strings.Wide_Wide_Unbounded;

with Wiki.Documents;
with Wiki.Attributes;
with Wiki.Streams;
with Wiki.Strings;

--  === Wiki Renderer ===
--  The `Wiki_Renderer</tt> allows to render a wiki document into another wiki content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Wiki is

   use Standard.Wiki.Attributes;

   --  ------------------------------
   --  Wiki to HTML writer
   --  ------------------------------
   type Wiki_Renderer is new Renderer with private;

   --  Set the output stream.
   procedure Set_Output_Stream (Engine   : in out Wiki_Renderer;
                                Stream   : in Streams.Output_Stream_Access;
                                Format   : in Wiki_Syntax);

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Wiki_Renderer;
                     Doc    : in Documents.Document;
                     Node   : in Nodes.Node_Type);

   --  Add a section header in the document.
   procedure Render_Header (Engine : in out Wiki_Renderer;
                            Header : in Wide_Wide_String;
                            Level  : in Positive);

   --  Add a paragraph (<p>).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   procedure Add_Paragraph (Engine : in out Wiki_Renderer);

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Engine : in out Wiki_Renderer;
                             Level    : in Natural);

   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Engine : in out Wiki_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Render a link.
   procedure Render_Link (Engine : in out Wiki_Renderer;
                          Name     : in Strings.WString;
                          Attrs    : in Attributes.Attribute_List);

   --  Render an image.
   procedure Render_Image (Engine : in out Wiki_Renderer;
                           Title  : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Render a quote.
   procedure Render_Quote (Engine : in out Wiki_Renderer;
                           Title  : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Add a text block with the given format.
   procedure Render_Text (Engine : in out Wiki_Renderer;
                          Text   : in Wide_Wide_String;
                          Format : in Format_Map);

   --  Render a text block that is pre-formatted.
   procedure Render_Preformatted (Engine : in out Wiki_Renderer;
                                  Text   : in Strings.WString;
                                  Format : in Strings.WString);

   procedure Render_Tag (Engine : in out Wiki_Renderer;
                         Doc    : in Documents.Document;
                         Node   : in Nodes.Node_Type);

   --  Finish the document after complete wiki text has been parsed.
   procedure Finish (Engine : in out Wiki_Renderer;
                     Doc    : in Documents.Document);

   --  Set the text style format.
   procedure Set_Format (Engine : in out Wiki_Renderer;
                         Format   : in Format_Map);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wide_String_Access is access constant Wide_Wide_String;

   type Wiki_Tag_Type is (Header_Start, Header_End,
                          Img_Start, Img_End,
                          Link_Start, Link_End, Link_Separator,
                          Quote_Start, Quote_End, Quote_Separator,
                          Preformat_Start, Preformat_End,
                          List_Start, List_Item, List_Ordered_Item,
                          Line_Break, Escape_Rule,
                          Horizontal_Rule,
                          Blockquote_Start, Blockquote_End);

   type Wiki_Tag_Array is array (Wiki_Tag_Type) of Wide_String_Access;

   type Wiki_Format_Array is array (Format_Type) of Wide_String_Access;

   procedure Write_Optional_Space (Engine : in out Wiki_Renderer);

   --  Emit a new line.
   procedure New_Line (Engine   : in out Wiki_Renderer;
                       Optional : in Boolean := False);
   procedure Need_Separator_Line (Engine   : in out Wiki_Renderer);

   procedure Close_Paragraph (Engine : in out Wiki_Renderer);
   procedure Start_Keep_Content (Engine : in out Wiki_Renderer);

   type List_Style_Array is array (1 .. 32) of Boolean;

   EMPTY_TAG : aliased constant Wide_Wide_String := "";

   type Wiki_Renderer is new Renderer with record
      Output              : Streams.Output_Stream_Access := null;
      Syntax              : Wiki_Syntax := SYNTAX_CREOLE;
      Format              : Format_Map := (others => False);
      Tags                : Wiki_Tag_Array := (others => EMPTY_TAG'Access);
      Style_Start_Tags    : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Style_End_Tags      : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Escape_Set          : Ada.Strings.Wide_Wide_Maps.Wide_Wide_Character_Set;
      Has_Paragraph       : Boolean := False;
      Has_Item            : Boolean := False;
      Need_Paragraph      : Boolean := False;
      Need_Newline        : Boolean := False;
      Need_Space          : Boolean := False;
      Empty_Line          : Boolean := True;
      Empty_Previous_Line : Boolean := True;
      Keep_Content        : Natural := 0;
      In_List             : Boolean := False;
      Invert_Header_Level : Boolean := False;
      Allow_Link_Language : Boolean := False;
      Link_First          : Boolean := False;
      Html_Blockquote     : Boolean := False;
      In_Table            : Boolean := False;
      Col_Index           : Natural := 0;
      Line_Count          : Natural := 0;
      Current_Level       : Natural := 0;
      Quote_Level         : Natural := 0;
      UL_List_Level       : Natural := 0;
      OL_List_Level       : Natural := 0;
      Current_Style       : Format_Map := (others => False);
      Content             : Unbounded_Wide_Wide_String;
      Link_Href           : Unbounded_Wide_Wide_String;
      Link_Title          : Unbounded_Wide_Wide_String;
      Link_Lang           : Unbounded_Wide_Wide_String;
   end record;

   --  Render the table of content.
   procedure Render_TOC (Engine : in out Wiki_Renderer;
                         Doc    : in Documents.Document;
                         Level  : in Natural);

   --  Render a table component such as N_TABLE.
   procedure Render_Table (Engine : in out Wiki_Renderer;
                           Doc    : in Documents.Document;
                           Node   : in Nodes.Node_Type);

   --  Render a table row component such as N_ROW.
   procedure Render_Row (Engine : in out Wiki_Renderer;
                         Doc    : in Documents.Document;
                         Node   : in Nodes.Node_Type);

   --  Render a table row component such as N_COLUMN.
   procedure Render_Column (Engine : in out Wiki_Renderer;
                            Doc    : in Documents.Document;
                            Node   : in Nodes.Node_Type);

end Wiki.Render.Wiki;

-----------------------------------------------------------------------
--  wiki-render-wiki -- Wiki to Wiki renderer
--  Copyright (C) 2015, 2016, 2020, 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.Strings.Wide_Wide_Maps;
with Ada.Strings.Wide_Wide_Unbounded;

with Wiki.Documents;
with Wiki.Attributes;
with Wiki.Streams;
with Wiki.Strings;

--  === Wiki Renderer ===
--  The `Wiki_Renderer</tt> allows to render a wiki document into another wiki content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Wiki is

   use Standard.Wiki.Attributes;

   --  ------------------------------
   --  Wiki to HTML writer
   --  ------------------------------
   type Wiki_Renderer is new Renderer with private;

   --  Set the output stream.
   procedure Set_Output_Stream (Engine   : in out Wiki_Renderer;
                                Stream   : in Streams.Output_Stream_Access;
                                Format   : in Wiki_Syntax);

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Wiki_Renderer;
                     Doc    : in Documents.Document;
                     Node   : in Nodes.Node_Type);

   --  Add a section header in the document.
   procedure Render_Header (Engine : in out Wiki_Renderer;
                            Header : in Wide_Wide_String;
                            Level  : in Positive);

   --  Add a paragraph (<p>).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   procedure Add_Paragraph (Engine : in out Wiki_Renderer);

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Engine : in out Wiki_Renderer;
                             Level    : in Natural);

   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Engine : in out Wiki_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Render a link.
   procedure Render_Link (Engine : in out Wiki_Renderer;
                          Name     : in Strings.WString;
                          Attrs    : in Attributes.Attribute_List);

   --  Render an image.
   procedure Render_Image (Engine : in out Wiki_Renderer;
                           Title  : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Render a quote.
   procedure Render_Quote (Engine : in out Wiki_Renderer;
                           Title  : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Add a text block with the given format.
   procedure Render_Text (Engine : in out Wiki_Renderer;
                          Text   : in Wide_Wide_String;
                          Format : in Format_Map);

   --  Render a text block that is pre-formatted.
   procedure Render_Preformatted (Engine : in out Wiki_Renderer;
                                  Text   : in Strings.WString;
                                  Format : in Strings.WString);

   procedure Render_Tag (Engine : in out Wiki_Renderer;
                         Doc    : in Documents.Document;
                         Node   : in Nodes.Node_Type);

   --  Finish the document after complete wiki text has been parsed.
   procedure Finish (Engine : in out Wiki_Renderer;
                     Doc    : in Documents.Document);

   --  Set the text style format.
   procedure Set_Format (Engine : in out Wiki_Renderer;
                         Format   : in Format_Map);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wide_String_Access is access constant Wide_Wide_String;

   type Wiki_Tag_Type is (Header_Start, Header_End,
                          Img_Start, Img_End,
                          Link_Start, Link_End, Link_Separator,
                          Quote_Start, Quote_End, Quote_Separator,
                          Preformat_Start, Preformat_End,
                          List_Start, List_Item, List_Ordered_Item,
                          Line_Break, Escape_Rule,
                          Horizontal_Rule,
                          Blockquote_Start, Blockquote_End);

   type Wiki_Tag_Array is array (Wiki_Tag_Type) of Wide_String_Access;

   type Wiki_Format_Array is array (Format_Type) of Wide_String_Access;

   procedure Write_Optional_Space (Engine : in out Wiki_Renderer);

   --  Emit a new line.
   procedure New_Line (Engine   : in out Wiki_Renderer;
                       Optional : in Boolean := False);
   procedure Need_Separator_Line (Engine   : in out Wiki_Renderer);

   procedure Close_Paragraph (Engine : in out Wiki_Renderer);
   procedure Start_Keep_Content (Engine : in out Wiki_Renderer);

   type List_Style_Array is array (1 .. 32) of Boolean;

   EMPTY_TAG : aliased constant Wide_Wide_String := "";

   type Wiki_Renderer is new Renderer with record
      Output              : Streams.Output_Stream_Access := null;
      Syntax              : Wiki_Syntax := SYNTAX_CREOLE;
      Format              : Format_Map := (others => False);
      Tags                : Wiki_Tag_Array := (others => EMPTY_TAG'Access);
      Style_Start_Tags    : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Style_End_Tags      : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Escape_Set          : Ada.Strings.Wide_Wide_Maps.Wide_Wide_Character_Set;
      Has_Paragraph       : Boolean := False;
      Has_Item            : Boolean := False;
      Need_Paragraph      : Boolean := False;
      Need_Newline        : Boolean := False;
      Need_Space          : Boolean := False;
      Empty_Line          : Boolean := True;
      Empty_Previous_Line : Boolean := True;
      Keep_Content        : Natural := 0;
      In_List             : Boolean := False;
      Invert_Header_Level : Boolean := False;
      Allow_Link_Language : Boolean := False;
      Link_First          : Boolean := False;
      Html_Blockquote     : Boolean := False;
      Html_Table          : Boolean := False;
      In_Table            : Boolean := False;
      Col_Index           : Natural := 0;
      Line_Count          : Natural := 0;
      Current_Level       : Natural := 0;
      Quote_Level         : Natural := 0;
      UL_List_Level       : Natural := 0;
      OL_List_Level       : Natural := 0;
      Current_Style       : Format_Map := (others => False);
      Content             : Unbounded_Wide_Wide_String;
      Link_Href           : Unbounded_Wide_Wide_String;
      Link_Title          : Unbounded_Wide_Wide_String;
      Link_Lang           : Unbounded_Wide_Wide_String;
   end record;

   procedure Write_Link (Engine : in out Wiki_Renderer;
                         Link   : in Strings.WString);

   --  Render the table of content.
   procedure Render_TOC (Engine : in out Wiki_Renderer;
                         Doc    : in Documents.Document;
                         Level  : in Natural);

   --  Render a table component such as N_TABLE.
   procedure Render_Table (Engine : in out Wiki_Renderer;
                           Doc    : in Documents.Document;
                           Node   : in Nodes.Node_Type);

   --  Render a table row component such as N_ROW.
   procedure Render_Row (Engine : in out Wiki_Renderer;
                         Doc    : in Documents.Document;
                         Node   : in Nodes.Node_Type);

   --  Render a table row component such as N_COLUMN.
   procedure Render_Column (Engine : in out Wiki_Renderer;
                            Doc    : in Documents.Document;
                            Node   : in Nodes.Node_Type);

end Wiki.Render.Wiki;

Declare the Write_Link procedure

Declare the Write_Link procedure


-----------------------------------------------------------------------
--  applications -- Ada Web Application
--  Copyright (C) 2009, 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.Strings.Fixed;

with ASF.Contexts.Facelets;
with ASF.Applications.Main;
with ASF.Components.Base;
with ASF.Components.Core;
with ASF.Responses;
package body ASF.Applications.Views is

   use ASF.Components;

   type Facelet_Context is new ASF.Contexts.Facelets.Facelet_Context with record
      Facelets    : access ASF.Views.Facelets.Facelet_Factory;
      Application : access ASF.Applications.Main.Application'Class;
   end record;

   --  Include the definition having the given name.
   overriding
   procedure Include_Facelet (Context : in out Facelet_Context;
                              Source  : in String;
                              Parent  : in Base.UIComponent_Access);

   --  Get the application associated with this facelet context.
   overriding
   function Get_Application (Context : in Facelet_Context)
                             return access ASF.Applications.Main.Application'Class;

   --  ------------------------------
   --  Include the definition having the given name.
   --  ------------------------------
   overriding
   procedure Include_Facelet (Context : in out Facelet_Context;
                              Source  : in String;
                              Parent  : in Base.UIComponent_Access) is

      use ASF.Views;

      Path : constant String := Context.Resolve_Path (Source);
      Tree : Facelets.Facelet;
   begin
      Facelets.Find_Facelet (Factory => Context.Facelets.all,
                             Name    => Path,
                             Context => Context,
                             Result  => Tree);

      Facelets.Build_View (View    => Tree,
                           Context => Context,
                           Root    => Parent);
   end Include_Facelet;

   --  ------------------------------
   --  Get the application associated with this facelet context.
   --  ------------------------------
   overriding
   function Get_Application (Context : in Facelet_Context)
                             return access ASF.Applications.Main.Application'Class is
   begin
      return Context.Application;
   end Get_Application;

   --  ------------------------------
   --  Get the facelet name from the view name.
   --  ------------------------------
   function Get_Facelet_Name (Handler : in View_Handler;
                              Name    : in String) return String is
      use Ada.Strings.Fixed;
      use Ada.Strings.Unbounded;

      Pos : constant Natural := Index (Name, ".", Ada.Strings.Backward);
   begin
      if Pos > 0 and then To_String (Handler.View_Ext) = Name (Pos .. Name'Last) then
         return Name (Name'First .. Pos - 1) & To_String (Handler.File_Ext);
      end if;
      return Name & To_String (Handler.File_Ext);
   end Get_Facelet_Name;

   --  ------------------------------
   --  Restore the view identified by the given name in the faces context
   --  and create the component tree representing that view.
   --  ------------------------------
   procedure Restore_View (Handler : in out View_Handler;
                           Name    : in String;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class;
                           View    : out ASF.Components.Root.UIViewRoot) is

      use ASF.Views;

      Ctx       : Facelet_Context;
      Tree      : Facelets.Facelet;
      View_Name : constant String := Handler.Get_Facelet_Name (Name);
   begin
      Ctx.Facelets    := Handler.Facelets'Unchecked_Access;
      Ctx.Application := Context.Get_Application;
      Ctx.Set_ELContext (Context.Get_ELContext);
      Facelets.Find_Facelet (Factory => Handler.Facelets,
                             Name    => View_Name,
                             Context => Ctx,
                             Result  => Tree);
      if Facelets.Is_Null (Tree) then
         Context.Get_Response.Send_Error (ASF.Responses.SC_NOT_FOUND);
         Context.Response_Completed;
         return;
      end if;

      --  Build the component tree for this request.
      declare
         Root : aliased Core.UIComponentBase;
         Node : Base.UIComponent_Access;
      begin
         Facelets.Build_View (View    => Tree,
                              Context => Ctx,
                              Root    => Root'Unchecked_Access);
         ASF.Components.Base.Steal_Root_Component (Root, Node);
         ASF.Components.Root.Set_Root (View, Node, View_Name);
      end;
   end Restore_View;

   --  ------------------------------
   --  Create a new UIViewRoot instance initialized from the context and with
   --  the view identifier.  If the view is a valid view, create the component tree
   --  representing that view.
   --  ------------------------------
   procedure Create_View (Handler : in out View_Handler;
                          Name    : in String;
                          Context : in out ASF.Contexts.Faces.Faces_Context'Class;
                          View    : out ASF.Components.Root.UIViewRoot) is
      Pos : constant Natural := Util.Strings.Rindex (Name, '.');
   begin
      if Pos > 0 then
         Handler.Restore_View (Name (Name'First .. Pos - 1), Context, View);
      else
         Handler.Restore_View (Name, Context, View);
      end if;
   end Create_View;

   --  ------------------------------
   --  Render the view represented by the component tree.  The view is
   --  rendered using the context.
   --  ------------------------------
   procedure Render_View (Handler : in out View_Handler;
                          Context : in out ASF.Contexts.Faces.Faces_Context'Class;
                          View    : in ASF.Components.Root.UIViewRoot) is
      pragma Unreferenced (Handler);

      Root : constant access ASF.Components.Base.UIComponent'Class
        := ASF.Components.Root.Get_Root (View);
   begin
      if Root /= null then
         Root.Encode_All (Context);
      end if;
   end Render_View;

   --  ------------------------------
   --  Get the URL suitable for encoding and rendering the view specified by the <b>View</b>
   --  identifier.
   --  ------------------------------
   function Get_Action_URL (Handler : in View_Handler;
                            Context : in ASF.Contexts.Faces.Faces_Context'Class;
                            View    : in String) return String is
      use Ada.Strings.Unbounded;

      Pos          : constant Natural := Util.Strings.Rindex (View, '.');
      Context_Path : constant String := Context.Get_Request.Get_Context_Path;
   begin
      if Pos > 0 and then View (Pos .. View'Last) = Handler.File_Ext then
         return Context_Path & View (View'First .. Pos - 1) & To_String (Handler.View_Ext);
      end if;
      if Pos > 0 and then View (Pos .. View'Last) = Handler.View_Ext then
         return Context_Path & View;
      end if;
      return Context_Path & View;
   end Get_Action_URL;

   --  ------------------------------
   --  Get the URL for redirecting the user to the specified view.
   --  ------------------------------
   function Get_Redirect_URL (Handler : in View_Handler;
                              Context : in ASF.Contexts.Faces.Faces_Context'Class;
                              View    : in String) return String is
   begin
      return Handler.Get_Action_URL (Context, View);
   end Get_Redirect_URL;

   --  ------------------------------
   --  Initialize the view handler.
   --  ------------------------------
   procedure Initialize (Handler    : out View_Handler;
                         Components : access ASF.Factory.Component_Factory;
                         Conf       : in Config) is
      use ASF.Views;
      use Ada.Strings.Unbounded;
   begin
      Handler.Paths    := To_Unbounded_String (Conf.Get (VIEW_DIR_PARAM));
      Handler.View_Ext := To_Unbounded_String (Conf.Get (VIEW_EXT_PARAM));
      Handler.File_Ext := To_Unbounded_String (Conf.Get (VIEW_FILE_EXT_PARAM));

      Facelets.Initialize (Factory => Handler.Facelets,
                           Components => Components,
                           Paths   => To_String (Handler.Paths),
                           Ignore_White_Spaces => Conf.Get (VIEW_IGNORE_WHITE_SPACES_PARAM),
                           Ignore_Empty_Lines  => Conf.Get (VIEW_IGNORE_EMPTY_LINES_PARAM),
                           Escape_Unknown_Tags => Conf.Get (VIEW_ESCAPE_UNKNOWN_TAGS_PARAM));

   end Initialize;

   --  ------------------------------
   --  Closes the view handler
   --  ------------------------------
   procedure Close (Handler : in out View_Handler) is
      use ASF.Views;
   begin
      Facelets.Clear_Cache (Handler.Facelets);
   end Close;

   --  ------------------------------
   --  Set the extension mapping rule to find the facelet file from
   --  the name.
   --  ------------------------------
   procedure Set_Extension_Mapping (Handler : in out View_Handler;
                                    From    : in String;
                                    Into    : in String) is
      use Ada.Strings.Unbounded;
   begin
      Handler.View_Ext := To_Unbounded_String (From);
      Handler.File_Ext := To_Unbounded_String (Into);
   end Set_Extension_Mapping;

end ASF.Applications.Views;

-----------------------------------------------------------------------
--  applications -- Ada Web Application
--  Copyright (C) 2009, 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.Strings.Fixed;

with ASF.Contexts.Facelets;
with ASF.Applications.Main;
with ASF.Components.Base;
with ASF.Components.Core;
with ASF.Responses;
package body ASF.Applications.Views is

   use ASF.Components;

   type Facelet_Context is new ASF.Contexts.Facelets.Facelet_Context with record
      Facelets    : access ASF.Views.Facelets.Facelet_Factory;
      Application : access ASF.Applications.Main.Application'Class;
   end record;

   --  Include the definition having the given name.
   overriding
   procedure Include_Facelet (Context : in out Facelet_Context;
                              Source  : in String;
                              Parent  : in Base.UIComponent_Access);

   --  Get the application associated with this facelet context.
   overriding
   function Get_Application (Context : in Facelet_Context)
                             return access ASF.Applications.Main.Application'Class;

   --  ------------------------------
   --  Include the definition having the given name.
   --  ------------------------------
   overriding
   procedure Include_Facelet (Context : in out Facelet_Context;
                              Source  : in String;
                              Parent  : in Base.UIComponent_Access) is

      use ASF.Views;

      Path : constant String := Context.Resolve_Path (Source);
      Tree : Facelets.Facelet;
   begin
      Facelets.Find_Facelet (Factory => Context.Facelets.all,
                             Name    => Path,
                             Context => Context,
                             Result  => Tree);

      Facelets.Build_View (View    => Tree,
                           Context => Context,
                           Root    => Parent);
   end Include_Facelet;

   --  ------------------------------
   --  Get the application associated with this facelet context.
   --  ------------------------------
   overriding
   function Get_Application (Context : in Facelet_Context)
                             return access ASF.Applications.Main.Application'Class is
   begin
      return Context.Application;
   end Get_Application;

   --  ------------------------------
   --  Get the facelet name from the view name.
   --  ------------------------------
   function Get_Facelet_Name (Handler : in View_Handler;
                              Name    : in String) return String is
      use Ada.Strings.Fixed;
      use Ada.Strings.Unbounded;

      Pos : constant Natural := Index (Name, ".", Ada.Strings.Backward);
   begin
      if Pos > 0 and then To_String (Handler.View_Ext) = Name (Pos .. Name'Last) then
         return Name (Name'First .. Pos - 1) & To_String (Handler.File_Ext);
      end if;
      return Name & To_String (Handler.File_Ext);
   end Get_Facelet_Name;

   --  ------------------------------
   --  Restore the view identified by the given name in the faces context
   --  and create the component tree representing that view.
   --  ------------------------------
   procedure Restore_View (Handler : in out View_Handler;
                           Name    : in String;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class;
                           View    : out ASF.Components.Root.UIViewRoot) is

      use ASF.Views;

      Ctx       : Facelet_Context;
      Tree      : Facelets.Facelet;
      View_Name : constant String := Handler.Get_Facelet_Name (Name);
   begin
      Ctx.Facelets    := Handler.Facelets'Unchecked_Access;
      Ctx.Application := Context.Get_Application;
      Ctx.Set_ELContext (Context.Get_ELContext);
      Facelets.Find_Facelet (Factory => Handler.Facelets,
                             Name    => View_Name,
                             Context => Ctx,
                             Result  => Tree);
      if Facelets.Is_Null (Tree) then
         Context.Get_Response.Send_Error (ASF.Responses.SC_NOT_FOUND);
         Context.Response_Completed;
         return;
      end if;

      --  Build the component tree for this request.
      declare
         Root : aliased Core.UIComponentBase;
         Node : Base.UIComponent_Access;
      begin
         Facelets.Build_View (View    => Tree,
                              Context => Ctx,
                              Root    => Root'Unchecked_Access);
         ASF.Components.Base.Steal_Root_Component (Root, Node);
         ASF.Components.Root.Set_Root (View, Node, View_Name);
      end;
   end Restore_View;

   --  ------------------------------
   --  Create a new UIViewRoot instance initialized from the context and with
   --  the view identifier.  If the view is a valid view, create the component tree
   --  representing that view.
   --  ------------------------------
   procedure Create_View (Handler : in out View_Handler;
                          Name    : in String;
                          Context : in out ASF.Contexts.Faces.Faces_Context'Class;
                          View    : out ASF.Components.Root.UIViewRoot) is
      Pos : constant Natural := Util.Strings.Rindex (Name, '.');
   begin
      if Pos > 0 then
         Handler.Restore_View (Name (Name'First .. Pos - 1), Context, View);
      else
         Handler.Restore_View (Name, Context, View);
      end if;
   end Create_View;

   --  ------------------------------
   --  Render the view represented by the component tree.  The view is
   --  rendered using the context.
   --  ------------------------------
   procedure Render_View (Handler : in out View_Handler;
                          Context : in out ASF.Contexts.Faces.Faces_Context'Class;
                          View    : in ASF.Components.Root.UIViewRoot) is
      pragma Unreferenced (Handler);

      Root : constant access ASF.Components.Base.UIComponent'Class
        := ASF.Components.Root.Get_Root (View);
   begin
      if Root /= null then
         Root.Encode_All (Context);
      end if;
   end Render_View;

   --  ------------------------------
   --  Get the URL suitable for encoding and rendering the view specified by the <b>View</b>
   --  identifier.
   --  ------------------------------
   function Get_Action_URL (Handler : in View_Handler;
                            Context : in ASF.Contexts.Faces.Faces_Context'Class;
                            View    : in String) return String is
      use Ada.Strings.Unbounded;

      Pos          : constant Natural := Util.Strings.Rindex (View, '.');
      Context_Path : constant String := Context.Get_Request.Get_Context_Path;
   begin
      if Pos > 0 and then View (Pos .. View'Last) = Handler.File_Ext then
         return Context_Path & View (View'First .. Pos - 1) & To_String (Handler.View_Ext);
      end if;
      if Pos > 0 and then View (Pos .. View'Last) = Handler.View_Ext then
         return Context_Path & View;
      end if;
      return Context_Path & View;
   end Get_Action_URL;

   --  ------------------------------
   --  Get the URL for redirecting the user to the specified view.
   --  ------------------------------
   function Get_Redirect_URL (Handler : in View_Handler;
                              Context : in ASF.Contexts.Faces.Faces_Context'Class;
                              View    : in String) return String is
      Pos : constant Natural := Util.Strings.Rindex (View, '?');
   begin
      if Pos > 0 then
         return Handler.Get_Action_URL (Context, View (View'First .. Pos - 1))
           & View (Pos .. View'Last);
      else
         return Handler.Get_Action_URL (Context, View);
      end if;
   end Get_Redirect_URL;

   --  ------------------------------
   --  Initialize the view handler.
   --  ------------------------------
   procedure Initialize (Handler    : out View_Handler;
                         Components : access ASF.Factory.Component_Factory;
                         Conf       : in Config) is
      use ASF.Views;
      use Ada.Strings.Unbounded;
   begin
      Handler.Paths    := To_Unbounded_String (Conf.Get (VIEW_DIR_PARAM));
      Handler.View_Ext := To_Unbounded_String (Conf.Get (VIEW_EXT_PARAM));
      Handler.File_Ext := To_Unbounded_String (Conf.Get (VIEW_FILE_EXT_PARAM));

      Facelets.Initialize (Factory => Handler.Facelets,
                           Components => Components,
                           Paths   => To_String (Handler.Paths),
                           Ignore_White_Spaces => Conf.Get (VIEW_IGNORE_WHITE_SPACES_PARAM),
                           Ignore_Empty_Lines  => Conf.Get (VIEW_IGNORE_EMPTY_LINES_PARAM),
                           Escape_Unknown_Tags => Conf.Get (VIEW_ESCAPE_UNKNOWN_TAGS_PARAM));

   end Initialize;

   --  ------------------------------
   --  Closes the view handler
   --  ------------------------------
   procedure Close (Handler : in out View_Handler) is
      use ASF.Views;
   begin
      Facelets.Clear_Cache (Handler.Facelets);
   end Close;

   --  ------------------------------
   --  Set the extension mapping rule to find the facelet file from
   --  the name.
   --  ------------------------------
   procedure Set_Extension_Mapping (Handler : in out View_Handler;
                                    From    : in String;
                                    Into    : in String) is
      use Ada.Strings.Unbounded;
   begin
      Handler.View_Ext := To_Unbounded_String (From);
      Handler.File_Ext := To_Unbounded_String (Into);
   end Set_Extension_Mapping;

end ASF.Applications.Views;

Fix get_Redirect_URL to handler view parameters


-----------------------------------------------------------------------
--  asf.responses -- ASF Requests
--  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.
-----------------------------------------------------------------------

--  The ASF.Responses package is an Ada implementation of
--  the Java servlet response (JSR 315 5. The Response).
package body ASF.Responses.Mockup is

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   function Contains_Header (Resp : in Response;
                             Name : in String) return Boolean is
      Pos : constant Util.Strings.Maps.Cursor := Resp.Headers.Find (Name);
   begin
      return Util.Strings.Maps.Has_Element (Pos);
   end Contains_Header;

   --  ------------------------------
   --  Iterate over the response headers and executes the Process procedure.
   --  ------------------------------
   procedure Iterate_Headers (Resp    : in Response;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is

      procedure Process_Wrapper (Position : in Util.Strings.Maps.Cursor);

      procedure Process_Wrapper (Position : in Util.Strings.Maps.Cursor) is
      begin
         Process.all (Name  => Util.Strings.Maps.Key (Position),
                      Value => Util.Strings.Maps.Element (Position));
      end Process_Wrapper;

   begin
      Resp.Headers.Iterate (Process => Process_Wrapper'Access);
   end Iterate_Headers;

   --  ------------------------------
   --  Sets a response header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   --  ------------------------------
   procedure Set_Header (Resp  : in out Response;
                         Name  : in String;
                         Value : in String) is
   begin
      Resp.Headers.Include (Name, Value);
   end Set_Header;

   --  ------------------------------
   --  Adds a response header with the given name and value.
   --  This method allows response headers to have multiple values.
   --  ------------------------------
   procedure Add_Header (Resp  : in out Response;
                         Name  : in String;
                         Value : in String) is
   begin
      Resp.Headers.Insert (Name, Value);
   end Add_Header;

   --  ------------------------------
   --  Returns the value of the specified response header as a String. If the response
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the response. The header name is case insensitive. You can use
   --  this method with any response header.
   --  ------------------------------
   function Get_Header (Resp : in Response;
                        Name : in String) return String is
      Pos : constant Util.Strings.Maps.Cursor := Resp.Headers.Find (Name);
   begin
      if Util.Strings.Maps.Has_Element (Pos) then
         return Util.Strings.Maps.Element (Pos);
      else
         return "";
      end if;
   end Get_Header;

   --  ------------------------------
   --  Get the content written to the mockup output stream.
   --  ------------------------------
   procedure Read_Content (Resp : in out Response;
                           Into : out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Resp.Content.Read (Into => Into);
   end Read_Content;

   --  ------------------------------
   --  Clear the response content.
   --  This operation removes any content held in the output stream, clears the status,
   --  removes any header in the response.
   --  ------------------------------
   procedure Clear (Resp : in out Response) is
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Resp.Read_Content (Content);
      Resp.Status := SC_OK;
      Resp.Headers.Clear;
   end Clear;

   --  ------------------------------
   --  Initialize the response mockup output stream.
   --  ------------------------------
   overriding
   procedure Initialize (Resp : in out Response) is
   begin
      Resp.Content.Initialize (128 * 1024);
      Resp.Stream := Resp.Content'Unchecked_Access;
   end Initialize;

end ASF.Responses.Mockup;

-----------------------------------------------------------------------
--  asf.responses -- ASF Requests
--  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.
-----------------------------------------------------------------------

--  The ASF.Responses package is an Ada implementation of
--  the Java servlet response (JSR 315 5. The Response).
package body ASF.Responses.Mockup is

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   function Contains_Header (Resp : in Response;
                             Name : in String) return Boolean is
      Pos : constant Util.Strings.Maps.Cursor := Resp.Headers.Find (Name);
   begin
      return Util.Strings.Maps.Has_Element (Pos);
   end Contains_Header;

   --  ------------------------------
   --  Iterate over the response headers and executes the Process procedure.
   --  ------------------------------
   procedure Iterate_Headers (Resp    : in Response;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is

      procedure Process_Wrapper (Position : in Util.Strings.Maps.Cursor);

      procedure Process_Wrapper (Position : in Util.Strings.Maps.Cursor) is
      begin
         Process.all (Name  => Util.Strings.Maps.Key (Position),
                      Value => Util.Strings.Maps.Element (Position));
      end Process_Wrapper;

   begin
      Resp.Headers.Iterate (Process => Process_Wrapper'Access);
   end Iterate_Headers;

   --  ------------------------------
   --  Sets a response header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   --  ------------------------------
   procedure Set_Header (Resp  : in out Response;
                         Name  : in String;
                         Value : in String) is
   begin
      Resp.Headers.Include (Name, Value);
   end Set_Header;

   --  ------------------------------
   --  Adds a response header with the given name and value.
   --  This method allows response headers to have multiple values.
   --  ------------------------------
   procedure Add_Header (Resp  : in out Response;
                         Name  : in String;
                         Value : in String) is
   begin
      if Resp.Headers.Contains (Name) then
         Resp.Headers.Include (Name, Resp.Headers.Element (Name) & ASCII.LF
                               & Name & ": " & Value);
      else
         Resp.Headers.Insert (Name, Value);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Returns the value of the specified response header as a String. If the response
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the response. The header name is case insensitive. You can use
   --  this method with any response header.
   --  ------------------------------
   function Get_Header (Resp : in Response;
                        Name : in String) return String is
      Pos : constant Util.Strings.Maps.Cursor := Resp.Headers.Find (Name);
   begin
      if Util.Strings.Maps.Has_Element (Pos) then
         return Util.Strings.Maps.Element (Pos);
      else
         return "";
      end if;
   end Get_Header;

   --  ------------------------------
   --  Get the content written to the mockup output stream.
   --  ------------------------------
   procedure Read_Content (Resp : in out Response;
                           Into : out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Resp.Content.Read (Into => Into);
   end Read_Content;

   --  ------------------------------
   --  Clear the response content.
   --  This operation removes any content held in the output stream, clears the status,
   --  removes any header in the response.
   --  ------------------------------
   procedure Clear (Resp : in out Response) is
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Resp.Read_Content (Content);
      Resp.Status := SC_OK;
      Resp.Headers.Clear;
   end Clear;

   --  ------------------------------
   --  Initialize the response mockup output stream.
   --  ------------------------------
   overriding
   procedure Initialize (Resp : in out Response) is
   begin
      Resp.Content.Initialize (128 * 1024);
      Resp.Stream := Resp.Content'Unchecked_Access;
   end Initialize;

end ASF.Responses.Mockup;

Fix the response mockup to support several response headers with the same name


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

with Util.Encoders.Base64;
with Util.Log.Loggers;

--  The ASF.Sessions.Factory package is a factory for creating, searching
--  and deleting sessions.
package body ASF.Sessions.Factory is

   use Ada.Finalization;
   use Ada.Strings.Unbounded;

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

   --  ------------------------------
   --  Allocate a unique and random session identifier.  The default implementation
   --  generates a 256 bit random number that it serializes as base64 in the string.
   --  Upon successful completion, the sequence string buffer is allocated and
   --  returned in Id.  The buffer will be freed when the session is removed.
   --  ------------------------------
   procedure Allocate_Session_Id (Factory : in out Session_Factory;
                                  Id      : out Ada.Strings.Unbounded.String_Access) is
      use Ada.Streams;
      use Interfaces;

      Rand    : Stream_Element_Array (0 .. 4 * Factory.Id_Size - 1);
      Buffer  : Stream_Element_Array (0 .. 4 * 3 * Factory.Id_Size);
      Encoder : Util.Encoders.Base64.Encoder;
      Last    : Stream_Element_Offset;
      Encoded : Stream_Element_Offset;
   begin
      Factory.Lock.Write;

      --  Generate the random sequence.
      for I in 0 .. Factory.Id_Size - 1 loop
         declare
            Value : constant Unsigned_32 := Id_Random.Random (Factory.Random);
         begin
            Rand (4 * I)     := Stream_Element (Value and 16#0FF#);
            Rand (4 * I + 1) := Stream_Element (Shift_Right (Value, 8) and 16#0FF#);
            Rand (4 * I + 2) := Stream_Element (Shift_Right (Value, 16) and 16#0FF#);
            Rand (4 * I + 3) := Stream_Element (Shift_Right (Value, 24) and 16#0FF#);
         end;
      end loop;
      Factory.Lock.Release_Write;

      --  Encode the random stream in base64 and save it into the Id string.
      Encoder.Transform (Data => Rand, Into => Buffer,
                         Last => Last, Encoded => Encoded);

      Id := new String (1 .. Natural (Encoded + 1));
      for I in 0 .. Encoded loop
         Id (Natural (I + 1)) := Character'Val (Buffer (I));
      end loop;

      Log.Info ("Allocated session {0}", Id.all);
   end Allocate_Session_Id;

   --  ------------------------------
   --  Create a new session
   --  ------------------------------
   procedure Create_Session (Factory : in out Session_Factory;
                             Result  : out Session) is

      Sess    : Session;
      Impl    : constant Session_Record_Access := new Session_Record;
   begin
      Impl.Ref_Counter  := Util.Concurrent.Counters.ONE;
      Impl.Create_Time  := Ada.Calendar.Clock;
      Impl.Access_Time  := Impl.Create_Time;
      Impl.Max_Inactive := Factory.Max_Inactive;
      Sess.Impl         := Impl;

      Session_Factory'Class (Factory).Allocate_Session_Id (Impl.Id);

      Factory.Lock.Write;
      Factory.Sessions.Insert (Impl.Id.all'Access, Sess);
      Factory.Lock.Release_Write;

      Result := Sess;
   end Create_Session;

   --  ------------------------------
   --  Deletes the session.
   --  ------------------------------
   procedure Delete_Session (Factory : in out Session_Factory;
                             Sess    : in out Session) is
   begin
      null;
   end Delete_Session;

   --  ------------------------------
   --  Finds the session knowing the session identifier.
   --  If the session is found, the last access time is updated.
   --  Otherwise, the null session object is returned.
   --  ------------------------------
   procedure Find_Session (Factory : in out Session_Factory;
                           Id      : in String;
                           Result  : out Session) is
   begin
      Result := Null_Session;
      Factory.Lock.Read;
      declare
         Pos : constant Session_Maps.Cursor := Factory.Sessions.Find (Id'Unrestricted_Access);
      begin
         if Session_Maps.Has_Element (Pos) then
            Result := Session_Maps.Element (Pos);
         end if;
      end;
      Factory.Lock.Release_Read;

      if Result.Is_Valid then
         Result.Impl.Access_Time := Ada.Calendar.Clock;
         Log.Info ("Found active session {0}", Id);
      else
         Log.Info ("Invalid session {0}", Id);
      end if;
   end Find_Session;

   --  ------------------------------
   --  Returns the maximum time interval, in seconds, that the servlet container will
   --  keep this session open between client accesses. After this interval, the servlet
   --  container will invalidate the session. The maximum time interval can be set with
   --  the Set_Max_Inactive_Interval method.
   --  A negative time indicates the session should never timeout.
   --  ------------------------------
   function Get_Max_Inactive_Interval (Factory : in Session_Factory) return Duration is
   begin
      return Factory.Max_Inactive;
   end Get_Max_Inactive_Interval;

   --  ------------------------------
   --  Specifies the time, in seconds, between client requests before the servlet
   --  container will invalidate this session. A negative time indicates the session
   --  should never timeout.
   --  ------------------------------
   procedure Set_Max_Inactive_Interval (Factory  : in out Session_Factory;
                                        Interval : in Duration) is
   begin
      Factory.Max_Inactive := Interval;
   end Set_Max_Inactive_Interval;

   --  ------------------------------
   --  Initialize the session factory.
   --  ------------------------------
   overriding
   procedure Initialize (Factory : in out Session_Factory) is
   begin
      Id_Random.Reset (Factory.Random);
   end Initialize;

end ASF.Sessions.Factory;

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

with Util.Encoders.Base64;
with Util.Log.Loggers;

--  The ASF.Sessions.Factory package is a factory for creating, searching
--  and deleting sessions.
package body ASF.Sessions.Factory is

   use Ada.Finalization;
   use Ada.Strings.Unbounded;

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

   --  ------------------------------
   --  Allocate a unique and random session identifier.  The default implementation
   --  generates a 256 bit random number that it serializes as base64 in the string.
   --  Upon successful completion, the sequence string buffer is allocated and
   --  returned in Id.  The buffer will be freed when the session is removed.
   --  ------------------------------
   procedure Allocate_Session_Id (Factory : in out Session_Factory;
                                  Id      : out Ada.Strings.Unbounded.String_Access) is
      use Ada.Streams;
      use Interfaces;

      Rand    : Stream_Element_Array (0 .. 4 * Factory.Id_Size - 1);
      Buffer  : Stream_Element_Array (0 .. 4 * 3 * Factory.Id_Size);
      Encoder : Util.Encoders.Base64.Encoder;
      Last    : Stream_Element_Offset;
      Encoded : Stream_Element_Offset;
   begin
      Factory.Lock.Write;

      --  Generate the random sequence.
      for I in 0 .. Factory.Id_Size - 1 loop
         declare
            Value : constant Unsigned_32 := Id_Random.Random (Factory.Random);
         begin
            Rand (4 * I)     := Stream_Element (Value and 16#0FF#);
            Rand (4 * I + 1) := Stream_Element (Shift_Right (Value, 8) and 16#0FF#);
            Rand (4 * I + 2) := Stream_Element (Shift_Right (Value, 16) and 16#0FF#);
            Rand (4 * I + 3) := Stream_Element (Shift_Right (Value, 24) and 16#0FF#);
         end;
      end loop;
      Factory.Lock.Release_Write;

      --  Encode the random stream in base64 and save it into the Id string.
      Encoder.Transform (Data => Rand, Into => Buffer,
                         Last => Last, Encoded => Encoded);

      Id := new String (1 .. Natural (Encoded + 1));
      for I in 0 .. Encoded loop
         Id (Natural (I + 1)) := Character'Val (Buffer (I));
      end loop;

      Log.Info ("Allocated session {0}", Id.all);
   end Allocate_Session_Id;

   --  ------------------------------
   --  Create a new session
   --  ------------------------------
   procedure Create_Session (Factory : in out Session_Factory;
                             Result  : out Session) is

      Sess    : Session;
      Impl    : constant Session_Record_Access
        := new Session_Record '(Ada.Finalization.Limited_Controlled with
                                Ref_Counter  => Util.Concurrent.Counters.ONE,
                                Create_Time  => Ada.Calendar.Clock,
                                Max_Inactive => Factory.Max_Inactive,
                                others       => <>);
   begin
      Impl.Access_Time := Impl.Create_Time;
      Sess.Impl        := Impl;

      Session_Factory'Class (Factory).Allocate_Session_Id (Impl.Id);

      Factory.Lock.Write;
      Factory.Sessions.Insert (Impl.Id.all'Access, Sess);
      Factory.Lock.Release_Write;

      Result := Sess;
   end Create_Session;

   --  ------------------------------
   --  Deletes the session.
   --  ------------------------------
   procedure Delete_Session (Factory : in out Session_Factory;
                             Sess    : in out Session) is
   begin
      null;
   end Delete_Session;

   --  ------------------------------
   --  Finds the session knowing the session identifier.
   --  If the session is found, the last access time is updated.
   --  Otherwise, the null session object is returned.
   --  ------------------------------
   procedure Find_Session (Factory : in out Session_Factory;
                           Id      : in String;
                           Result  : out Session) is
   begin
      Result := Null_Session;
      Factory.Lock.Read;
      declare
         Pos : constant Session_Maps.Cursor := Factory.Sessions.Find (Id'Unrestricted_Access);
      begin
         if Session_Maps.Has_Element (Pos) then
            Result := Session_Maps.Element (Pos);
         end if;
      end;
      Factory.Lock.Release_Read;

      if Result.Is_Valid then
         Result.Impl.Access_Time := Ada.Calendar.Clock;
         Log.Info ("Found active session {0}", Id);
      else
         Log.Info ("Invalid session {0}", Id);
      end if;
   end Find_Session;

   --  ------------------------------
   --  Returns the maximum time interval, in seconds, that the servlet container will
   --  keep this session open between client accesses. After this interval, the servlet
   --  container will invalidate the session. The maximum time interval can be set with
   --  the Set_Max_Inactive_Interval method.
   --  A negative time indicates the session should never timeout.
   --  ------------------------------
   function Get_Max_Inactive_Interval (Factory : in Session_Factory) return Duration is
   begin
      return Factory.Max_Inactive;
   end Get_Max_Inactive_Interval;

   --  ------------------------------
   --  Specifies the time, in seconds, between client requests before the servlet
   --  container will invalidate this session. A negative time indicates the session
   --  should never timeout.
   --  ------------------------------
   procedure Set_Max_Inactive_Interval (Factory  : in out Session_Factory;
                                        Interval : in Duration) is
   begin
      Factory.Max_Inactive := Interval;
   end Set_Max_Inactive_Interval;

   --  ------------------------------
   --  Initialize the session factory.
   --  ------------------------------
   overriding
   procedure Initialize (Factory : in out Session_Factory) is
   begin
      Id_Random.Reset (Factory.Random);
   end Initialize;

end ASF.Sessions.Factory;

Fix compilation on arm

Fix compilation on arm


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

with Ada.Text_IO;
with ASF.Applications.Main;
with ASF.Applications.Tests;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Requests.Tools;
with ASF.Servlets.Faces;
with Ada.Directories;

with Util.Files;
with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Measures;
package body ASF.Applications.Views.Tests is

   use Ada.Strings.Unbounded;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;
   --  Set up performed before each test case

   --  Test loading of facelet file
   procedure Test_Load_Facelet (T : in out Test) is

      use ASF;
      use ASF.Contexts.Faces;

      App      : Applications.Main.Application;
--        H        : Applications.Views.View_Handler;

      View_Name   : constant String := To_String (T.File);
      Result_File : constant String := To_String (T.Result);
      Conf        : Applications.Config;
      App_Factory : Applications.Main.Application_Factory;
      Dir         : constant String := "regtests/files";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Faces       : aliased ASF.Servlets.Faces.Faces_Servlet;
      List        : Util.Beans.Basic.Readonly_Bean_Access;
      List_Bean   : Util.Beans.Objects.Object;
   begin
      List := Applications.Tests.Create_Form_List;
      List_Bean := Util.Beans.Objects.To_Object (List);

      Conf.Load_Properties ("regtests/view.properties");
      Conf.Set ("view.dir", Path);
      App.Initialize (Conf, App_Factory);
      App.Register_Application ("/");
      App.Add_Servlet ("faces", Faces'Unchecked_Access);

      App.Set_Global ("function", "Test_Load_Facelet");
      App.Set_Global ("date", "2011-12-03 03:04:05.23");
      for I in 1 .. 2 loop
         declare
            S : Util.Measures.Stamp;
            Req       : ASF.Requests.Mockup.Request;
            Rep       : aliased ASF.Responses.Mockup.Response;
            Content   : Unbounded_String;
         begin
            ASF.Requests.Tools.Set_Context (Req      => Req,
                                            Servlet  => Faces'Unchecked_Access,
                                            Response => Rep'Unchecked_Access);
            Req.Set_Method ("GET");
            Req.Set_Path_Info (View_Name);
            Req.Set_Parameter ("file-name", To_String (T.Name));
            Req.Set_Header ("file", To_String (T.Name));
            Req.Set_Attribute ("list", List_Bean);
            App.Dispatch (Page     => View_Name,
                          Request  => Req,
                          Response => Rep);
            Util.Measures.Report (S, "Pass" & Integer'Image (I) & ": Render view "
                                  & View_Name);

            Rep.Read_Content (Content);
            Util.Files.Write_File (Result_File, Content);
            Util.Tests.Assert_Equal_Files (T       => T,
                                           Expect  => To_String (T.Expect),
                                           Test    => Result_File,
                                           Message => "Restore and render view");
         end;
      end loop;
   end Test_Load_Facelet;

   --  Test case name
   overriding
   function Name (T : Test) return Util.Tests.Message_String is
   begin
      return Util.Tests.Format ("Test " & To_String (T.Name));
   end Name;

   --  Perform the test.
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Load_Facelet;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      Result_Dir  : constant String := "regtests/result/views";
      Dir         : constant String := "regtests/files/views";
      Expect_Dir  : constant String := "regtests/expect/views";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;
   begin
      if Kind (Path) /= Directory then
         Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Simple    : constant String := Simple_Name (Ent);
            Tst      : Test_Case_Access;
         begin
            if Simple /= "." and then Simple /= ".."
              and then Simple /= ".svn" then
               Tst := new Test;
               Tst.Name := To_Unbounded_String (Dir & "/" & Simple);
               Tst.File := To_Unbounded_String ("views/" & Simple);
               Tst.Expect := To_Unbounded_String (Expect_Path & "/" & Simple);
               Tst.Result := To_Unbounded_String (Result_Path & "/" & Simple);
               Suite.Add_Test (Tst.all'Access);
            end if;
         end;
      end loop;
   end Add_Tests;

end ASF.Applications.Views.Tests;

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

with Ada.Text_IO;
with ASF.Applications.Main;
with ASF.Applications.Tests;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Requests.Tools;
with ASF.Servlets.Faces;
with ASF.Converters.Dates;
with Ada.Directories;

with Util.Files;
with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Measures;
package body ASF.Applications.Views.Tests is

   use Ada.Strings.Unbounded;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;
   --  Set up performed before each test case

   --  ------------------------------
   --  Test loading of facelet file
   --  ------------------------------
   procedure Test_Load_Facelet (T : in out Test) is

      use ASF;
      use ASF.Contexts.Faces;

      App      : Applications.Main.Application;
--        H        : Applications.Views.View_Handler;

      View_Name   : constant String := To_String (T.File);
      Result_File : constant String := To_String (T.Result);
      Conf        : Applications.Config;
      App_Factory : Applications.Main.Application_Factory;
      Dir         : constant String := "regtests/files";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Faces       : aliased ASF.Servlets.Faces.Faces_Servlet;
      List        : Util.Beans.Basic.Readonly_Bean_Access;
      List_Bean   : Util.Beans.Objects.Object;
      Form        : Util.Beans.Basic.Readonly_Bean_Access;
      Form_Bean   : Util.Beans.Objects.Object;
      C           : ASF.Converters.Dates.Date_Converter_Access;
   begin
      List := Applications.Tests.Create_Form_List;
      List_Bean := Util.Beans.Objects.To_Object (List);

      Form := Applications.Tests.Create_Form_Bean;
      Form_Bean := Util.Beans.Objects.To_Object (Form);

      Conf.Load_Properties ("regtests/view.properties");
      Conf.Set ("view.dir", Path);
      App.Initialize (Conf, App_Factory);
      App.Register_Application ("/");
      App.Add_Servlet ("faces", Faces'Unchecked_Access);
      C := ASF.Converters.Dates.Create_Date_Converter (Date    => ASF.Converters.Dates.DEFAULT,
                                                       Time    => ASF.Converters.Dates.DEFAULT,
                                                       Format  => ASF.Converters.Dates.TIME,
                                                       Locale  => "en",
                                                       Pattern => "");
      App.Add_Converter ("date-default-converter", C.all'Access);

      App.Set_Global ("function", "Test_Load_Facelet");
      App.Set_Global ("date", "2011-12-03 03:04:05.23");
      for I in 1 .. 2 loop
         declare
            S : Util.Measures.Stamp;
            Req       : ASF.Requests.Mockup.Request;
            Rep       : aliased ASF.Responses.Mockup.Response;
            Content   : Unbounded_String;
         begin
            ASF.Requests.Tools.Set_Context (Req      => Req,
                                            Servlet  => Faces'Unchecked_Access,
                                            Response => Rep'Unchecked_Access);
            Req.Set_Method ("GET");
            Req.Set_Path_Info (View_Name);
            Req.Set_Parameter ("file-name", To_String (T.Name));
            Req.Set_Header ("file", To_String (T.Name));
            Req.Set_Attribute ("list", List_Bean);
            Req.Set_Attribute ("form", Form_Bean);
            App.Dispatch (Page     => View_Name,
                          Request  => Req,
                          Response => Rep);
            Util.Measures.Report (S, "Pass" & Integer'Image (I) & ": Render view "
                                  & View_Name);

            Rep.Read_Content (Content);
            Util.Files.Write_File (Result_File, Content);
            Util.Tests.Assert_Equal_Files (T       => T,
                                           Expect  => To_String (T.Expect),
                                           Test    => Result_File,
                                           Message => "Restore and render view");
         end;
      end loop;
   end Test_Load_Facelet;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : Test) return Util.Tests.Message_String is
   begin
      return Util.Tests.Format ("Test " & To_String (T.Name));
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Load_Facelet;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      Result_Dir  : constant String := "regtests/result/views";
      Dir         : constant String := "regtests/files/views";
      Expect_Dir  : constant String := "regtests/expect/views";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;
   begin
      if Kind (Path) /= Directory then
         Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Simple    : constant String := Simple_Name (Ent);
            Tst      : Test_Case_Access;
         begin
            if Simple /= "." and then Simple /= ".."
              and then Simple /= ".svn"
            then
               Tst := new Test;
               Tst.Name := To_Unbounded_String (Dir & "/" & Simple);
               Tst.File := To_Unbounded_String ("views/" & Simple);
               Tst.Expect := To_Unbounded_String (Expect_Path & "/" & Simple);
               Tst.Result := To_Unbounded_String (Result_Path & "/" & Simple);
               Suite.Add_Test (Tst.all'Access);
            end if;
         end;
      end loop;
   end Add_Tests;

end ASF.Applications.Views.Tests;

Add a form bean for the test Add a date converter for the <f:converter> test