-----------------------------------------------------------------------
--  asf-views-facelets -- Facelets representation and management
--  Copyright (C) 2009, 2010, 2011, 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.Calendar;
with Ada.Strings.Unbounded;
with Ada.Containers.Hashed_Maps;
with Ada.Strings.Unbounded.Hash;
with ASF.Views.Nodes;
with ASF.Contexts.Facelets;
with ASF.Factory;
with ASF.Components.Base;
with Ada.Finalization;

--  The ASF.Views.Facelets package contains the facelet factory
--  responsible for getting the facelet tree from a facelet name.
--  The facelets (or *.xhtml) files are loaded by the reader to form
--  a tag node tree which is cached by the factory.  The facelet factory
--  is shared by multiple requests and threads.
package ASF.Views.Facelets is

   type Facelet is private;
   type Facelet_Access is access all Facelet;

   --  Returns True if the facelet is null/empty.
   function Is_Null (F : Facelet) return Boolean;

   --  ------------------------------
   --  Facelet factory
   --  ------------------------------
   --  The facelet factory allows to retrieve the node tree to build the
   --  component tree.  The node tree can be shared by several component trees.
   --  The node tree is initialized from the XHTML view file.  It is put
   --  in a cache to avoid loading and parsing the file several times.
   type Facelet_Factory is limited private;

   --  Get the facelet identified by the given name.  If the facelet is already
   --  loaded, the cached value is returned.  The facelet file is searched in
   --  a set of directories configured in the facelet factory.
   procedure Find_Facelet (Factory : in out Facelet_Factory;
                           Name    : in String;
                           Context : in ASF.Contexts.Facelets.Facelet_Context'Class;
                           Result  : out Facelet);

   --  Create the component tree from the facelet view.
   procedure Build_View (View    : in Facelet;
                         Context : in out ASF.Contexts.Facelets.Facelet_Context'Class;
                         Root    : in ASF.Components.Base.UIComponent_Access);

   --  Initialize the facelet factory.
   --  Set the search directories for facelet files.
   --  Set the ignore white space configuration when reading XHTML files.
   --  Set the ignore empty lines configuration when reading XHTML files.
   --  Set the escape unknown tags configuration when reading XHTML files.
   procedure Initialize (Factory             : in out Facelet_Factory;
                         Components          : access ASF.Factory.Component_Factory;
                         Paths               : in String;
                         Ignore_White_Spaces : in Boolean;
                         Ignore_Empty_Lines  : in Boolean;
                         Escape_Unknown_Tags : in Boolean);

   --  Find the facelet file in one of the facelet directories.
   --  Returns the path to be used for reading the facelet file.
   function Find_Facelet_Path (Factory : in Facelet_Factory;
                               Name    : in String) return String;

   --  Clear the facelet cache
   procedure Clear_Cache (Factory : in out Facelet_Factory);

private

   use Ada.Strings.Unbounded;

   type Facelet is record
      Root        : ASF.Views.Nodes.Tag_Node_Access;
      File        : ASF.Views.File_Info_Access;
      Modify_Time : Ada.Calendar.Time;
   end record;

   Empty : constant Facelet := (others => <>);

   --  Tag library map indexed on the library namespace.
   package Facelet_Maps is new
     Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                 Element_Type    => Facelet,
                                 Hash            => Ada.Strings.Unbounded.Hash,
                                 Equivalent_Keys => "=");

   use Facelet_Maps;

   protected type Facelet_Cache is
      --  Find the facelet entry associated with the given name.
      function Find (Name : in Unbounded_String) return Facelet;

      --  Insert or replace the facelet entry associated with the given name.
      procedure Insert (Name : in Unbounded_String;
                        Item : in Facelet);

      --  Clear the cache.
      procedure Clear;
   private
      Map     : Facelet_Maps.Map;
   end Facelet_Cache;

   type Facelet_Factory is new Ada.Finalization.Limited_Controlled with record
      Paths    : Unbounded_String := To_Unbounded_String ("");

      --  The facelet cache.
      Map      : Facelet_Cache;

      --  The component factory
      Factory  : access ASF.Factory.Component_Factory;

      --  Whether the unknown tags are escaped using XML escape rules.
      Escape_Unknown_Tags : Boolean := True;

      --  Whether white spaces can be ignored.
      Ignore_White_Spaces : Boolean := True;

      --  Whether empty lines should be ignored (when white spaces are kept).
      Ignore_Empty_Lines : Boolean := True;
   end record;

   --  Free the storage held by the factory cache.
   overriding
   procedure Finalize (Factory : in out Facelet_Factory);

end ASF.Views.Facelets;

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

with Ada.Calendar;
with ASF.Views.Nodes;
with ASF.Contexts.Facelets;
with ASF.Factory;
with ASF.Components.Base;
with Ada.Finalization;
private with Ada.Strings.Unbounded;
private with Ada.Containers.Hashed_Sets;
private with Util.Refs;
private with Ada.Strings.Hash;

--  The ASF.Views.Facelets package contains the facelet factory
--  responsible for getting the facelet tree from a facelet name.
--  The facelets (or *.xhtml) files are loaded by the reader to form
--  a tag node tree which is cached by the factory.  The facelet factory
--  is shared by multiple requests and threads.
package ASF.Views.Facelets is

   type Facelet is private;

   --  Returns True if the facelet is null/empty.
   function Is_Null (F : Facelet) return Boolean;

   --  ------------------------------
   --  Facelet factory
   --  ------------------------------
   --  The facelet factory allows to retrieve the node tree to build the
   --  component tree.  The node tree can be shared by several component trees.
   --  The node tree is initialized from the XHTML view file.  It is put
   --  in a cache to avoid loading and parsing the file several times.
   type Facelet_Factory is limited private;

   --  Get the facelet identified by the given name.  If the facelet is already
   --  loaded, the cached value is returned.  The facelet file is searched in
   --  a set of directories configured in the facelet factory.
   procedure Find_Facelet (Factory : in out Facelet_Factory;
                           Name    : in String;
                           Context : in ASF.Contexts.Facelets.Facelet_Context'Class;
                           Result  : out Facelet);

   --  Create the component tree from the facelet view.
   procedure Build_View (View    : in Facelet;
                         Context : in out ASF.Contexts.Facelets.Facelet_Context'Class;
                         Root    : in ASF.Components.Base.UIComponent_Access);

   --  Initialize the facelet factory.
   --  Set the search directories for facelet files.
   --  Set the ignore white space configuration when reading XHTML files.
   --  Set the ignore empty lines configuration when reading XHTML files.
   --  Set the escape unknown tags configuration when reading XHTML files.
   procedure Initialize (Factory             : in out Facelet_Factory;
                         Components          : access ASF.Factory.Component_Factory;
                         Paths               : in String;
                         Ignore_White_Spaces : in Boolean;
                         Ignore_Empty_Lines  : in Boolean;
                         Escape_Unknown_Tags : in Boolean);

   --  Find the facelet file in one of the facelet directories.
   --  Returns the path to be used for reading the facelet file.
   function Find_Facelet_Path (Factory : in Facelet_Factory;
                               Name    : in String) return String;

   --  Clear the facelet cache
   procedure Clear_Cache (Factory : in out Facelet_Factory);

