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

with Util.Serialize.IO.XML;

with AWA.Applications.Configs;

--  The <b>AWA.Modules.Reader</b> package reads the module configuration files
--  and initializes the module.
package body AWA.Modules.Reader is

   --  ------------------------------
   --  Read the module configuration file and configure the components
   --  ------------------------------
   procedure Read_Configuration (Plugin  : in out Module'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.Default.Default_Context_Access) is

      Reader : Util.Serialize.IO.XML.Parser;

      package Config is
        new AWA.Applications.Configs.Reader_Config (Reader,
                                                    Plugin.App.all'Unchecked_Access,
                                                    Context);
      pragma Warnings (Off, Config);

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

      if AWA.Modules.Log.Get_Level >= Util.Log.DEBUG_LEVEL then
         Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);
      end if;

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File);

   exception
      when others =>
         Log.Error ("Error while reading {0}", File);
         raise;
   end Read_Configuration;

end AWA.Modules.Reader;

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

with Util.Serialize.IO.XML;

with AWA.Applications.Configs;
with Security.Policies;

--  The <b>AWA.Modules.Reader</b> package reads the module configuration files
--  and initializes the module.
package body AWA.Modules.Reader is

   --  ------------------------------
   --  Read the module configuration file and configure the components
   --  ------------------------------
   procedure Read_Configuration (Plugin  : in out Module'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.Default.Default_Context_Access) is

      Reader : Util.Serialize.IO.XML.Parser;

      package Config is
        new AWA.Applications.Configs.Reader_Config (Reader,
                                                    Plugin.App.all'Unchecked_Access,
                                                    Context);
      pragma Warnings (Off, Config);

      Sec    : constant Security.Policies.Policy_Manager_Access := Plugin.App.Get_Security_Manager;
   begin
      Log.Info ("Reading module configuration file {0}", File);

      Sec.Prepare_Config (Reader);
      if AWA.Modules.Log.Get_Level >= Util.Log.DEBUG_LEVEL then
         Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);
      end if;

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File);
      Sec.Finish_Config (Reader);

   exception
      when others =>
         Log.Error ("Error while reading {0}", File);
         raise;
   end Read_Configuration;

end AWA.Modules.Reader;

Call Prepare_Config on the security manager before reading the module XML configuration


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

with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.File_Readers;
with Natools.S_Expressions.Interpreter_Loop;
with Natools.Static_Maps.Web.Sites;
with Natools.Web.Pages;

package body Natools.Web.Sites is

   procedure Add_Page
     (Builder : in out Site_Builder;
      File_Root : in S_Expressions.Atom;
      Path_Root : in S_Expressions.Atom);

   procedure Add_Page
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      File_Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   procedure Add_Page_Simple
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      Common_Name : in S_Expressions.Atom);

   procedure Get_Page
     (Container : in Page_Maps.Updatable_Map;
      Path : in S_Expressions.Atom;
      Result : out Page_Maps.Cursor;
      Extra_Path_First : out S_Expressions.Offset);

   procedure Execute
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   procedure Set_If_Possible
     (Reference : in out S_Expressions.Atom_Refs.Immutable_Reference;
      Expression : in S_Expressions.Lockable.Descriptor'Class);

   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   procedure Get_Page
     (Container : in Page_Maps.Updatable_Map;
      Path : in S_Expressions.Atom;
      Result : out Page_Maps.Cursor;
      Extra_Path_First : out S_Expressions.Offset)
   is
      use type S_Expressions.Atom;
      use type S_Expressions.Octet;
      use type S_Expressions.Offset;
   begin
      Result := Container.Floor (Path);

      if not Page_Maps.Has_Element (Result) then
         Extra_Path_First := 0;
         return;
      end if;

      declare
         Found_Path : constant S_Expressions.Atom := Page_Maps.Key (Result);
      begin
         if Found_Path'Length > Path'Length
           or else Path (Path'First .. Path'First + Found_Path'Length - 1)
              /= Found_Path
         then
            Page_Maps.Clear (Result);
            return;
         end if;

         Extra_Path_First := Path'First + Found_Path'Length;
      end;

      if Extra_Path_First in Path'Range
        and then Path (Extra_Path_First) /= Character'Pos ('/')
      then
         Page_Maps.Clear (Result);
         return;
      end if;
   end Get_Page;

   procedure Set_If_Possible
     (Reference : in out S_Expressions.Atom_Refs.Immutable_Reference;
      Expression : in S_Expressions.Lockable.Descriptor'Class)
   is
      use type S_Expressions.Events.Event;
   begin
      if Expression.Current_Event = S_Expressions.Events.Add_Atom then
         Reference := S_Expressions.Atom_Ref_Constructors.Create
           (Expression.Current_Atom);
      end if;
   end Set_If_Possible;

   ----------------------
   -- Site Interpreter --
   ----------------------

   procedure Add_Page
     (Builder : in out Site_Builder;
      File_Root : in S_Expressions.Atom;
      Path_Root : in S_Expressions.Atom)
   is
      use type S_Expressions.Atom;

      File : constant S_Expressions.Atom
        := Builder.File_Prefix.Query.Data.all
         & File_Root
         & Builder.File_Suffix.Query.Data.all;
      Path : constant S_Expressions.Atom
        := Builder.Path_Prefix.Query.Data.all
         & Path_Root
         & Builder.Path_Suffix.Query.Data.all;
      Page : constant Pages.Page_Ref := Pages.Create (File, Path);
   begin
      Builder.Pages.Insert (Path, Page);
   end Add_Page;

   procedure Add_Page
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      File_Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      use type S_Expressions.Events.Event;
   begin
      if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
         Add_Page (Builder, File_Name, Arguments.Current_Atom);
      end if;
   end Add_Page;

   procedure Add_Page_Simple
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      Common_Name : in S_Expressions.Atom)
   is
      pragma Unreferenced (Context);
   begin
      Add_Page (Builder, Common_Name, Common_Name);
   end Add_Page_Simple;

   procedure Add_Pages is new S_Expressions.Interpreter_Loop
     (Site_Builder, Meaningless_Type, Add_Page, Add_Page_Simple);

   procedure Execute
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      package Commands renames Natools.Static_Maps.Web.Sites;
      use type S_Expressions.Events.Event;
   begin
      case Commands.To_Command (S_Expressions.To_String (Name)) is
         when Commands.Error =>
            Log (Severities.Error, "Unknown site command """
              & S_Expressions.To_String (Name) & '"');

         when Commands.Set_Default_Template =>
            Set_If_Possible (Builder.Default_Template, Arguments);

         when Commands.Set_File_Prefix =>
            Set_If_Possible (Builder.File_Prefix, Arguments);

         when Commands.Set_File_Suffix =>
            Set_If_Possible (Builder.File_Suffix, Arguments);

         when Commands.Set_Path_Prefix =>
            Set_If_Possible (Builder.Path_Prefix, Arguments);

         when Commands.Set_Path_Suffix =>
            Set_If_Possible (Builder.Path_Suffix, Arguments);

         when Commands.Set_Template_File =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
               declare
                  Reader : S_Expressions.File_Readers.S_Reader
                    := S_Expressions.File_Readers.Reader
                       (S_Expressions.To_String (Arguments.Current_Atom));
               begin
                  Containers.Set_Expressions (Builder.Templates, Reader);
               end;
            end if;

         when Commands.Set_Templates =>
            Containers.Set_Expressions (Builder.Templates, Arguments);

         when Commands.Site_Map =>
            Add_Pages (Arguments, Builder, Meaningless_Value);
      end case;
   end Execute;

   procedure Interpreter is new S_Expressions.Interpreter_Loop
     (Site_Builder, Meaningless_Type, Execute);

   procedure Update
     (Builder : in out Site_Builder;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Interpreter (Expression, Builder, Meaningless_Value);
   end Update;

   ---------------------------
   -- Site Public Interface --
   ---------------------------

   function Create (File_Name : String) return Site is
      Result : Site
        := (File_Name => S_Expressions.Atom_Ref_Constructors.Create
                           (S_Expressions.To_Atom (File_Name)),
            others => <>);
   begin
      Reload (Result);
      return Result;
   end Create;

   procedure Reload (Object : in out Site) is
      Reader : S_Expressions.File_Readers.S_Reader
        := S_Expressions.File_Readers.Reader
           (S_Expressions.To_String (Object.File_Name.Query.Data.all));
      Builder : Site_Builder;
   begin
      Update (Builder, Reader);
      Object :=
        (Default_Template => Builder.Default_Template,
         File_Name => Object.File_Name,
         Pages => Page_Maps.Create (Builder.Pages),
         Templates => Builder.Templates);

      if Object.Default_Template.Is_Empty then
         Object.Default_Template := S_Expressions.Atom_Ref_Constructors.Create
           (S_Expressions.To_Atom ("html"));
      end if;
   end Reload;

   procedure Respond
     (Object : aliased in out Site;
      Exchange : in out Exchanges.Exchange)
   is
      use type S_Expressions.Octet;
      use type S_Expressions.Offset;

      procedure Call_Page
        (Key : in S_Expressions.Atom;
         Page_Object : in out Page'Class);

      Path : constant S_Expressions.Atom
        := S_Expressions.To_Atom (Exchanges.Path (Exchange));

      procedure Call_Page
        (Key : in S_Expressions.Atom;
         Page_Object : in out Page'Class)
      is
         use type S_Expressions.Atom;
      begin
         pragma Assert (Key'Length <= Path'Length
           and then Key = Path (Path'First .. Path'First + Key'Length - 1));

         Respond (Page_Object, Exchange, Object,
           Path (Path'First + Key'Length .. Path'Last));
      end Call_Page;

      Cursor : Page_Maps.Cursor;
      Extra_Path_First : S_Expressions.Offset;
   begin
      Get_Page (Object.Pages, Path, Cursor, Extra_Path_First);

      if not Page_Maps.Has_Element (Cursor) then
         return;
      end if;

      Response_Loop :
      loop
         Object.Pages.Update_Element (Cursor, Call_Page'Access);

         exit Response_Loop when Exchanges.Has_Response (Exchange);

         Find_Parent :
         loop
            Remove_Path_Component :
            loop
               Extra_Path_First := Extra_Path_First - 1;

               exit Response_Loop
                 when Extra_Path_First not in Path'Range;
               exit Remove_Path_Component
                 when Path (Extra_Path_First) = Character'Pos ('/');
            end loop Remove_Path_Component;

            Cursor := Object.Pages.Find
              (Path (Path'First .. Extra_Path_First - 1));
            exit Find_Parent when Page_Maps.Has_Element (Cursor);
         end loop Find_Parent;
      end loop Response_Loop;
   end Respond;

   -------------------------
   -- Site Data Accessors --
   -------------------------

   function Default_Template (Object : Site) return S_Expressions.Atom is
   begin
      return Object.Default_Template.Query.Data.all;
   end Default_Template;

   function Template
     (Object : Site;
      Name : S_Expressions.Atom)
     return S_Expressions.Caches.Cursor is
   begin
      return Containers.Get_Expression (Object.Templates, Name);
   end Template;

end Natools.Web.Sites;

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

with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.File_Readers;
with Natools.S_Expressions.Interpreter_Loop;
with Natools.Static_Maps.Web.Sites;
with Natools.Web.Pages;

package body Natools.Web.Sites is

   procedure Add_Page
     (Builder : in out Site_Builder;
      File_Root : in S_Expressions.Atom;
      Path_Root : in S_Expressions.Atom);

   procedure Add_Page
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      File_Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   procedure Add_Page_Simple
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      Common_Name : in S_Expressions.Atom);

   procedure Get_Page
     (Container : in Page_Maps.Updatable_Map;
      Path : in S_Expressions.Atom;
      Result : out Page_Maps.Cursor;
      Extra_Path_First : out S_Expressions.Offset);

   procedure Execute
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   procedure Set_If_Possible
     (Reference : in out S_Expressions.Atom_Refs.Immutable_Reference;
      Expression : in S_Expressions.Lockable.Descriptor'Class);

   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   procedure Get_Page
     (Container : in Page_Maps.Updatable_Map;
      Path : in S_Expressions.Atom;
      Result : out Page_Maps.Cursor;
      Extra_Path_First : out S_Expressions.Offset)
   is
      use type S_Expressions.Atom;
      use type S_Expressions.Octet;
      use type S_Expressions.Offset;
   begin
      Result := Container.Floor (Path);

      if not Page_Maps.Has_Element (Result) then
         Extra_Path_First := 0;
         return;
      end if;

      declare
         Found_Path : constant S_Expressions.Atom := Page_Maps.Key (Result);
      begin
         if Found_Path'Length > Path'Length
           or else Path (Path'First .. Path'First + Found_Path'Length - 1)
              /= Found_Path
         then
            Page_Maps.Clear (Result);
            return;
         end if;

         Extra_Path_First := Path'First + Found_Path'Length;
      end;

      if Extra_Path_First in Path'Range
        and then Path (Extra_Path_First) /= Character'Pos ('/')
      then
         Page_Maps.Clear (Result);
         return;
      end if;
   end Get_Page;

   procedure Set_If_Possible
     (Reference : in out S_Expressions.Atom_Refs.Immutable_Reference;
      Expression : in S_Expressions.Lockable.Descriptor'Class)
   is
      use type S_Expressions.Events.Event;
   begin
      if Expression.Current_Event = S_Expressions.Events.Add_Atom then
         Reference := S_Expressions.Atom_Ref_Constructors.Create
           (Expression.Current_Atom);
      end if;
   end Set_If_Possible;

   ----------------------
   -- Site Interpreter --
   ----------------------

   procedure Add_Page
     (Builder : in out Site_Builder;
      File_Root : in S_Expressions.Atom;
      Path_Root : in S_Expressions.Atom)
   is
      use type S_Expressions.Atom;

      File : constant S_Expressions.Atom
        := Builder.File_Prefix.Query.Data.all
         & File_Root
         & Builder.File_Suffix.Query.Data.all;
      Path : constant S_Expressions.Atom
        := Builder.Path_Prefix.Query.Data.all
         & Path_Root
         & Builder.Path_Suffix.Query.Data.all;
      Page : constant Pages.Page_Ref := Pages.Create (File, Path);
   begin
      Builder.Pages.Insert (Path, Page);
   end Add_Page;

   procedure Add_Page
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      File_Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      use type S_Expressions.Events.Event;
   begin
      if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
         Add_Page (Builder, File_Name, Arguments.Current_Atom);
      end if;
   end Add_Page;

   procedure Add_Page_Simple
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      Common_Name : in S_Expressions.Atom)
   is
      pragma Unreferenced (Context);
   begin
      Add_Page (Builder, Common_Name, Common_Name);
   end Add_Page_Simple;

   procedure Add_Pages is new S_Expressions.Interpreter_Loop
     (Site_Builder, Meaningless_Type, Add_Page, Add_Page_Simple);

   procedure Execute
     (Builder : in out Site_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      package Commands renames Natools.Static_Maps.Web.Sites;
      use type S_Expressions.Events.Event;
   begin
      case Commands.To_Command (S_Expressions.To_String (Name)) is
         when Commands.Error =>
            Log (Severities.Error, "Unknown site command """
              & S_Expressions.To_String (Name) & '"');

         when Commands.Set_Default_Template =>
            Set_If_Possible (Builder.Default_Template, Arguments);

         when Commands.Set_File_Prefix =>
            Set_If_Possible (Builder.File_Prefix, Arguments);

         when Commands.Set_File_Suffix =>
            Set_If_Possible (Builder.File_Suffix, Arguments);

         when Commands.Set_Path_Prefix =>
            Set_If_Possible (Builder.Path_Prefix, Arguments);

         when Commands.Set_Path_Suffix =>
            Set_If_Possible (Builder.Path_Suffix, Arguments);

         when Commands.Set_Template_File =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
               declare
                  Reader : S_Expressions.File_Readers.S_Reader
                    := S_Expressions.File_Readers.Reader
                       (S_Expressions.To_String (Arguments.Current_Atom));
               begin
                  Containers.Set_Expressions (Builder.Templates, Reader);
               end;
            end if;

         when Commands.Set_Templates =>
            Containers.Set_Expressions (Builder.Templates, Arguments);

         when Commands.Site_Map =>
            Add_Pages (Arguments, Builder, Meaningless_Value);
      end case;
   end Execute;

   procedure Interpreter is new S_Expressions.Interpreter_Loop
     (Site_Builder, Meaningless_Type, Execute);

   procedure Update
     (Builder : in out Site_Builder;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Interpreter (Expression, Builder, Meaningless_Value);
   end Update;

   ---------------------------
   -- Site Public Interface --
   ---------------------------

   function Create (File_Name : String) return Site is
      Result : Site
        := (File_Name => S_Expressions.Atom_Ref_Constructors.Create
                           (S_Expressions.To_Atom (File_Name)),
            others => <>);
   begin
      Reload (Result);
      return Result;
   end Create;

   procedure Reload (Object : in out Site) is
      Reader : S_Expressions.File_Readers.S_Reader
        := S_Expressions.File_Readers.Reader
           (S_Expressions.To_String (Object.File_Name.Query.Data.all));
      Empty_Atom : constant S_Expressions.Atom_Refs.Immutable_Reference
        := S_Expressions.Atom_Ref_Constructors.Create
           (S_Expressions.Null_Atom);
      Builder : Site_Builder
        := (Default_Template
              => S_Expressions.Atom_Refs.Null_Immutable_Reference,
            File_Prefix => Empty_Atom,
            File_Suffix => Empty_Atom,
            Path_Prefix => Empty_Atom,
            Path_Suffix => Empty_Atom,
            Pages | Templates => <>);
   begin
      Update (Builder, Reader);

      Object :=
        (Default_Template => Builder.Default_Template,
         File_Name => Object.File_Name,
         Pages => Page_Maps.Create (Builder.Pages),
         Templates => Builder.Templates);

      if Object.Default_Template.Is_Empty then
         Object.Default_Template := S_Expressions.Atom_Ref_Constructors.Create
           (S_Expressions.To_Atom ("html"));
      end if;
   end Reload;

   procedure Respond
     (Object : aliased in out Site;
      Exchange : in out Exchanges.Exchange)
   is
      use type S_Expressions.Octet;
      use type S_Expressions.Offset;

      procedure Call_Page
        (Key : in S_Expressions.Atom;
         Page_Object : in out Page'Class);

      Path : constant S_Expressions.Atom
        := S_Expressions.To_Atom (Exchanges.Path (Exchange));

      procedure Call_Page
        (Key : in S_Expressions.Atom;
         Page_Object : in out Page'Class)
      is
         use type S_Expressions.Atom;
      begin
         pragma Assert (Key'Length <= Path'Length
           and then Key = Path (Path'First .. Path'First + Key'Length - 1));

         Respond (Page_Object, Exchange, Object,
           Path (Path'First + Key'Length .. Path'Last));
      end Call_Page;

      Cursor : Page_Maps.Cursor;
      Extra_Path_First : S_Expressions.Offset;
   begin
      Get_Page (Object.Pages, Path, Cursor, Extra_Path_First);

      if not Page_Maps.Has_Element (Cursor) then
         return;
      end if;

      Response_Loop :
      loop
         Object.Pages.Update_Element (Cursor, Call_Page'Access);

         exit Response_Loop when Exchanges.Has_Response (Exchange);

         Find_Parent :
         loop
            Remove_Path_Component :
            loop
               Extra_Path_First := Extra_Path_First - 1;

               exit Response_Loop
                 when Extra_Path_First not in Path'Range;
               exit Remove_Path_Component
                 when Path (Extra_Path_First) = Character'Pos ('/');
            end loop Remove_Path_Component;

            Cursor := Object.Pages.Find
              (Path (Path'First .. Extra_Path_First - 1));
            exit Find_Parent when Page_Maps.Has_Element (Cursor);
         end loop Find_Parent;
      end loop Response_Loop;
   end Respond;

   -------------------------
   -- Site Data Accessors --
   -------------------------

   function Default_Template (Object : Site) return S_Expressions.Atom is
   begin
      return Object.Default_Template.Query.Data.all;
   end Default_Template;

   function Template
     (Object : Site;
      Name : S_Expressions.Atom)
     return S_Expressions.Caches.Cursor is
   begin
      return Containers.Get_Expression (Object.Templates, Name);
   end Template;

end Natools.Web.Sites;

fix initialization of site builders

sites: fix initialization of site builders


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

with Wiki.Helpers;
with Wiki.Parsers.Html.Entities;
package body Wiki.Parsers.Html is

   --  Parse an HTML attribute
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Unbounded_Wide_Wide_String);

   --  Parse a HTML/XML comment to strip it.
   procedure Parse_Comment (P : in out Parser);

   --  Parse a simple DOCTYPE declaration and ignore it.
   procedure Parse_Doctype (P : in out Parser);

   procedure Collect_Attributes (P     : in out Parser);
   function Is_Letter (C : in Wide_Wide_Character) return Boolean;
   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Unbounded_Wide_Wide_String);

   function Is_Letter (C : in Wide_Wide_Character) return Boolean is
   begin
      return C > ' ' and C /= ':' and C /= '>' and C /= ''' and C /= '"'
        and C /= '/' and C /= '=' and C /= '<';
   end Is_Letter;

   --  ------------------------------
   --  Parse an HTML attribute
   --  ------------------------------
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Unbounded_Wide_Wide_String) is
      C : Wide_Wide_Character;
   begin
      Name := To_Unbounded_Wide_Wide_String ("");
      Skip_Spaces (P);
      while not P.Is_Eof loop
         Peek (P, C);
         if not Is_Letter (C) then
            Put_Back (P, C);
            return;
         end if;
         Ada.Strings.Wide_Wide_Unbounded.Append (Name, C);
      end loop;
   end Parse_Attribute_Name;

   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Unbounded_Wide_Wide_String) is
      C     : Wide_Wide_Character;
      Token : Wide_Wide_Character;
   begin
      Value := To_Unbounded_Wide_Wide_String ("");
      Peek (P, Token);
      if Wiki.Helpers.Is_Space (Token) then
         return;
      elsif Token = '>' then
         Put_Back (P, Token);
         return;
      elsif Token /= ''' and Token /= '"' then
         Append (Value, Token);
         while not P.Is_Eof loop
            Peek (P, C);
            if C = ''' or C = '"' or C = ' ' or C = '=' or C = '>' or C = '<' or C = '`' then
               Put_Back (P, C);
               return;
            end if;
            Append (Value, C);
         end loop;
      else
         while not P.Is_Eof loop
            Peek (P, C);
            if C = Token then
               return;
            end if;
            Append (Value, C);
         end loop;
      end if;
   end Collect_Attribute_Value;

   --  ------------------------------
   --  Parse a list of HTML attributes up to the first '>'.
   --  attr-name
   --  attr-name=
   --  attr-name=value
   --  attr-name='value'
   --  attr-name="value"
   --  <name name='value' ...>
   --  ------------------------------
   procedure Collect_Attributes (P     : in out Parser) is
      C     : Wide_Wide_Character;
      Name  : Unbounded_Wide_Wide_String;
      Value : Unbounded_Wide_Wide_String;
   begin
      Wiki.Attributes.Clear (P.Attributes);
      while not P.Is_Eof loop
         Parse_Attribute_Name (P, Name);
         Skip_Spaces (P);
         Peek (P, C);
         if C = '>' or C = '<' or C = '/' then
            Put_Back (P, C);
            exit;
         end if;
         if C = '=' then
            Collect_Attribute_Value (P, Value);
            Attributes.Append (P.Attributes, Name, Value);
         elsif Wiki.Helpers.Is_Space (C) and Length (Name) > 0 then
            Attributes.Append (P.Attributes, Name, Null_Unbounded_Wide_Wide_String);
         end if;
      end loop;
      --  Peek (P, C);

      --  Add any pending attribute.
      if Length (Name) > 0 then
         Attributes.Append (P.Attributes, Name, Null_Unbounded_Wide_Wide_String);
      end if;
   end Collect_Attributes;

   --  ------------------------------
   --  Parse a HTML/XML comment to strip it.
   --  ------------------------------
   procedure Parse_Comment (P : in out Parser) is
      C     : Wide_Wide_Character;
   begin
      Peek (P, C);
      while not P.Is_Eof loop
         Peek (P, C);
         if C = '-' then
            declare
               Count : Natural := 1;
            begin
               Peek (P, C);
               while not P.Is_Eof and C = '-' loop
                  Peek (P, C);
                  Count := Count + 1;
               end loop;
               exit when C = '>' and Count >= 2;
            end;
         end if;
      end loop;
   end Parse_Comment;

   --  ------------------------------
   --  Parse a simple DOCTYPE declaration and ignore it.
   --  ------------------------------
   procedure Parse_Doctype (P : in out Parser) is
      C : Wide_Wide_Character;
   begin
      while not P.Is_Eof loop
         Peek (P, C);
         exit when C = '>';
      end loop;
   end Parse_Doctype;

   --  ------------------------------
   --  Parse a HTML element <XXX attributes>
   --  or parse an end of HTML element </XXX>
   --  ------------------------------
   procedure Parse_Element (P : in out Parser) is
      Name : Unbounded_Wide_Wide_String;
      C    : Wide_Wide_Character;
      Tag  : Wiki.Nodes.Html_Tag_Type;
   begin
      Peek (P, C);
      if C = '!' then
         Peek (P, C);
         if C = '-' then
            Parse_Comment (P);
         else
            Parse_Doctype (P);
         end if;
         return;
      end if;
      if C /= '/' then
         Put_Back (P, C);
      end if;
      Parse_Attribute_Name (P, Name);
      Tag := Wiki.Nodes.Find_Tag (To_Wide_Wide_String (Name));
      if C = '/' then
         Skip_Spaces (P);
         Peek (P, C);
         if C /= '>' then
            Put_Back (P, C);
         end if;
         Flush_Text (P);
         End_Element (P, Tag);
      else
         Collect_Attributes (P);
         Peek (P, C);
         if C = '/' then
            Peek (P, C);
            if C = '>' then
               Start_Element (P, Tag, P.Attributes);
               End_Element (P, Tag);
               return;
            end if;
         elsif C /= '>' then
            Put_Back (P, C);
         end if;
         Start_Element (P, Tag, P.Attributes);
      end if;
   end Parse_Element;

   --  ------------------------------
   --  Parse an HTML entity such as   and replace it with the corresponding code.
   --  ------------------------------
   procedure Parse_Entity (P     : in out Parser;
                           Token : in Wide_Wide_Character) is
      pragma Unreferenced (Token);

      Name : String (1 .. 10);
      Len  : Natural := 0;
      High : Natural := Wiki.Parsers.Html.Entities.Keywords'Last;
      Low  : Natural := Wiki.Parsers.Html.Entities.Keywords'First;
      Pos  : Natural;
      C    : Wide_Wide_Character;
   begin
      while Len < Name'Last loop
         Peek (P, C);
         exit when C = ';' or else P.Is_Eof;
         Len := Len + 1;
         Name (Len) := Ada.Characters.Conversions.To_Character (C);
      end loop;
      while Low <= High loop
         Pos := (Low + High) / 2;
         if Wiki.Parsers.Html.Entities.Keywords (Pos).all = Name (1 .. Len) then
            Parse_Text (P, Entities.Mapping (Pos));
            return;
         elsif Entities.Keywords (Pos).all < Name (1 .. Len) then
            Low := Pos + 1;
         else
            High := Pos - 1;
         end if;
      end loop;

      --  The HTML entity is not recognized: we must treat it as plain wiki text.
      Parse_Text (P, '&');
      for I in 1 .. Len loop
         Parse_Text (P, Ada.Characters.Conversions.To_Wide_Wide_Character (Name (I)));
      end loop;
   end Parse_Entity;

end Wiki.Parsers.Html;

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

with Wiki.Helpers;
with Wiki.Parsers.Html.Entities;
package body Wiki.Parsers.Html is

   use Ada.Strings.Wide_Wide_Unbounded;

   --  Parse an HTML attribute
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Unbounded_Wide_Wide_String);

   --  Parse a HTML/XML comment to strip it.
   procedure Parse_Comment (P : in out Parser);

   --  Parse a simple DOCTYPE declaration and ignore it.
   procedure Parse_Doctype (P : in out Parser);

   procedure Collect_Attributes (P     : in out Parser);
   function Is_Letter (C : in Wide_Wide_Character) return Boolean;
   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Unbounded_Wide_Wide_String);

   function Is_Letter (C : in Wide_Wide_Character) return Boolean is
   begin
      return C > ' ' and C /= ':' and C /= '>' and C /= ''' and C /= '"'
        and C /= '/' and C /= '=' and C /= '<';
   end Is_Letter;

   --  ------------------------------
   --  Parse an HTML attribute
   --  ------------------------------
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Unbounded_Wide_Wide_String) is
      C : Wide_Wide_Character;
   begin
      Name := To_Unbounded_Wide_Wide_String ("");
      Skip_Spaces (P);
      while not P.Is_Eof loop
         Peek (P, C);
         if not Is_Letter (C) then
            Put_Back (P, C);
            return;
         end if;
         Ada.Strings.Wide_Wide_Unbounded.Append (Name, C);
      end loop;
   end Parse_Attribute_Name;

   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Unbounded_Wide_Wide_String) is
      C     : Wide_Wide_Character;
      Token : Wide_Wide_Character;
   begin
      Value := To_Unbounded_Wide_Wide_String ("");
      Peek (P, Token);
      if Wiki.Helpers.Is_Space (Token) then
         return;
      elsif Token = '>' then
         Put_Back (P, Token);
         return;
      elsif Token /= ''' and Token /= '"' then
         Append (Value, Token);
         while not P.Is_Eof loop
            Peek (P, C);
            if C = ''' or C = '"' or C = ' ' or C = '=' or C = '>' or C = '<' or C = '`' then
               Put_Back (P, C);
               return;
            end if;
            Append (Value, C);
         end loop;
      else
         while not P.Is_Eof loop
            Peek (P, C);
            if C = Token then
               return;
            end if;
            Append (Value, C);
         end loop;
      end if;
   end Collect_Attribute_Value;

   --  ------------------------------
   --  Parse a list of HTML attributes up to the first '>'.
   --  attr-name
   --  attr-name=
   --  attr-name=value
   --  attr-name='value'
   --  attr-name="value"
   --  <name name='value' ...>
   --  ------------------------------
   procedure Collect_Attributes (P     : in out Parser) is
      C     : Wide_Wide_Character;
      Name  : Unbounded_Wide_Wide_String;
      Value : Unbounded_Wide_Wide_String;
   begin
      Wiki.Attributes.Clear (P.Attributes);
      while not P.Is_Eof loop
         Parse_Attribute_Name (P, Name);
         Skip_Spaces (P);
         Peek (P, C);
         if C = '>' or C = '<' or C = '/' then
            Put_Back (P, C);
            exit;
         end if;
         if C = '=' then
            Collect_Attribute_Value (P, Value);
            Attributes.Append (P.Attributes, Name, Value);
         elsif Wiki.Helpers.Is_Space (C) and Length (Name) > 0 then
            Attributes.Append (P.Attributes, Name, Null_Unbounded_Wide_Wide_String);
         end if;
      end loop;
      --  Peek (P, C);

      --  Add any pending attribute.
      if Length (Name) > 0 then
         Attributes.Append (P.Attributes, Name, Null_Unbounded_Wide_Wide_String);
      end if;
   end Collect_Attributes;

   --  ------------------------------
   --  Parse a HTML/XML comment to strip it.
   --  ------------------------------
   procedure Parse_Comment (P : in out Parser) is
      C     : Wide_Wide_Character;
   begin
      Peek (P, C);
      while not P.Is_Eof loop
         Peek (P, C);
         if C = '-' then
            declare
               Count : Natural := 1;
            begin
               Peek (P, C);
               while not P.Is_Eof and C = '-' loop
                  Peek (P, C);
                  Count := Count + 1;
               end loop;
               exit when C = '>' and Count >= 2;
            end;
         end if;
      end loop;
   end Parse_Comment;

   --  ------------------------------
   --  Parse a simple DOCTYPE declaration and ignore it.
   --  ------------------------------
   procedure Parse_Doctype (P : in out Parser) is
      C : Wide_Wide_Character;
   begin
      while not P.Is_Eof loop
         Peek (P, C);
         exit when C = '>';
      end loop;
   end Parse_Doctype;

   --  ------------------------------
   --  Parse a HTML element <XXX attributes>
   --  or parse an end of HTML element </XXX>
   --  ------------------------------
   procedure Parse_Element (P : in out Parser) is
      Name : Unbounded_Wide_Wide_String;
      C    : Wide_Wide_Character;
      Tag  : Wiki.Nodes.Html_Tag_Type;
   begin
      Peek (P, C);
      if C = '!' then
         Peek (P, C);
         if C = '-' then
            Parse_Comment (P);
         else
            Parse_Doctype (P);
         end if;
         return;
      end if;
      if C /= '/' then
         Put_Back (P, C);
      end if;
      Parse_Attribute_Name (P, Name);
      Tag := Wiki.Nodes.Find_Tag (To_Wide_Wide_String (Name));
      if C = '/' then
         Skip_Spaces (P);
         Peek (P, C);
         if C /= '>' then
            Put_Back (P, C);
         end if;
         Flush_Text (P);
         End_Element (P, Tag);
      else
         Collect_Attributes (P);
         Peek (P, C);
         if C = '/' then
            Peek (P, C);
            if C = '>' then
               Start_Element (P, Tag, P.Attributes);
               End_Element (P, Tag);
               return;
            end if;
         elsif C /= '>' then
            Put_Back (P, C);
         end if;
         Start_Element (P, Tag, P.Attributes);
      end if;
   end Parse_Element;

   --  ------------------------------
   --  Parse an HTML entity such as   and replace it with the corresponding code.
   --  ------------------------------
   procedure Parse_Entity (P     : in out Parser;
                           Token : in Wide_Wide_Character) is
      pragma Unreferenced (Token);

      Name : String (1 .. 10);
      Len  : Natural := 0;
      High : Natural := Wiki.Parsers.Html.Entities.Keywords'Last;
      Low  : Natural := Wiki.Parsers.Html.Entities.Keywords'First;
      Pos  : Natural;
      C    : Wide_Wide_Character;
   begin
      while Len < Name'Last loop
         Peek (P, C);
         exit when C = ';' or else P.Is_Eof;
         Len := Len + 1;
         Name (Len) := Ada.Characters.Conversions.To_Character (C);
      end loop;
      while Low <= High loop
         Pos := (Low + High) / 2;
         if Wiki.Parsers.Html.Entities.Keywords (Pos).all = Name (1 .. Len) then
            Parse_Text (P, Entities.Mapping (Pos));
            return;
         elsif Entities.Keywords (Pos).all < Name (1 .. Len) then
            Low := Pos + 1;
         else
            High := Pos - 1;
         end if;
      end loop;

      --  The HTML entity is not recognized: we must treat it as plain wiki text.
      Parse_Text (P, '&');
      for I in 1 .. Len loop
         Parse_Text (P, Ada.Characters.Conversions.To_Wide_Wide_Character (Name (I)));
      end loop;
   end Parse_Entity;

end Wiki.Parsers.Html;

Fix compilation

Fix compilation


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

with Util.Tests;

package Util.Streams.Buffered.Lzma.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Compress_Stream (T : in out Test);

end Util.Streams.Buffered.Lzma.Tests;

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

with Util.Tests;

package Util.Streams.Buffered.Lzma.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Compress_Stream (T : in out Test);

   procedure Test_Compress_File_Stream (T : in out Test);

end Util.Streams.Buffered.Lzma.Tests;

Declare the Test_Compress_File_Stream procedure


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

with Util.Log.Loggers;
package body MAT.Readers.Streams.Files is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Files");

   BUFFER_SIZE  : constant Natural := 100 * 1024;

   --  ------------------------------
   --  Open the file.
   --  ------------------------------
   procedure Open (Reader : in out File_Reader_Type;
                   Path   : in String) is
   begin
      Log.Info ("Reading data stream {0}", Path);

      Reader.Stream.Initialize (Size   => BUFFER_SIZE,
                                Input  => Reader.File'Unchecked_Access,
                                Output => null);
      Reader.File.Open (Mode => Ada.Streams.Stream_IO.In_File,
                        Name => Path);
   end Open;

end MAT.Readers.Streams.Files;

-----------------------------------------------------------------------
--  mat-readers-files -- Reader for files
--  Copyright (C) 2014, 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.Streams.Stream_IO;

with Util.Log.Loggers;
package body MAT.Readers.Streams.Files is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Files");

   BUFFER_SIZE  : constant Natural := 100 * 1024;

   --  ------------------------------
   --  Open the file.
   --  ------------------------------
   procedure Open (Reader : in out File_Reader_Type;
                   Path   : in String) is
      Stream : constant access Util.Streams.Input_Stream'Class := Reader.File'Access;
   begin
      Log.Info ("Reading data stream {0}", Path);

      Reader.Stream.Initialize (Size   => BUFFER_SIZE,
                                Input  => Stream);
      Reader.File.Open (Mode => Ada.Streams.Stream_IO.In_File,
                        Name => Path);
   end Open;

end MAT.Readers.Streams.Files;

Fix initialization of file stream

Fix initialization of file stream


-----------------------------------------------------------------------
--  util-streams-raw -- Raw streams for Unix based systems
--  Copyright (C) 2011, 2013, 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 Ada.IO_Exceptions;

package body Util.Streams.Pipes is

   --  -----------------------
   --  Set the shell executable path to use to launch a command.  The default on Unix is
   --  the /bin/sh command.  Argument splitting is done by the /bin/sh -c command.
   --  When setting an empty shell command, the argument splitting is done by the
   --  <tt>Spawn</tt> procedure.
   --  -----------------------
   procedure Set_Shell (Stream : in out Pipe_Stream;
                        Shell  : in String) is
   begin
      Util.Processes.Set_Shell (Stream.Proc, Shell);
   end Set_Shell;

   --  -----------------------
   --  Before launching the process, redirect the input stream of the process
   --  to the specified file.
   --  Raises Invalid_State if the process is running.
   --  -----------------------
   procedure Set_Input_Stream (Stream : in out Pipe_Stream;
                               File   : in String) is
   begin
      Util.Processes.Set_Input_Stream (Stream.Proc, File);
   end Set_Input_Stream;

   --  -----------------------
   --  Set the output stream of the process.
   --  Raises Invalid_State if the process is running.
   --  -----------------------
   procedure Set_Output_Stream (Stream : in out Pipe_Stream;
                                File   : in String;
                                Append : in Boolean := False) is
   begin
      Util.Processes.Set_Output_Stream (Stream.Proc, File, Append);
   end Set_Output_Stream;

   --  -----------------------
   --  Set the error stream of the process.
   --  Raises Invalid_State if the process is running.
   --  -----------------------
   procedure Set_Error_Stream (Stream : in out Pipe_Stream;
                               File   : in String;
                               Append : in Boolean := False) is
   begin
      Util.Processes.Set_Error_Stream (Stream.Proc, File, Append);
   end Set_Error_Stream;

   --  -----------------------
   --  Set the working directory that the process will use once it is created.
   --  The directory must exist or the Invalid_Directory exception will be raised.
   --  -----------------------
   procedure Set_Working_Directory (Stream : in out Pipe_Stream;
                                    Path   : in String) is
   begin
      Util.Processes.Set_Working_Directory (Stream.Proc, Path);
   end Set_Working_Directory;

   --  -----------------------
   --  Open a pipe to read or write to an external process.  The pipe is created and the
   --  command is executed with the input and output streams redirected through the pipe.
   --  -----------------------
   procedure Open (Stream  : in out Pipe_Stream;
                   Command : in String;
                   Mode    : in Pipe_Mode := READ) is
   begin
      Util.Processes.Spawn (Stream.Proc, Command, Mode);
   end Open;

   --  -----------------------
   --  Close the pipe and wait for the external process to terminate.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Pipe_Stream) is
   begin
      Util.Processes.Wait (Stream.Proc);
   end Close;

   --  -----------------------
   --  Get the process exit status.
   --  -----------------------
   function Get_Exit_Status (Stream : in Pipe_Stream) return Integer is
   begin
      return Util.Processes.Get_Exit_Status (Stream.Proc);
   end Get_Exit_Status;

   --  -----------------------
   --  Returns True if the process is running.
   --  -----------------------
   function Is_Running (Stream : in Pipe_Stream) return Boolean is
   begin
      return Util.Processes.Is_Running (Stream.Proc);
   end Is_Running;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Write (Stream : in out Pipe_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      Output : constant Streams.Output_Stream_Access := Processes.Get_Input_Stream (Stream.Proc);
   begin
      if Output = null then
         raise Ada.IO_Exceptions.Status_Error with "Process is not launched";
      end if;
      Output.Write (Buffer);
   end Write;

   --  -----------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  -----------------------
   overriding
   procedure Read (Stream : in out Pipe_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is
      Input : constant Streams.Input_Stream_Access := Processes.Get_Output_Stream (Stream.Proc);
   begin
      if Input = null then
         raise Ada.IO_Exceptions.Status_Error with "Process is not launched";
      end if;
      Input.Read (Into, Last);
   end Read;

   --  -----------------------
   --  Flush the stream and release the buffer.
   --  -----------------------
   overriding
   procedure Finalize (Object : in out Pipe_Stream) is
   begin
      null;
   end Finalize;

end Util.Streams.Pipes;

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

package body Util.Streams.Pipes is

   --  -----------------------
   --  Set the shell executable path to use to launch a command.  The default on Unix is
   --  the /bin/sh command.  Argument splitting is done by the /bin/sh -c command.
   --  When setting an empty shell command, the argument splitting is done by the
   --  <tt>Spawn</tt> procedure.
   --  -----------------------
   procedure Set_Shell (Stream : in out Pipe_Stream;
                        Shell  : in String) is
   begin
      Util.Processes.Set_Shell (Stream.Proc, Shell);
   end Set_Shell;

   --  -----------------------
   --  Before launching the process, redirect the input stream of the process
   --  to the specified file.
   --  Raises Invalid_State if the process is running.
   --  -----------------------
   procedure Set_Input_Stream (Stream : in out Pipe_Stream;
                               File   : in String) is
   begin
      Util.Processes.Set_Input_Stream (Stream.Proc, File);
   end Set_Input_Stream;

   --  -----------------------
   --  Set the output stream of the process.
   --  Raises Invalid_State if the process is running.
   --  -----------------------
   procedure Set_Output_Stream (Stream : in out Pipe_Stream;
                                File   : in String;
                                Append : in Boolean := False) is
   begin
      Util.Processes.Set_Output_Stream (Stream.Proc, File, Append);
   end Set_Output_Stream;

   --  -----------------------
   --  Set the error stream of the process.
   --  Raises Invalid_State if the process is running.
   --  -----------------------
   procedure Set_Error_Stream (Stream : in out Pipe_Stream;
                               File   : in String;
                               Append : in Boolean := False) is
   begin
      Util.Processes.Set_Error_Stream (Stream.Proc, File, Append);
   end Set_Error_Stream;

   --  -----------------------
   --  Closes the given file descriptor in the child process before executing the command.
   --  -----------------------
   procedure Add_Close (Stream : in out Pipe_Stream;
                        Fd     : in Util.Processes.File_Type) is
   begin
      Util.Processes.Add_Close (Stream.Proc, Fd);
   end Add_Close;

   --  -----------------------
   --  Set the working directory that the process will use once it is created.
   --  The directory must exist or the Invalid_Directory exception will be raised.
   --  -----------------------
   procedure Set_Working_Directory (Stream : in out Pipe_Stream;
                                    Path   : in String) is
   begin
      Util.Processes.Set_Working_Directory (Stream.Proc, Path);
   end Set_Working_Directory;

   --  -----------------------
   --  Open a pipe to read or write to an external process.  The pipe is created and the
   --  command is executed with the input and output streams redirected through the pipe.
   --  -----------------------
   procedure Open (Stream  : in out Pipe_Stream;
                   Command : in String;
                   Mode    : in Pipe_Mode := READ) is
   begin
      Util.Processes.Spawn (Stream.Proc, Command, Mode);
   end Open;

   --  -----------------------
   --  Close the pipe and wait for the external process to terminate.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Pipe_Stream) is
   begin
      Util.Processes.Wait (Stream.Proc);
   end Close;

   --  -----------------------
   --  Get the process exit status.
   --  -----------------------
   function Get_Exit_Status (Stream : in Pipe_Stream) return Integer is
   begin
      return Util.Processes.Get_Exit_Status (Stream.Proc);
   end Get_Exit_Status;

   --  -----------------------
   --  Returns True if the process is running.
   --  -----------------------
   function Is_Running (Stream : in Pipe_Stream) return Boolean is
   begin
      return Util.Processes.Is_Running (Stream.Proc);
   end Is_Running;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Write (Stream : in out Pipe_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      Output : constant Streams.Output_Stream_Access := Processes.Get_Input_Stream (Stream.Proc);
   begin
      if Output = null then
         raise Ada.IO_Exceptions.Status_Error with "Process is not launched";
      end if;
      Output.Write (Buffer);
   end Write;

   --  -----------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  -----------------------
   overriding
   procedure Read (Stream : in out Pipe_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is
      Input : constant Streams.Input_Stream_Access := Processes.Get_Output_Stream (Stream.Proc);
   begin
      if Input = null then
         raise Ada.IO_Exceptions.Status_Error with "Process is not launched";
      end if;
      Input.Read (Into, Last);
   end Read;

   --  -----------------------
   --  Flush the stream and release the buffer.
   --  -----------------------
   overriding
   procedure Finalize (Object : in out Pipe_Stream) is
   begin
      null;
   end Finalize;

end Util.Streams.Pipes;

Implement the Add_Close procedure

Implement the Add_Close procedure


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

with System; use System;
with System.Address_To_Access_Conversions;
with System.Storage_Elements;
with MAT.Types;
with Interfaces; use Interfaces;
package body MAT.Readers.Marshaller is

   use System.Storage_Elements;

   package Uint8_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint8);

   package Uint32_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint32);

   function Get_Raw_Uint32 (Buf : System.Address) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buf);
   begin
      return P.all;
   end Get_Raw_Uint32;

   function Get_Uint8 (Buffer : in Buffer_Ptr) return MAT.Types.Uint8 is
      use Uint8_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size = 0 then
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 1;
      Buffer.Current := Buffer.Current + Storage_Offset (1);
      return P.all;
   end Get_Uint8;

   function Get_Uint16 (Buffer : in Buffer_Ptr) return MAT.Types.Uint16 is
      use Uint8_Access;

      High : Object_Pointer := To_Pointer (Buffer.Current
                                           + Storage_Offset (1));
      Low : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size <= 1 then
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 2;
      Buffer.Current := Buffer.Current + Storage_Offset (2);
      return MAT.Types.Uint16 (High.all) * 256 + MAT.Types.Uint16 (Low.all);
   end Get_Uint16;

   function Get_Uint32 (Buffer : in Buffer_Ptr) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size < 4 then
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 4;
      Buffer.Current := Buffer.Current + Storage_Offset (4);
      if Buffer.Current >= Buffer.Last then
         Buffer.Current := Buffer.Start;
      end if;
      return P.all;
   end Get_Uint32;

   function Get_Uint64 (Buffer : in Buffer_Ptr) return MAT.Types.Uint64 is
      Val : MAT.Types.Uint64 := MAT.Types.Uint64 (Get_Uint32 (Buffer));
   begin
      return Val + MAT.Types.Uint64 (Get_Uint32 (Buffer)) * 2**32;
   end Get_Uint64;

   function Get_Target_Value (Msg  : in Buffer_Ptr;
                              Kind : in MAT.Events.Attribute_Type) return Target_Type is
   begin
      case Kind is
         when MAT.Events.T_UINT8 =>
            return Target_Type (Get_Uint8 (Msg));

         when MAT.Events.T_UINT16 =>
            return Target_Type (Get_Uint16 (Msg));

         when MAT.Events.T_UINT32 =>
            return Target_Type (Get_Uint32 (Msg));

         when MAT.Events.T_UINT64 =>
            return Target_Type (Get_Uint64 (Msg));

         when others =>
            pragma Assert (False, "Invalid attribute type ");
            return 0;
      end case;
   end Get_Target_Value;

   --  ------------------------------
   --  Extract a string from the buffer.  The string starts with a byte that
   --  indicates the string length.
   --  ------------------------------
   function Get_String (Buffer : in Buffer_Ptr) return String is
      Len    : constant MAT.Types.Uint8 := Get_Uint8 (Buffer);
      Result : String (1 .. Natural (Len));
   begin
      for I in Result'Range loop
         Result (I) := Character'Val (Get_Uint8 (Buffer));
      end loop;
      return Result;
   end Get_String;

   --  ------------------------------
   --  Skip the given number of bytes from the message.
   --  ------------------------------
   procedure Skip (Buffer : in Buffer_Ptr;
                   Size   : in Natural) is
   begin
      Buffer.Size := Buffer.Size - Size;
      Buffer.Current := Buffer.Current + Storage_Offset (Size);
   end Skip;

end MAT.Readers.Marshaller;

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

with System; use System;
with System.Address_To_Access_Conversions;
with System.Storage_Elements;
with MAT.Types;
with Util.Log.Loggers;
with Interfaces; use Interfaces;
package body MAT.Readers.Marshaller is

   use System.Storage_Elements;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Marshaller");

   package Uint8_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint8);

   package Uint32_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint32);

   function Get_Raw_Uint32 (Buf : System.Address) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buf);
   begin
      return P.all;
   end Get_Raw_Uint32;

   function Get_Uint8 (Buffer : in Buffer_Ptr) return MAT.Types.Uint8 is
      use Uint8_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size = 0 then
         Log.Error ("Not enough data to get a uint8");
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 1;
      Buffer.Current := Buffer.Current + Storage_Offset (1);
      return P.all;
   end Get_Uint8;

   function Get_Uint16 (Buffer : in Buffer_Ptr) return MAT.Types.Uint16 is
      use Uint8_Access;

      High : Object_Pointer := To_Pointer (Buffer.Current
                                           + Storage_Offset (1));
      Low : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size <= 1 then
         Log.Error ("Not enough data to get a uint16");
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 2;
      Buffer.Current := Buffer.Current + Storage_Offset (2);
      return MAT.Types.Uint16 (High.all) * 256 + MAT.Types.Uint16 (Low.all);
   end Get_Uint16;

   function Get_Uint32 (Buffer : in Buffer_Ptr) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size < 4 then
         Log.Error ("Not enough data to get a uint32");
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 4;
      Buffer.Current := Buffer.Current + Storage_Offset (4);
      if Buffer.Current >= Buffer.Last then
         Buffer.Current := Buffer.Start;
      end if;
      return P.all;
   end Get_Uint32;

   function Get_Uint64 (Buffer : in Buffer_Ptr) return MAT.Types.Uint64 is
      Val : MAT.Types.Uint64 := MAT.Types.Uint64 (Get_Uint32 (Buffer));
   begin
      return Val + MAT.Types.Uint64 (Get_Uint32 (Buffer)) * 2**32;
   end Get_Uint64;

   function Get_Target_Value (Msg  : in Buffer_Ptr;
                              Kind : in MAT.Events.Attribute_Type) return Target_Type is
   begin
      case Kind is
         when MAT.Events.T_UINT8 =>
            return Target_Type (Get_Uint8 (Msg));

         when MAT.Events.T_UINT16 =>
            return Target_Type (Get_Uint16 (Msg));

         when MAT.Events.T_UINT32 =>
            return Target_Type (Get_Uint32 (Msg));

         when MAT.Events.T_UINT64 =>
            return Target_Type (Get_Uint64 (Msg));

         when others =>
            Log.Error ("Invalid attribute type {0}",
                       MAT.EVents.Attribute_Type'Image (Kind));
            return 0;
      end case;
   end Get_Target_Value;

   --  ------------------------------
   --  Extract a string from the buffer.  The string starts with a byte that
   --  indicates the string length.
   --  ------------------------------
   function Get_String (Buffer : in Buffer_Ptr) return String is
      Len    : constant MAT.Types.Uint8 := Get_Uint8 (Buffer);
      Result : String (1 .. Natural (Len));
   begin
      for I in Result'Range loop
         Result (I) := Character'Val (Get_Uint8 (Buffer));
      end loop;
      return Result;
   end Get_String;

   --  ------------------------------
   --  Skip the given number of bytes from the message.
   --  ------------------------------
   procedure Skip (Buffer : in Buffer_Ptr;
                   Size   : in Natural) is
   begin
      Buffer.Size := Buffer.Size - Size;
      Buffer.Current := Buffer.Current + Storage_Offset (Size);
   end Skip;

end MAT.Readers.Marshaller;

Add some log error message if there is not enough data in the buffer