private

   use Ada.Strings.Unbounded;

   CHECK_FILE_DELAY : constant := 10.0;

   type Facelet_Type (Len : Natural) is limited new Util.Refs.Ref_Entity with record
      Root        : ASF.Views.Nodes.Tag_Node_Access;
      File        : ASF.Views.File_Info_Access;
      Modify_Time : Ada.Calendar.Time;
      Check_Time  : Ada.Calendar.Time;
      Name        : String (1 .. Len);
   end record;
   type Facelet_Access is access all Facelet_Type;

   package Ref is
      new Util.Refs.Indefinite_References (Facelet_Type, Facelet_Access);

   type Facelet is record
      Facelet : Facelet_Access;
   end record;

   Empty : constant Facelet := (others => <>);

   function Hash (Item : in Facelet_Access) return Ada.Containers.Hash_Type is
      (Ada.Strings.Hash (Item.Name));

   function Compare (Left, Right : in Facelet_Access) return Boolean is
      (Left.Name = Right.Name);

   --  Tag library map indexed on the library namespace.
   package Facelet_Sets is new
     Ada.Containers.Hashed_Sets (Element_Type        => Facelet_Access,
                                 Hash                => Hash,
                                 Equivalent_Elements => Compare);

   use Facelet_Sets;

   protected type Facelet_Cache is
      --  Find the facelet entry associated with the given name.
      function Find (Name : in String) return Facelet_Access;

      --  Insert or replace the facelet entry associated with the given name.
      procedure Insert (Facelet : in Facelet_Access);

      --  Clear the cache.
      procedure Clear;
   private
      Map     : Facelet_Sets.Set;
   end Facelet_Cache;

   type Facelet_Factory is new Ada.Finalization.Limited_Controlled with record
      Paths    : Unbounded_String := To_Unbounded_String ("");

      --  The facelet cache.
      Map      : Facelet_Cache;

      --  The component factory
      Factory  : access ASF.Factory.Component_Factory;

      --  Whether the unknown tags are escaped using XML escape rules.
      Escape_Unknown_Tags : Boolean := True;

      --  Whether white spaces can be ignored.
      Ignore_White_Spaces : Boolean := True;

      --  Whether empty lines should be ignored (when white spaces are kept).
      Ignore_Empty_Lines : Boolean := True;
   end record;

   --  Free the storage held by the factory cache.
   overriding
   procedure Finalize (Factory : in out Facelet_Factory);

end ASF.Views.Facelets;

Refactor the Facelet type to store the name within the record and add a Check_Time member


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

   --  use Util.Log;
   use type Util.Log.Loggers.Logger_Access;

   --  The logger'
   Log : aliased constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Serialize.IO",
                                                                              Util.Log.WARN_LEVEL);
   procedure Write_Attribute (Stream : in out Output_Stream'Class;
                              Name   : in String;
                              Value  : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Stream.Write_Attribute (Name, Ada.Strings.Unbounded.To_String (Value));
   end Write_Attribute;

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

   --  ------------------------------
   --  Read the file and parse it using the JSON parser.
   --  ------------------------------
   procedure Parse (Handler : in out Parser;
                    File    : in String;
                    Sink    : in out Reader'Class) is
      Stream     : aliased Util.Streams.Files.File_Stream;
      Buffer     : Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Handler.Error_Logger.Info ("Reading file {0}", File);

      Handler.File := Ada.Strings.Unbounded.To_Unbounded_String (File);
      Buffer.Initialize (Output => null,
                         Input  => Stream'Unchecked_Access,
                         Size   => 1024);
      Stream.Open (Mode => Ada.Streams.Stream_IO.In_File, Name => File);
      --  Context_Stack.Clear (Handler.Stack);
      Parser'Class (Handler).Parse (Buffer, Sink);

   exception
--      when Util.Serialize.Mappers.Field_Fatal_Error =>
--         null;

      when Ada.IO_Exceptions.Name_Error =>
         Parser'Class (Handler).Error ("File '" & File & "' does not exist.");

      when E : others =>
         if not Handler.Error_Flag then
            Parser'Class (Handler).Error ("Exception " & Ada.Exceptions.Exception_Name (E));
         end if;
   end Parse;

   --  ------------------------------
   --  Parse the content string.
   --  ------------------------------
   procedure Parse_String (Handler : in out Parser;
                           Content : in String;
                           Sink    : in out Reader'Class) is
      Stream : aliased Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Handler.File := Ada.Strings.Unbounded.To_Unbounded_String ("<inline>");
      Stream.Initialize (Content  => Content);
      --  Context_Stack.Clear (Handler.Stack);
      Parser'Class (Handler).Parse (Stream, Sink);

   exception
--      when Util.Serialize.Mappers.Field_Fatal_Error =>
--         null;

      when E : others =>
         if not Handler.Error_Flag then
            Parser'Class (Handler).Error ("Exception " & Ada.Exceptions.Exception_Name (E));
         end if;

   end Parse_String;

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

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

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   function Get_Location (Handler : in Parser) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Handler.File);
   end Get_Location;

   --  ------------------------------
   --  Report an error while parsing the input stream.  The error message will be reported
   --  on the logger associated with the parser.  The parser will be set as in error so that
   --  the Has_Error function will return True after parsing the whole file.
   --  ------------------------------
   procedure Error (Handler : in out Parser;
                    Message : in String) is
   begin
      Handler.Error_Logger.Error ("{0}: {1}",
                                  Parser'Class (Handler).Get_Location,
                                  Message);
      Handler.Error_Flag := True;
   end Error;

end Util.Serialize.IO;

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

   --  use Util.Log;
   use type Util.Log.Loggers.Logger_Access;

   --  The logger'
   Log : aliased constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Serialize.IO",
                                                                              Util.Log.WARN_LEVEL);
   procedure Write_Attribute (Stream : in out Output_Stream'Class;
                              Name   : in String;
                              Value  : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Stream.Write_Attribute (Name, Ada.Strings.Unbounded.To_String (Value));
   end Write_Attribute;

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

   --  ------------------------------
   --  Read the file and parse it using the JSON parser.
   --  ------------------------------
   procedure Parse (Handler : in out Parser;
                    File    : in String;
                    Sink    : in out Reader'Class) is
      Stream     : aliased Util.Streams.Files.File_Stream;
      Buffer     : Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Handler.Error_Logger.Info ("Reading file {0}", File);

      Handler.File := Ada.Strings.Unbounded.To_Unbounded_String (File);
      Buffer.Initialize (Output => null,
                         Input  => Stream'Unchecked_Access,
                         Size   => 1024);
      Stream.Open (Mode => Ada.Streams.Stream_IO.In_File, Name => File);
      --  Context_Stack.Clear (Handler.Stack);
      Sink.Start_Document;
      Parser'Class (Handler).Parse (Buffer, Sink);

   exception
--      when Util.Serialize.Mappers.Field_Fatal_Error =>
--         null;

      when Ada.IO_Exceptions.Name_Error =>
         Parser'Class (Handler).Error ("File '" & File & "' does not exist.");

      when E : others =>
         if not Handler.Error_Flag then
            Parser'Class (Handler).Error ("Exception " & Ada.Exceptions.Exception_Name (E));
         end if;
   end Parse;

   --  ------------------------------
   --  Parse the content string.
   --  ------------------------------
   procedure Parse_String (Handler : in out Parser;
                           Content : in String;
                           Sink    : in out Reader'Class) is
      Stream : aliased Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Handler.File := Ada.Strings.Unbounded.To_Unbounded_String ("<inline>");
      Stream.Initialize (Content  => Content);
      --  Context_Stack.Clear (Handler.Stack);
      Sink.Start_Document;
      Parser'Class (Handler).Parse (Stream, Sink);

   exception
--      when Util.Serialize.Mappers.Field_Fatal_Error =>
--         null;

      when E : others =>
         if not Handler.Error_Flag then
            Parser'Class (Handler).Error ("Exception " & Ada.Exceptions.Exception_Name (E));
         end if;

   end Parse_String;

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

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

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   function Get_Location (Handler : in Parser) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Handler.File);
   end Get_Location;

   --  ------------------------------
   --  Report an error while parsing the input stream.  The error message will be reported
   --  on the logger associated with the parser.  The parser will be set as in error so that
   --  the Has_Error function will return True after parsing the whole file.
   --  ------------------------------
   procedure Error (Handler : in out Parser;
                    Message : in String) is
   begin
      Handler.Error_Logger.Error ("{0}: {1}",
                                  Parser'Class (Handler).Get_Location,
                                  Message);
      Handler.Error_Flag := True;
   end Error;

end Util.Serialize.IO;

Call the Start_Document operation before parsing the stream


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

   --  ------------------------------
   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   --  ------------------------------
   overriding
   procedure Add_Node (Filter    : in out Html_Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind) is
      Tag : Html_Tag;
   begin
      case Kind is
         when N_LINE_BREAK =>
            Tag := BR_TAG;

         when N_PARAGRAPH =>
            Tag := P_TAG;

         when N_HORIZONTAL_RULE =>
            Tag := HR_TAG;

         when N_TOC_DISPLAY =>
            return;

         when N_NEWLINE =>
            Filter_Type (Filter).Add_Node (Document, Kind);
            return;

      end case;
      if Filter.Allowed (Tag) then
         Filter_Type (Filter).Add_Node (Document, Kind);
      end if;
   end Add_Node;

   --  ------------------------------
   --  Add a text content with the given format to the document.
   --  ------------------------------
   overriding
   procedure Add_Text (Filter    : in out Html_Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map) is
   begin
      if Filter.Hide_Level > 0 then
         return;
      end if;
      Filter_Type (Filter).Add_Text (Document, Text, Format);
   end Add_Text;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Filter    : in out Html_Filter_Type;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      Filter.Flush_Stack (Document);
      Filter_Type (Filter).Add_Header (Document, Header, Level);
   end Add_Header;

   --  ------------------------------
   --  Push a HTML node with the given tag to the document.
   --  ------------------------------
   overriding
   procedure Push_Node (Filter     : in out Html_Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Tag        : in Wiki.Html_Tag;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
      Current_Tag : Html_Tag;
   begin
      while not Filter.Stack.Is_Empty loop
         Current_Tag := Filter.Stack.Last_Element;
         if Wiki.Helpers.Need_Close (Tag, Current_Tag) then
            if Filter.Hide_Level = 0 then
               Filter_Type (Filter).Pop_Node (Document, Current_Tag);
            end if;
            Filter.Stack.Delete_Last;
         end if;
         exit;
      end loop;
      if Filter.Hidden (Tag) then
         Filter.Hide_Level := Filter.Hide_Level + 1;
      elsif not Filter.Allowed (Tag) then
         return;
      end if;
      Filter.Stack.Append (Tag);
      if Filter.Hide_Level = 0 then
         Filter_Type (Filter).Push_Node (Document, Tag, Attributes);
      end if;
   end Push_Node;

   --  ------------------------------
   --  Pop a HTML node with the given tag.
   --  ------------------------------
   overriding
   procedure Pop_Node (Filter   : in out Html_Filter_Type;
                       Document : in out Wiki.Documents.Document;
                       Tag      : in Wiki.Html_Tag) is
      Current_Tag : Html_Tag;
   begin
      if Filter.Stack.Is_Empty then
         return;
      elsif not Filter.Allowed (Tag) and not Filter.Hidden (Tag) then
         return;
      end if;

      --  Emit a end tag element until we find our matching tag and the top most tag
      --  allows the end tag to be omitted (ex: a td, tr, td, dd, ...).
      while not Filter.Stack.Is_Empty loop
         Current_Tag := Filter.Stack.Last_Element;
         exit when Current_Tag = Tag or not Tag_Omission (Current_Tag);
         if Filter.Hide_Level = 0 then
            Filter_Type (Filter).Pop_Node (Document, Current_Tag);
         end if;
         Filter.Stack.Delete_Last;
      end loop;

      if Filter.Hide_Level = 0 then
         Filter_Type (Filter).Pop_Node (Document, Tag);
      end if;
      if Filter.Hidden (Current_Tag) then
         Filter.Hide_Level := Filter.Hide_Level - 1;
      end if;
      Filter.Stack.Delete_Last;
   end Pop_Node;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Filter     : in out Html_Filter_Type;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Allowed (A_TAG) then
         Filter_Type (Filter).Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   overriding
   procedure Add_Image (Filter     : in out Html_Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Allowed (IMG_TAG) then
         Filter_Type (Filter).Add_Image (Document, Name, Attributes);
      end if;
   end Add_Image;

   --  ------------------------------
   --  Flush the HTML element that have not yet been closed.
   --  ------------------------------
   procedure Flush_Stack (Filter   : in out Html_Filter_Type;
                          Document : in out Wiki.Documents.Document) is
   begin
      while not Filter.Stack.Is_Empty loop
         declare
            Tag : constant Html_Tag := Filter.Stack.Last_Element;
         begin
            if Filter.Hide_Level = 0 then
               Filter_Type (Filter).Pop_Node (Document, Tag);
            end if;
            if Filter.Hidden (Tag) then
               Filter.Hide_Level := Filter.Hide_Level - 1;
            end if;
         end;
         Filter.Stack.Delete_Last;
      end loop;
   end Flush_Stack;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Filter : in out Html_Filter_Type;
                     Document : in out Wiki.Documents.Document) is
   begin
      Filter.Flush_Stack (Document);
      Filter_Type (Filter).Finish (Document);
   end Finish;

   --  ------------------------------
   --  Mark the HTML tag as being forbidden.
   --  ------------------------------
   procedure Forbidden (Filter : in out Html_Filter_Type;
                        Tag    : in Html_Tag) is
   begin
      Filter.Allowed (Tag) := False;
   end Forbidden;

   --  ------------------------------
   --  Mark the HTML tag as being allowed.
   --  ------------------------------
   procedure Allowed (Filter : in out Html_Filter_Type;
                      Tag    : in Html_Tag) is
   begin
      Filter.Allowed (Tag) := True;
   end Allowed;

   --  ------------------------------
   --  Mark the HTML tag as being hidden.  The tag and its inner content including the text
   --  will be removed and not passed to the final document.
   --  ------------------------------
   procedure Hide (Filter : in out Html_Filter_Type;
                   Tag    : in Html_Tag) is
   begin
      Filter.Hidden (Tag) := True;
   end Hide;

   --  ------------------------------
   --  Mark the HTML tag as being visible.
   --  ------------------------------
   procedure Visible (Filter : in out Html_Filter_Type;
                      Tag    : in Html_Tag) is
   begin
      Filter.Hidden (Tag) := False;
   end Visible;

end Wiki.Filters.Html;

-----------------------------------------------------------------------
--  wiki-filters-html -- Wiki HTML filters
--  Copyright (C) 2015, 2019, 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 Wiki.Helpers;
package body Wiki.Filters.Html is

   --  ------------------------------
   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   --  ------------------------------
   overriding
   procedure Add_Node (Filter    : in out Html_Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind) is
      Tag : Html_Tag;
   begin
      case Kind is
         when N_LINE_BREAK =>
            Tag := BR_TAG;

         when N_PARAGRAPH =>
            Tag := P_TAG;

         when N_HORIZONTAL_RULE =>
            Tag := HR_TAG;

         when N_TOC_DISPLAY | N_NONE =>
            return;

         when N_NEWLINE | N_LIST_END | N_LIST_ITEM_END | N_NUM_LIST_END
           | N_LIST_ITEM =>
            Filter_Type (Filter).Add_Node (Document, Kind);
            return;

      end case;
      if Filter.Allowed (Tag) then
         Filter_Type (Filter).Add_Node (Document, Kind);
      end if;
   end Add_Node;

   --  ------------------------------
   --  Add a text content with the given format to the document.
   --  ------------------------------
   overriding
   procedure Add_Text (Filter    : in out Html_Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map) is
   begin
      if Filter.Hide_Level > 0 then
         return;
      end if;
      Filter_Type (Filter).Add_Text (Document, Text, Format);
   end Add_Text;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Filter    : in out Html_Filter_Type;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      Filter.Flush_Stack (Document);
      Filter_Type (Filter).Add_Header (Document, Header, Level);
   end Add_Header;

   --  ------------------------------
   --  Push a HTML node with the given tag to the document.
   --  ------------------------------
   overriding
   procedure Push_Node (Filter     : in out Html_Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Tag        : in Wiki.Html_Tag;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
      Current_Tag : Html_Tag;
   begin
      while not Filter.Stack.Is_Empty loop
         Current_Tag := Filter.Stack.Last_Element;
         if Wiki.Helpers.Need_Close (Tag, Current_Tag) then
            if Filter.Hide_Level = 0 then
               Filter_Type (Filter).Pop_Node (Document, Current_Tag);
            end if;
            Filter.Stack.Delete_Last;
         end if;
         exit;
      end loop;
      if Filter.Hidden (Tag) then
         Filter.Hide_Level := Filter.Hide_Level + 1;
      elsif not Filter.Allowed (Tag) then
         return;
      end if;
      Filter.Stack.Append (Tag);
      if Filter.Hide_Level = 0 then
         Filter_Type (Filter).Push_Node (Document, Tag, Attributes);
      end if;
   end Push_Node;

   --  ------------------------------
   --  Pop a HTML node with the given tag.
   --  ------------------------------
   overriding
   procedure Pop_Node (Filter   : in out Html_Filter_Type;
                       Document : in out Wiki.Documents.Document;
                       Tag      : in Wiki.Html_Tag) is
      Current_Tag : Html_Tag;
   begin
      if Filter.Stack.Is_Empty then
         return;
      elsif not Filter.Allowed (Tag) and not Filter.Hidden (Tag) then
         return;
      end if;

      --  Emit a end tag element until we find our matching tag and the top most tag
      --  allows the end tag to be omitted (ex: a td, tr, td, dd, ...).
      while not Filter.Stack.Is_Empty loop
         Current_Tag := Filter.Stack.Last_Element;
         exit when Current_Tag = Tag or not Tag_Omission (Current_Tag);
         if Filter.Hide_Level = 0 then
            Filter_Type (Filter).Pop_Node (Document, Current_Tag);
         end if;
         Filter.Stack.Delete_Last;
      end loop;

      if Filter.Hide_Level = 0 then
         Filter_Type (Filter).Pop_Node (Document, Tag);
      end if;
      if Filter.Hidden (Current_Tag) then
         Filter.Hide_Level := Filter.Hide_Level - 1;
      end if;
      Filter.Stack.Delete_Last;
   end Pop_Node;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Filter     : in out Html_Filter_Type;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Allowed (A_TAG) then
         Filter_Type (Filter).Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   overriding
   procedure Add_Image (Filter     : in out Html_Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Allowed (IMG_TAG) then
         Filter_Type (Filter).Add_Image (Document, Name, Attributes);
      end if;
   end Add_Image;

   --  ------------------------------
   --  Flush the HTML element that have not yet been closed.
   --  ------------------------------
   procedure Flush_Stack (Filter   : in out Html_Filter_Type;
                          Document : in out Wiki.Documents.Document) is
   begin
      while not Filter.Stack.Is_Empty loop
         declare
            Tag : constant Html_Tag := Filter.Stack.Last_Element;
         begin
            if Filter.Hide_Level = 0 then
               Filter_Type (Filter).Pop_Node (Document, Tag);
            end if;
            if Filter.Hidden (Tag) then
               Filter.Hide_Level := Filter.Hide_Level - 1;
            end if;
         end;
         Filter.Stack.Delete_Last;
      end loop;
   end Flush_Stack;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Filter : in out Html_Filter_Type;
                     Document : in out Wiki.Documents.Document) is
   begin
      Filter.Flush_Stack (Document);
      Filter_Type (Filter).Finish (Document);
   end Finish;

   --  ------------------------------
   --  Mark the HTML tag as being forbidden.
   --  ------------------------------
   procedure Forbidden (Filter : in out Html_Filter_Type;
                        Tag    : in Html_Tag) is
   begin
      Filter.Allowed (Tag) := False;
   end Forbidden;

   --  ------------------------------
   --  Mark the HTML tag as being allowed.
   --  ------------------------------
   procedure Allowed (Filter : in out Html_Filter_Type;
                      Tag    : in Html_Tag) is
   begin
      Filter.Allowed (Tag) := True;
   end Allowed;

   --  ------------------------------
   --  Mark the HTML tag as being hidden.  The tag and its inner content including the text
   --  will be removed and not passed to the final document.
   --  ------------------------------
   procedure Hide (Filter : in out Html_Filter_Type;
                   Tag    : in Html_Tag) is
   begin
      Filter.Hidden (Tag) := True;
   end Hide;

   --  ------------------------------
   --  Mark the HTML tag as being visible.
   --  ------------------------------
   procedure Visible (Filter : in out Html_Filter_Type;
                      Tag    : in Html_Tag) is
   begin
      Filter.Hidden (Tag) := False;
   end Visible;

end Wiki.Filters.Html;

Update to take into account the new document nodes


-----------------------------------------------------------------------
--  mapping -- Example of serialization mappings
--  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.Log.Loggers;
package body Mapping is

   use Util.Beans.Objects;

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

   type Property_Fields is (FIELD_NAME, FIELD_VALUE);
   type Property_Access is access all Property;

   type Address_Fields is (FIELD_CITY, FIELD_STREET, FIELD_COUNTRY, FIELD_ZIP);
   type Address_Access is access all Address;

   procedure Proxy_Address (Attr    : in Util.Serialize.Mappers.Mapping'Class;
                            Element : in out Person;
                            Value   : in Util.Beans.Objects.Object);
   function Get_Address_Member (Addr  : in Address;
                                Field : in Address_Fields) return Util.Beans.Objects.Object;
   procedure Set_Member (Addr  : in out Address;
                         Field : in Address_Fields;
                         Value : in Util.Beans.Objects.Object);
   procedure Set_Member (P : in out Property;
                         Field : in Property_Fields;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (P : in out Property;
                         Field : in Property_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_NAME =>
            P.Name := To_Unbounded_String (Value);

         when FIELD_VALUE =>
            P.Value := To_Unbounded_String (Value);

      end case;
   end Set_Member;

   package Property_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Property,
                                               Element_Type_Access => Property_Access,
                                               Fields              => Property_Fields,
                                               Set_Member          => Set_Member);

   --  ------------------------------
   --  Set the name/value pair on the current object.
   --  ------------------------------
   procedure Set_Member (P     : in out Person;
                         Field : in Person_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      Log.Debug ("Person field {0} - {0}", Person_Fields'Image (Field), To_String (Value));
      case Field is
         when FIELD_FIRST_NAME =>
            P.First_Name := To_Unbounded_String (Value);

         when FIELD_LAST_NAME =>
            P.Last_Name := To_Unbounded_String (Value);

         when FIELD_AGE =>
            P.Age := To_Integer (Value);

         when FIELD_ID =>
            P.Id := To_Long_Long_Integer (Value);

         when FIELD_NAME =>
            P.Name := To_Unbounded_String (Value);

         when FIELD_USER_NAME =>
            P.Username := To_Unbounded_String (Value);

         when FIELD_GENDER =>
            P.Gender := To_Unbounded_String (Value);

         when FIELD_LINK =>
            P.Link := To_Unbounded_String (Value);

      end case;
   end Set_Member;

   --  ------------------------------
   --  Set the name/value pair on the current object.
   --  ------------------------------
   function Get_Person_Member (From  : in Person;
                               Field : in Person_Fields) return Util.Beans.Objects.Object is
   begin
      case Field is
         when FIELD_FIRST_NAME =>
            return Util.Beans.Objects.To_Object (From.First_Name);

         when FIELD_LAST_NAME =>
            return Util.Beans.Objects.To_Object (From.Last_Name);

         when FIELD_AGE =>
            return Util.Beans.Objects.To_Object (From.Age);

         when FIELD_NAME =>
            return Util.Beans.Objects.To_Object (From.Name);

         when FIELD_USER_NAME =>
            return Util.Beans.Objects.To_Object (From.Username);

         when FIELD_LINK =>
            return Util.Beans.Objects.To_Object (From.Link);

         when FIELD_GENDER =>
            return Util.Beans.Objects.To_Object (From.Gender);

         when FIELD_ID =>
            return Util.Beans.Objects.To_Object (From.Id);

      end case;
   end Get_Person_Member;

   --  ------------------------------
   --  Set the name/value pair on the current object.
   --  ------------------------------
   procedure Set_Member (Addr  : in out Address;
                         Field : in Address_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_CITY =>
            Addr.City := To_Unbounded_String (Value);

         when FIELD_STREET =>
            Addr.Street := To_Unbounded_String (Value);

         when FIELD_COUNTRY =>
            Addr.Country := To_Unbounded_String (Value);

         when FIELD_ZIP =>
            Addr.Zip := To_Integer (Value);

      end case;
   end Set_Member;

   function Get_Address_Member (Addr  : in Address;
                                Field : in Address_Fields) return Util.Beans.Objects.Object is
   begin
      case Field is
         when FIELD_CITY =>
            return Util.Beans.Objects.To_Object (Addr.City);

         when FIELD_STREET =>
            return Util.Beans.Objects.To_Object (Addr.Street);

         when FIELD_COUNTRY =>
            return Util.Beans.Objects.To_Object (Addr.Country);

         when FIELD_ZIP =>
            return Util.Beans.Objects.To_Object (Addr.Zip);

      end case;
   end Get_Address_Member;

   package Address_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Address,
                                               Element_Type_Access => Address_Access,
                                               Fields              => Address_Fields,
                                               Set_Member          => Set_Member);

   --  Mapping for the Property record.
   Property_Mapping      : aliased Property_Mapper.Mapper;

   --  Mapping for the Address record.
   Address_Mapping       : aliased Address_Mapper.Mapper;

   --  Mapping for the Person record.
   Person_Mapping        : aliased Person_Mapper.Mapper;

   --  Mapping for a list of Person records (stored as a Vector).
   Person_Vector_Mapping : aliased Person_Vector_Mapper.Mapper;

   --  ------------------------------
   --  Get the address mapper which describes how to load an Address.
   --  ------------------------------
   function Get_Address_Mapper return Util.Serialize.Mappers.Mapper_Access is
   begin
      return Address_Mapping'Access;
   end Get_Address_Mapper;

   --  ------------------------------
   --  Get the person mapper which describes how to load a Person.
   --  ------------------------------
   function Get_Person_Mapper return Person_Mapper.Mapper_Access is
   begin
      return Person_Mapping'Access;
   end Get_Person_Mapper;

   --  ------------------------------
   --  Get the person vector mapper which describes how to load a list of Person.
   --  ------------------------------
   function Get_Person_Vector_Mapper return Person_Vector_Mapper.Mapper_Access is
   begin
      return Person_Vector_Mapping'Access;
   end Get_Person_Vector_Mapper;

   --  ------------------------------
   --  Helper to give access to the Address member of a Person.
   --  ------------------------------
   procedure Proxy_Address (Attr    : in Util.Serialize.Mappers.Mapping'Class;
                            Element : in out Person;
                            Value   : in Util.Beans.Objects.Object) is
   begin
      Address_Mapper.Set_Member (Attr, Element.Addr, Value);
   end Proxy_Address;

begin
   Property_Mapping.Add_Default_Mapping;

   --  XML:                                JSON:
   --  ----                                -----
   --  <city>Paris</city>                  "city" : "Paris"
   --  <street>Champs de Mars</street>     "street" : "Champs de Mars"
   --  <country>France</country>           "country" : "France"
   --  <zip>75</zip>                       "zip" : 75
   Address_Mapping.Bind (Get_Address_Member'Access);
--     Address_Mapping.Add_Mapping ("info", Property_Mapping'Access, Proxy_Info'Access);
   Address_Mapping.Add_Default_Mapping;

   --  XML:
   --  ----
   --  <xxx id='23'>
   --     <address>
   --        <city>...</city>
   --        <street number='44'>..</street>
   --        <country>..</country>
   --        <zip>..</zip>
   --     </address>
   --     <name>John</name>
   --     <last_name>Harry</last_name>
   --     <age>23</age>
   --     <info><facebook><id>...</id></facebook></info>
   --  </xxx>
   --  Person_Mapper.Add_Mapping ("@id");
   Person_Mapping.Bind (Get_Person_Member'Access);
   Person_Mapping.Add_Mapping ("address", Address_Mapping'Access, Proxy_Address'Access);
   Person_Mapping.Add_Default_Mapping;
   --  Person_Mapper.Add_Mapping ("info/*");
   --  Person_Mapper.Add_Mapping ("address/street/@number");

   Person_Vector_Mapping.Set_Mapping (Person_Mapping'Access);
end Mapping;

-----------------------------------------------------------------------
--  mapping -- Example of serialization mappings
--  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.Log.Loggers;
package body Mapping is

   use Util.Beans.Objects;

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

   type Property_Fields is (FIELD_NAME, FIELD_VALUE);
   type Property_Access is access all Property;

   type Address_Fields is (FIELD_CITY, FIELD_STREET, FIELD_COUNTRY, FIELD_ZIP);
   type Address_Access is access all Address;

   procedure Proxy_Address (Attr    : in Util.Serialize.Mappers.Mapping'Class;
                            Element : in out Person;
                            Value   : in Util.Beans.Objects.Object);
   function Get_Address_Member (Addr  : in Address;
                                Field : in Address_Fields) return Util.Beans.Objects.Object;
   procedure Set_Member (Addr  : in out Address;
                         Field : in Address_Fields;
                         Value : in Util.Beans.Objects.Object);
   procedure Set_Member (P : in out Property;
                         Field : in Property_Fields;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (P : in out Property;
                         Field : in Property_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_NAME =>
            P.Name := To_Unbounded_String (Value);

         when FIELD_VALUE =>
            P.Value := To_Unbounded_String (Value);

      end case;
   end Set_Member;

   package Property_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Property,
                                               Element_Type_Access => Property_Access,
                                               Fields              => Property_Fields,
                                               Set_Member          => Set_Member);

   --  ------------------------------
   --  Set the name/value pair on the current object.
   --  ------------------------------
   procedure Set_Member (P     : in out Person;
                         Field : in Person_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      Log.Debug ("Person field {0} - {0}", Person_Fields'Image (Field), To_String (Value));
      case Field is
         when FIELD_FIRST_NAME =>
            P.First_Name := To_Unbounded_String (Value);

         when FIELD_LAST_NAME =>
            P.Last_Name := To_Unbounded_String (Value);

         when FIELD_AGE =>
            P.Age := To_Integer (Value);

         when FIELD_ID =>
            P.Id := To_Long_Long_Integer (Value);

         when FIELD_NAME =>
            P.Name := To_Unbounded_String (Value);

         when FIELD_USER_NAME =>
            P.Username := To_Unbounded_String (Value);

         when FIELD_GENDER =>
            P.Gender := To_Unbounded_String (Value);

         when FIELD_LINK =>
            P.Link := To_Unbounded_String (Value);

      end case;
   end Set_Member;

   --  ------------------------------
   --  Set the name/value pair on the current object.
   --  ------------------------------
   function Get_Person_Member (From  : in Person;
                               Field : in Person_Fields) return Util.Beans.Objects.Object is
   begin
      case Field is
         when FIELD_FIRST_NAME =>
            return Util.Beans.Objects.To_Object (From.First_Name);

         when FIELD_LAST_NAME =>
            return Util.Beans.Objects.To_Object (From.Last_Name);

         when FIELD_AGE =>
            return Util.Beans.Objects.To_Object (From.Age);

         when FIELD_NAME =>
            return Util.Beans.Objects.To_Object (From.Name);

         when FIELD_USER_NAME =>
            return Util.Beans.Objects.To_Object (From.Username);

         when FIELD_LINK =>
            return Util.Beans.Objects.To_Object (From.Link);

         when FIELD_GENDER =>
            return Util.Beans.Objects.To_Object (From.Gender);

         when FIELD_ID =>
            return Util.Beans.Objects.To_Object (From.Id);

      end case;
   end Get_Person_Member;

   --  ------------------------------
   --  Set the name/value pair on the current object.
   --  ------------------------------
   procedure Set_Member (Addr  : in out Address;
                         Field : in Address_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_CITY =>
            Addr.City := To_Unbounded_String (Value);

         when FIELD_STREET =>
            Addr.Street := To_Unbounded_String (Value);

         when FIELD_COUNTRY =>
            Addr.Country := To_Unbounded_String (Value);

         when FIELD_ZIP =>
            Addr.Zip := To_Integer (Value);

      end case;
   end Set_Member;

   function Get_Address_Member (Addr  : in Address;
                                Field : in Address_Fields) return Util.Beans.Objects.Object is
   begin
      case Field is
         when FIELD_CITY =>
            return Util.Beans.Objects.To_Object (Addr.City);

         when FIELD_STREET =>
            return Util.Beans.Objects.To_Object (Addr.Street);

         when FIELD_COUNTRY =>
            return Util.Beans.Objects.To_Object (Addr.Country);

         when FIELD_ZIP =>
            return Util.Beans.Objects.To_Object (Addr.Zip);

      end case;
   end Get_Address_Member;

   package Address_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Address,
                                               Element_Type_Access => Address_Access,
                                               Fields              => Address_Fields,
                                               Set_Member          => Set_Member);

   --  Mapping for the Property record.
   Property_Mapping      : aliased Property_Mapper.Mapper;

   --  Mapping for the Address record.
   Address_Mapping       : aliased Address_Mapper.Mapper;

   --  Mapping for the Person record.
   Person_Mapping        : aliased Person_Mapper.Mapper;

   --  ------------------------------
   --  Get the address mapper which describes how to load an Address.
   --  ------------------------------
   function Get_Address_Mapper return Util.Serialize.Mappers.Mapper_Access is
   begin
      return Address_Mapping'Access;
   end Get_Address_Mapper;

   --  ------------------------------
   --  Get the person mapper which describes how to load a Person.
   --  ------------------------------
   function Get_Person_Mapper return Person_Mapper.Mapper_Access is
   begin
      return Person_Mapping'Access;
   end Get_Person_Mapper;

   --  ------------------------------
   --  Helper to give access to the Address member of a Person.
   --  ------------------------------
   procedure Proxy_Address (Attr    : in Util.Serialize.Mappers.Mapping'Class;
                            Element : in out Person;
                            Value   : in Util.Beans.Objects.Object) is
   begin
      Address_Mapper.Set_Member (Attr, Element.Addr, Value);
   end Proxy_Address;

begin
   Property_Mapping.Add_Default_Mapping;

   --  XML:                                JSON:
   --  ----                                -----
   --  <city>Paris</city>                  "city" : "Paris"
   --  <street>Champs de Mars</street>     "street" : "Champs de Mars"
   --  <country>France</country>           "country" : "France"
   --  <zip>75</zip>                       "zip" : 75
   Address_Mapping.Bind (Get_Address_Member'Access);
--     Address_Mapping.Add_Mapping ("info", Property_Mapping'Access, Proxy_Info'Access);
   Address_Mapping.Add_Default_Mapping;

   --  XML:
   --  ----
   --  <xxx id='23'>
   --     <address>
   --        <city>...</city>
   --        <street number='44'>..</street>
   --        <country>..</country>
   --        <zip>..</zip>
   --     </address>
   --     <name>John</name>
   --     <last_name>Harry</last_name>
   --     <age>23</age>
   --     <info><facebook><id>...</id></facebook></info>
   --  </xxx>
   --  Person_Mapper.Add_Mapping ("@id");
   Person_Mapping.Bind (Get_Person_Member'Access);
   Person_Mapping.Add_Mapping ("address", Address_Mapping'Access, Proxy_Address'Access);
   Person_Mapping.Add_Default_Mapping;
   --  Person_Mapper.Add_Mapping ("info/*");
   --  Person_Mapper.Add_Mapping ("address/street/@number");

end Mapping;

Remove the Person_Vector_Mapper package

Remove the Person_Vector_Mapper package


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

with Input_Sources.File;
with DOM.Core.Documents;
with DOM.Readers;
with Sax.Readers;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Components.Core;
with ASF.Contexts.Faces;
with ASF.Applications.Views;
with ASF.Contexts.Writer.String;

with EL.Objects;
with EL.Contexts;
with EL.Contexts.Default;
with EL.Functions;
with EL.Variables;
with EL.Variables.Default;

with Gen.Model;
with Gen.Utils;

with Util.Files;
with Util.Log.Loggers;
package body Gen.Generator is

   use ASF;
   use Ada.Strings.Unbounded;
   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Generator");

   RESULT_DIR : constant String := "generator.output.dir";

   function To_Ada_Type (Name : EL.Objects.Object) return EL.Objects.Object;
   function Indent (Value : EL.Objects.Object) return EL.Objects.Object;

   --  EL Function to translate a model type to the key enum value
   function To_Key_Enum (Name : EL.Objects.Object) return EL.Objects.Object;

   --  ------------------------------
   --  EL Function to translate a model type to an Ada implementation type
   --  ------------------------------
   function To_Ada_Type (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "String" then
         return EL.Objects.To_Object (String '("Unbounded_String"));
      elsif Value = "Integer" or Value = "int" then
         return EL.Objects.To_Object (String '("Integer"));
      else
         return Name;
      end if;
   end To_Ada_Type;

   --  ------------------------------
   --  EL Function to check whether a type is an integer type
   --  ------------------------------
   function Is_Integer_Type (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "Integer" or Value = "int" then
         return EL.Objects.To_Object (True);
      else
         return EL.Objects.To_Object (False);
      end if;
   end Is_Integer_Type;

   KEY_INTEGER_LABEL : constant String := "KEY_INTEGER";
   KEY_STRING_LABEL  : constant String := "KEY_STRING";

   --  ------------------------------
   --  EL Function to translate a model type to the key enum value
   --  ------------------------------
   function To_Key_Enum (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "Integer" or Value = "int" or Value = "Identifier"
         or Value = "ADO.Identifier" then
         return EL.Objects.To_Object (KEY_INTEGER_LABEL);
      else
         return EL.Objects.To_Object (KEY_STRING_LABEL);
      end if;
   end To_Key_Enum;

   --  ------------------------------
   --  EL function to indent the code
   --  ------------------------------
   function Indent (Value : EL.Objects.Object) return EL.Objects.Object is
      S      : constant String := EL.Objects.To_String (Value);
      Result : constant String (S'Range) := (others => ' ');
   begin
      return EL.Objects.To_Object (Result);
   end Indent;

   --  ------------------------------
   --  EL function to indent the code
   --  ------------------------------
   function To_Sql_Type (Value : EL.Objects.Object) return EL.Objects.Object is
      Name   : constant String := EL.Objects.To_String (Value);
      Result : Unbounded_String;
   begin
      if Name = "Identifier" then
         Append (Result, "BIGINT NOT NULL");
      elsif Name = "Integer" then
         Append (Result, "INTEGER");
      elsif Name = "String" then
         Append (Result, "VARCHAR(255)");
      elsif Name = "Date" then
         Append (Result, "DATE");
      else
         Append (Result, "VARCHAR(255)");
      end if;
      return EL.Objects.To_Object (Result);
   end To_Sql_Type;

   --  ------------------------------
   --  Register the generator EL functions
   --  ------------------------------
   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
      URI : constant String := "http://code.google.com/p/ada-ado/generator";
   begin
      Mapper.Set_Function (Name      => "adaType",
                           Namespace => URI,
                           Func      => To_Ada_Type'Access);
      Mapper.Set_Function (Name      => "indent",
                           Namespace => URI,
                           Func      => Indent'Access);
      Mapper.Set_Function (Name      => "isInteger",
                           Namespace => URI,
                           Func      => Is_Integer_Type'Access);
      Mapper.Set_Function (Name      => "sqlType",
                           Namespace => URI,
                           Func      => To_Sql_Type'Access);
      Mapper.Set_Function (Name      => "keyEnum",
                           Namespace => URI,
                           Func      => To_Key_Enum'Access);
   end Set_Functions;

   --  ------------------------------
   --  Initialize the generator
   --  ------------------------------
   procedure Initialize (H : in out Handler) is
      procedure Register_Funcs is
        new ASF.Applications.Main.Register_Functions (Set_Functions);
   begin
      H.Conf.Set (ASF.Applications.VIEW_IGNORE_WHITE_SPACES, "false");
      H.Conf.Set (ASF.Applications.VIEW_ESCAPE_UNKNOWN_TAGS, "false");
      H.Conf.Set (ASF.Applications.VIEW_IGNORE_EMPTY_LINES, "true");
      H.Conf.Set (ASF.Applications.VIEW_FILE_EXT, "");
      if not H.Conf.Exists (ASF.Applications.VIEW_DIR) then
         H.Set_Template_Directory ("templates/");
      end if;
      H.Initialize (H.Conf);

      Register_Funcs (H);
   end Initialize;

   --  ------------------------------
   --  Set the directory where template files are stored.
   --  ------------------------------
   procedure Set_Template_Directory (H    : in out Handler;
                                     Path : in String) is
   begin
      H.Conf.Set (ASF.Applications.VIEW_DIR, Path);
   end Set_Template_Directory;

   --  ------------------------------
   --  Set the directory where results files are generated.
   --  ------------------------------
   procedure Set_Result_Directory (H    : in out Handler;
                                   Path : in String) is
   begin
      H.Conf.Set (RESULT_DIR, Path);
   end Set_Result_Directory;

   --  ------------------------------
   --  Register a model mapping
   --  ------------------------------
   procedure Register_Mapping (H    : in out Handler;
                               Node : in DOM.Core.Node) is
   begin
      H.Model.Initialize (Node);
   end Register_Mapping;

   --  ------------------------------
   --  Get the exit status
   --  Returns 0 if the generation was successful
   --  Returns 1 if there was a generation error
   --  ------------------------------
   function Get_Status (H : in Handler) return Ada.Command_Line.Exit_Status is
   begin
      return H.Status;
   end Get_Status;

   --  ------------------------------
   --  Report an error and set the exit status accordingly
   --  ------------------------------
   procedure Error (H : in out Handler;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "") is
   begin
      Log.Error (Message, Arg1, Arg2);
      H.Status := 1;
   end Error;

   --  ------------------------------
   --  Read the XML model file
   --  ------------------------------
   procedure Read_Model (H    : in out Handler;
                         File : in String) is
      Read           : Input_Sources.File.File_Input;
      My_Tree_Reader : DOM.Readers.Tree_Reader;
      Name_Start     : Natural;

      procedure Iterate is new Gen.Utils.Iterate_Nodes (T       => Handler,
                                                        Process => Register_Mapping);

   begin
      Log.Info ("Reading model file {0}", File);

      --  Base file name should be used as the public Id
      Name_Start := File'Last;
      while Name_Start >= File'First  and then File (Name_Start) /= '/' loop
         Name_Start := Name_Start - 1;
      end loop;
      Input_Sources.File.Open (File, Read);

      --  Full name is used as the system id
      Input_Sources.File.Set_System_Id (Read, File);
      Input_Sources.File.Set_Public_Id (Read, File (Name_Start + 1 .. File'Last));

      DOM.Readers.Set_Feature (My_Tree_Reader, Sax.Readers.Validation_Feature, False);

      DOM.Readers.Parse (My_Tree_Reader, Read);
      Input_Sources.File.Close (Read);

      H.Doc := DOM.Readers.Get_Tree (My_Tree_Reader);
      H.Root := DOM.Core.Documents.Get_Element (H.Doc);

      Iterate (H, H.Root, "hibernate-mapping");

   exception
      when Ada.IO_Exceptions.Name_Error =>
         H.Error ("Model file {0} does not exist", File);

   end Read_Model;

   --  ------------------------------
   --  Generate the code using the template file
   --  ------------------------------
   procedure Generate (H     : in out Handler;
                       File  : in String;
                       Model : in Gen.Model.Definition_Access) is
      Context   : aliased Contexts.Faces.Faces_Context;
      View      : Components.Core.UIViewRoot;
      Resolver  : aliased EL.Contexts.Default.Default_ELResolver;
      Req       : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      Log.Info ("Generating {0}", File);

      --  Model.Initialize (H.Model);
      Resolver.Register (To_Unbounded_String ("model"), Model.all'Unchecked_Access);
--        Context.Set_Response_Writer (Writer'Unchecked_Access);
--        Context.Set_ELContext (ELContext'Unchecked_Access);
--        ELContext.Set_Variable_Mapper (Variables'Unchecked_Access);
--        ELContext.Set_Resolver (Resolver'Unchecked_Access);
--        Writer.Initialize ("text/plain", "UTF-8", 8192);

--        H.Set_Context (Context'Unchecked_Access);
--        H.Restore_View (File, Context, View);

      H.Dispatch (Page     => File,
                  Request  => Req,
                  Response => Reply);

      declare
         Dir     : constant String := H.Conf.Get (RESULT_DIR, "./");
         Result  : constant EL.Objects.Object := View.Get_Root.Get_Attribute (Context, "file");
         Path    : constant String := Dir & EL.Objects.To_String (Result);
         Content : Unbounded_String;
      begin
         Log.Info ("Writing result file {0}", Path);

         Reply.Read_Content (Content);
         Util.Files.Write_File (Path => Path, Content => Content);
      end;

   end Generate;

   --  ------------------------------
   --  Generate the code using the template file
   --  ------------------------------
   procedure Generate (H     : in out Handler;
                       Mode  : in Iteration_Mode;
                       File  : in String) is
   begin
      case Mode is
         when ITERATION_PACKAGE =>
            declare
               Pos : Gen.Model.Tables.Package_Cursor := H.Model.First;
            begin
               while Gen.Model.Tables.Has_Element (Pos) loop
                  H.Generate (File, Gen.Model.Tables.Element (Pos).all'Access);
                  Gen.Model.Tables.Next (Pos);
               end loop;
            end;

         when ITERATION_TABLE =>
            H.Generate (File, H.Model'Unchecked_Access);

      end case;
   end Generate;

   --  Generate all the code generation files stored in the directory
   procedure Generate_All (H    : in out Handler;
                           Mode : in Iteration_Mode;
                           Name : in String) is
      use Ada.Directories;

      Search  : Search_Type;
      Filter  : constant Filter_Type := (others => True);
      Ent     : Directory_Entry_Type;
      Dir     : constant String := H.Conf.Get (ASF.Applications.VIEW_DIR);
      Path    : constant String := Dir & Name;
   begin
      if Kind (Path) /= Directory then
         Ada.Text_IO.Put_Line ("Cannot read model directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            File_Path : constant String := Full_Name (Ent);
         begin
            H.Generate (Mode, File_Path);
         end;
      end loop;

   exception
      when Ada.IO_Exceptions.Name_Error =>
         H.Error ("Template directory {0} does not exist", Path);
   end Generate_All;

end Gen.Generator;

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

with Input_Sources.File;
with DOM.Core.Documents;
with DOM.Readers;
with Sax.Readers;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Components.Core;
with ASF.Contexts.Faces;
with ASF.Applications.Views;

with EL.Objects;
with EL.Contexts;
with EL.Contexts.Default;
with EL.Functions;

with Gen.Model;
with Gen.Utils;

with Util.Files;
with Util.Log.Loggers;
package body Gen.Generator is

   use ASF;
   use Ada.Strings.Unbounded;
   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Generator");

   RESULT_DIR : constant String := "generator.output.dir";

   function To_Ada_Type (Name : EL.Objects.Object) return EL.Objects.Object;
   function Indent (Value : EL.Objects.Object) return EL.Objects.Object;

   --  EL Function to translate a model type to the key enum value
   function To_Key_Enum (Name : EL.Objects.Object) return EL.Objects.Object;

   --  ------------------------------
   --  EL Function to translate a model type to an Ada implementation type
   --  ------------------------------
   function To_Ada_Type (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "String" then
         return EL.Objects.To_Object (String '("Unbounded_String"));
      elsif Value = "Integer" or Value = "int" then
         return EL.Objects.To_Object (String '("Integer"));
      else
         return Name;
      end if;
   end To_Ada_Type;

   --  ------------------------------
   --  EL Function to check whether a type is an integer type
   --  ------------------------------
   function Is_Integer_Type (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "Integer" or Value = "int" then
         return EL.Objects.To_Object (True);
      else
         return EL.Objects.To_Object (False);
      end if;
   end Is_Integer_Type;

   KEY_INTEGER_LABEL : constant String := "KEY_INTEGER";
   KEY_STRING_LABEL  : constant String := "KEY_STRING";

   --  ------------------------------
   --  EL Function to translate a model type to the key enum value
   --  ------------------------------
   function To_Key_Enum (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "Integer" or Value = "int" or Value = "Identifier"
         or Value = "ADO.Identifier" then
         return EL.Objects.To_Object (KEY_INTEGER_LABEL);
      else
         return EL.Objects.To_Object (KEY_STRING_LABEL);
      end if;
   end To_Key_Enum;

   --  ------------------------------
   --  EL function to indent the code
   --  ------------------------------
   function Indent (Value : EL.Objects.Object) return EL.Objects.Object is
      S      : constant String := EL.Objects.To_String (Value);
      Result : constant String (S'Range) := (others => ' ');
   begin
      return EL.Objects.To_Object (Result);
   end Indent;

   --  ------------------------------
   --  EL function to indent the code
   --  ------------------------------
   function To_Sql_Type (Value : EL.Objects.Object) return EL.Objects.Object is
      Name   : constant String := EL.Objects.To_String (Value);
      Result : Unbounded_String;
   begin
      if Name = "Identifier" then
         Append (Result, "BIGINT NOT NULL");
      elsif Name = "Integer" then
         Append (Result, "INTEGER");
      elsif Name = "String" then
         Append (Result, "VARCHAR(255)");
      elsif Name = "Date" then
         Append (Result, "DATE");
      else
         Append (Result, "VARCHAR(255)");
      end if;
      return EL.Objects.To_Object (Result);
   end To_Sql_Type;

   --  ------------------------------
   --  Register the generator EL functions
   --  ------------------------------
   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
      URI : constant String := "http://code.google.com/p/ada-ado/generator";
   begin
      Mapper.Set_Function (Name      => "adaType",
                           Namespace => URI,
                           Func      => To_Ada_Type'Access);
      Mapper.Set_Function (Name      => "indent",
                           Namespace => URI,
                           Func      => Indent'Access);
      Mapper.Set_Function (Name      => "isInteger",
                           Namespace => URI,
                           Func      => Is_Integer_Type'Access);
      Mapper.Set_Function (Name      => "sqlType",
                           Namespace => URI,
                           Func      => To_Sql_Type'Access);
      Mapper.Set_Function (Name      => "keyEnum",
                           Namespace => URI,
                           Func      => To_Key_Enum'Access);
   end Set_Functions;

   --  ------------------------------
   --  Initialize the generator
   --  ------------------------------
   procedure Initialize (H : in out Handler) is
      procedure Register_Funcs is
        new ASF.Applications.Main.Register_Functions (Set_Functions);
   begin
      H.Conf.Set (ASF.Applications.VIEW_IGNORE_WHITE_SPACES, "false");
      H.Conf.Set (ASF.Applications.VIEW_ESCAPE_UNKNOWN_TAGS, "false");
      H.Conf.Set (ASF.Applications.VIEW_IGNORE_EMPTY_LINES, "true");
      H.Conf.Set (ASF.Applications.VIEW_FILE_EXT, "");
      if not H.Conf.Exists (ASF.Applications.VIEW_DIR) then
         H.Set_Template_Directory ("templates/");
      end if;
      H.Initialize (H.Conf);

      Register_Funcs (H);
   end Initialize;

   --  ------------------------------
   --  Set the directory where template files are stored.
   --  ------------------------------
   procedure Set_Template_Directory (H    : in out Handler;
                                     Path : in String) is
   begin
      H.Conf.Set (ASF.Applications.VIEW_DIR, Path);
   end Set_Template_Directory;

   --  ------------------------------
   --  Set the directory where results files are generated.
   --  ------------------------------
   procedure Set_Result_Directory (H    : in out Handler;
                                   Path : in String) is
   begin
      H.Conf.Set (RESULT_DIR, Path);
   end Set_Result_Directory;

   --  ------------------------------
   --  Register a model mapping
   --  ------------------------------
   procedure Register_Mapping (H    : in out Handler;
                               Node : in DOM.Core.Node) is
   begin
      H.Model.Initialize (Node);
   end Register_Mapping;

   --  ------------------------------
   --  Get the exit status
   --  Returns 0 if the generation was successful
   --  Returns 1 if there was a generation error
   --  ------------------------------
   function Get_Status (H : in Handler) return Ada.Command_Line.Exit_Status is
   begin
      return H.Status;
   end Get_Status;

   --  ------------------------------
   --  Report an error and set the exit status accordingly
   --  ------------------------------
   procedure Error (H : in out Handler;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "") is
   begin
      Log.Error (Message, Arg1, Arg2);
      H.Status := 1;
   end Error;

   --  ------------------------------
   --  Read the XML model file
   --  ------------------------------
   procedure Read_Model (H    : in out Handler;
                         File : in String) is
      Read           : Input_Sources.File.File_Input;
      My_Tree_Reader : DOM.Readers.Tree_Reader;
      Name_Start     : Natural;

      procedure Iterate is new Gen.Utils.Iterate_Nodes (T       => Handler,
                                                        Process => Register_Mapping);

   begin
      Log.Info ("Reading model file {0}", File);

      --  Base file name should be used as the public Id
      Name_Start := File'Last;
      while Name_Start >= File'First  and then File (Name_Start) /= '/' loop
         Name_Start := Name_Start - 1;
      end loop;
      Input_Sources.File.Open (File, Read);

      --  Full name is used as the system id
      Input_Sources.File.Set_System_Id (Read, File);
      Input_Sources.File.Set_Public_Id (Read, File (Name_Start + 1 .. File'Last));

      DOM.Readers.Set_Feature (My_Tree_Reader, Sax.Readers.Validation_Feature, False);

      DOM.Readers.Parse (My_Tree_Reader, Read);
      Input_Sources.File.Close (Read);

      H.Doc := DOM.Readers.Get_Tree (My_Tree_Reader);
      H.Root := DOM.Core.Documents.Get_Element (H.Doc);

      Iterate (H, H.Root, "hibernate-mapping");

   exception
      when Ada.IO_Exceptions.Name_Error =>
         H.Error ("Model file {0} does not exist", File);

   end Read_Model;

   --  ------------------------------
   --  Generate the code using the template file
   --  ------------------------------
   procedure Generate (H     : in out Handler;
                       File  : in String;
                       Model : in Gen.Model.Definition_Access) is
      Context   : aliased Contexts.Faces.Faces_Context;
      View      : Components.Core.UIViewRoot;
      Resolver  : aliased EL.Contexts.Default.Default_ELResolver;
      Req       : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Bean      : constant EL.Objects.Object := EL.Objects.To_Object (Model.all'Unchecked_Access);
   begin
      Log.Info ("Generating {0}", File);

      Req.Set_Attribute (Name => "model", Value => Bean);
      Resolver.Register (To_Unbounded_String ("model"), Model.all'Unchecked_Access);

      H.Dispatch (Page     => File,
                  Request  => Req,
                  Response => Reply);

      declare
         Dir     : constant String := H.Conf.Get (RESULT_DIR, "./");
         Result  : constant EL.Objects.Object := View.Get_Root.Get_Attribute (Context, "file");
         Path    : constant String := Dir & EL.Objects.To_String (Result);
         Content : Unbounded_String;
      begin
         Log.Info ("Writing result file {0}", Path);

         Reply.Read_Content (Content);
         Util.Files.Write_File (Path => Path, Content => Content);
      end;

   end Generate;

   --  ------------------------------
   --  Generate the code using the template file
   --  ------------------------------
   procedure Generate (H     : in out Handler;
                       Mode  : in Iteration_Mode;
                       File  : in String) is
   begin
      case Mode is
         when ITERATION_PACKAGE =>
            declare
               Pos : Gen.Model.Tables.Package_Cursor := H.Model.First;
            begin
               while Gen.Model.Tables.Has_Element (Pos) loop
                  H.Generate (File, Gen.Model.Tables.Element (Pos).all'Access);
                  Gen.Model.Tables.Next (Pos);
               end loop;
            end;

         when ITERATION_TABLE =>
            H.Generate (File, H.Model'Unchecked_Access);

      end case;
   end Generate;

   --  Generate all the code generation files stored in the directory
   procedure Generate_All (H    : in out Handler;
                           Mode : in Iteration_Mode;
                           Name : in String) is
      use Ada.Directories;

      Search  : Search_Type;
      Filter  : constant Filter_Type := (others => True);
      Ent     : Directory_Entry_Type;
      Dir     : constant String := H.Conf.Get (ASF.Applications.VIEW_DIR);
      Path    : constant String := Dir & Name;
   begin
      if Kind (Path) /= Directory then
         Ada.Text_IO.Put_Line ("Cannot read model directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            File_Path : constant String := Full_Name (Ent);
         begin
            H.Generate (Mode, File_Path);
         end;
      end loop;

   exception
      when Ada.IO_Exceptions.Name_Error =>
         H.Error ("Template directory {0} does not exist", Path);
   end Generate_All;

end Gen.Generator;

Store the model bean in a request mockup object