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

with Wiki.Helpers;
package body Wiki.Streams.Text_IO is

   --  ------------------------------
   --  Open the file and prepare to read the input stream.
   --  ------------------------------
   procedure Open (Stream : in out File_Input_Stream;
                   Path   : in String;
                   Form   : in String := "") is
   begin
      Ada.Wide_Wide_Text_IO.Open (Stream.File, Ada.Wide_Wide_Text_IO.In_File, Path, Form);
      Stream.Stdin := False;
   end Open;

   --  ------------------------------
   --  Close the file.
   --  ------------------------------
   procedure Close (Stream : in out File_Input_Stream) is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
   end Close;

   --  ------------------------------
   --  Close the stream.
   --  ------------------------------
   overriding
   procedure Finalize (Stream : in out File_Input_Stream) is
   begin
      Stream.Close;
   end Finalize;

   --  ------------------------------
   --  Read the input stream and fill the `Into` buffer until either it is full or
   --  we reach the end of line.  Returns in `Last` the last valid position in the
   --  `Into` buffer.  When there is no character to read, return True in
   --  the `Eof` indicator.
   --  ------------------------------
   overriding
   procedure Read (Input : in out File_Input_Stream;
                   Into  : in out Wiki.Strings.WString;
                   Last  : out Natural;
                   Eof   : out Boolean) is
      Available : Boolean;
      Pos       : Natural := Into'First;
      Char      : Wiki.Strings.WChar;
   begin
      Eof := False;
      while Pos <= Into'Last loop
         if Input.Stdin then
            Ada.Wide_Wide_Text_IO.Get_Immediate (Char, Available);
         else
            Ada.Wide_Wide_Text_IO.Get_Immediate (Input.File, Char, Available);
         end if;
         Into (Pos) := Char;
         Pos := Pos + 1;
         exit when Char = Helpers.LF or Char = Helpers.CR;
      end loop;
      Last := Pos - 1;

   exception
      when Ada.IO_Exceptions.End_Error =>
         Last := Pos - 1;
         Eof  := True;

   end Read;

   --  ------------------------------
   --  Open the file and prepare to write the output stream.
   --  ------------------------------
   procedure Open (Stream : in out File_Output_Stream;
                   Path   : in String;
                   Form   : in String := "") is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
      Ada.Wide_Wide_Text_IO.Open (Stream.File, Ada.Wide_Wide_Text_IO.Out_File, Path, Form);
      Ada.Wide_Wide_Text_IO.Set_Line_Length (Ada.Wide_Wide_Text_IO.Count'Last);
      Stream.Stdout := False;
   end Open;

   --  ------------------------------
   --  Create the file and prepare to write the output stream.
   --  ------------------------------
   procedure Create (Stream : in out File_Output_Stream;
                     Path   : in String;
                     Form   : in String := "") is
   begin
      Ada.Wide_Wide_Text_IO.Create (Stream.File, Ada.Wide_Wide_Text_IO.Out_File, Path, Form);
      Ada.Wide_Wide_Text_IO.Set_Line_Length (Ada.Wide_Wide_Text_IO.Count'Last);
      Stream.Stdout := False;
   end Create;

   --  ------------------------------
   --  Close the file.
   --  ------------------------------
   procedure Close (Stream : in out File_Output_Stream) is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
   end Close;

   --  ------------------------------
   --  Write the string to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream  : in out File_Output_Stream;
                    Content : in Wiki.Strings.WString) is
   begin
      if not Stream.Stdout then
         Ada.Wide_Wide_Text_IO.Put (Stream.File, Content);
      else
         Ada.Wide_Wide_Text_IO.Put (Content);
      end if;
   end Write;

   --  ------------------------------
   --  Write a single character to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream : in out File_Output_Stream;
                    Char   : in Wiki.Strings.WChar) is
   begin
      if not Stream.Stdout then
         Ada.Wide_Wide_Text_IO.Put (Stream.File, Char);
      else
         Ada.Wide_Wide_Text_IO.Put (Char);
      end if;
   end Write;

   --  ------------------------------
   --  Close the stream.
   --  ------------------------------
   overriding
   procedure Finalize (Stream : in out File_Output_Stream) is
   begin
      Stream.Close;
   end Finalize;

end Wiki.Streams.Text_IO;

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

with Wiki.Helpers;
package body Wiki.Streams.Text_IO is

   --  ------------------------------
   --  Open the file and prepare to read the input stream.
   --  ------------------------------
   procedure Open (Stream : in out File_Input_Stream;
                   Path   : in String;
                   Form   : in String := "") is
   begin
      Ada.Wide_Wide_Text_IO.Open (Stream.File, Ada.Wide_Wide_Text_IO.In_File, Path, Form);
      Stream.Stdin := False;
   end Open;

   --  ------------------------------
   --  Close the file.
   --  ------------------------------
   procedure Close (Stream : in out File_Input_Stream) is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
   end Close;

   --  ------------------------------
   --  Close the stream.
   --  ------------------------------
   overriding
   procedure Finalize (Stream : in out File_Input_Stream) is
   begin
      Stream.Close;
   end Finalize;

   --  ------------------------------
   --  Read the input stream and fill the `Into` buffer until either it is full or
   --  we reach the end of line.  Returns in `Last` the last valid position in the
   --  `Into` buffer.  When there is no character to read, return True in
   --  the `Eof` indicator.
   --  ------------------------------
   overriding
   procedure Read (Input : in out File_Input_Stream;
                   Into  : in out Wiki.Strings.WString;
                   Last  : out Natural;
                   Eof   : out Boolean) is
      Available : Boolean;
      Pos       : Natural := Into'First;
      Char      : Wiki.Strings.WChar;
   begin
      if Input.Stdin then
         if not Ada.Wide_Wide_Text_Io.End_Of_File then
            Ada.Wide_Wide_Text_IO.Get_Line (Into, Last);
            if Last < Into'Last then
               Into (Last + 1) := Helpers.Lf;
               Last := Last + 1;
            end if;
            Eof := False;
         else
            Last := Into'First - 1;
            Eof := True;
         end if;
      else
         if not Ada.Wide_Wide_Text_Io.End_Of_File (Input.File) then
            Ada.Wide_Wide_Text_IO.Get_Line (Input.File, Into, Last);
            if Last < Into'Last then
               Into (Last + 1) := Helpers.Lf;
               Last := Last + 1;
            end if;
            Eof := False;
         else
            Last := Into'First - 1;
            Eof := True;
         end if;
      end if;
--      Eof := False;
--      while Pos <= Into'Last loop
--         if Input.Stdin then
--            Ada.Wide_Wide_Text_IO.Get_Immediate (Char, Available);
--         else
--            Ada.Wide_Wide_Text_IO.Get_Immediate (Input.File, Char, Available);
--         end if;
--         Into (Pos) := Char;
--         Pos := Pos + 1;
--         exit when Char = Helpers.LF or Char = Helpers.CR;
--      end loop;
--      Last := Pos - 1;

   exception
      when Ada.IO_Exceptions.End_Error =>
         Last := Pos - 1;
         Eof  := True;

   end Read;

   --  ------------------------------
   --  Open the file and prepare to write the output stream.
   --  ------------------------------
   procedure Open (Stream : in out File_Output_Stream;
                   Path   : in String;
                   Form   : in String := "") is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
      Ada.Wide_Wide_Text_IO.Open (Stream.File, Ada.Wide_Wide_Text_IO.Out_File, Path, Form);
      Ada.Wide_Wide_Text_IO.Set_Line_Length (Ada.Wide_Wide_Text_IO.Count'Last);
      Stream.Stdout := False;
   end Open;

   --  ------------------------------
   --  Create the file and prepare to write the output stream.
   --  ------------------------------
   procedure Create (Stream : in out File_Output_Stream;
                     Path   : in String;
                     Form   : in String := "") is
   begin
      Ada.Wide_Wide_Text_IO.Create (Stream.File, Ada.Wide_Wide_Text_IO.Out_File, Path, Form);
      Ada.Wide_Wide_Text_IO.Set_Line_Length (Ada.Wide_Wide_Text_IO.Count'Last);
      Stream.Stdout := False;
   end Create;

   --  ------------------------------
   --  Close the file.
   --  ------------------------------
   procedure Close (Stream : in out File_Output_Stream) is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
   end Close;

   --  ------------------------------
   --  Write the string to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream  : in out File_Output_Stream;
                    Content : in Wiki.Strings.WString) is
   begin
      if not Stream.Stdout then
         Ada.Wide_Wide_Text_IO.Put (Stream.File, Content);
      else
         Ada.Wide_Wide_Text_IO.Put (Content);
      end if;
   end Write;

   --  ------------------------------
   --  Write a single character to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream : in out File_Output_Stream;
                    Char   : in Wiki.Strings.WChar) is
   begin
      if not Stream.Stdout then
         Ada.Wide_Wide_Text_IO.Put (Stream.File, Char);
      else
         Ada.Wide_Wide_Text_IO.Put (Char);
      end if;
   end Write;

   --  ------------------------------
   --  Close the stream.
   --  ------------------------------
   overriding
   procedure Finalize (Stream : in out File_Output_Stream) is
   begin
      Stream.Close;
   end Finalize;

end Wiki.Streams.Text_IO;

Update to use Get_Line

Update to use Get_Line


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

with Util.Processes;
with Util.Beans.Objects;
with Util.Log.Loggers;
with Util.Streams.Pipes;
with Util.Streams.Texts;

with ADO.Sessions;

with AWA.Images.Models;
with AWA.Services.Contexts;
with AWA.Storages.Services;
with AWA.Storages.Modules;
with Ada.Strings.Unbounded;

with EL.Variables.Default;
with EL.Contexts.Default;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
package body AWA.Images.Services is

   package ASC renames Awa.Services.Contexts;

   --  ------------------------------
   --  Image Service
   --  ------------------------------

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Images.Services");

   --  ------------------------------
   --  Initializes the storage service.
   --  ------------------------------
   overriding
   procedure Initialize (Service : in out Image_Service;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      AWA.Modules.Module_Manager (Service).Initialize (Module);

      declare
         Ctx     : EL.Contexts.Default.Default_Context;
         Command : constant String := Module.Get_Config (PARAM_THUMBNAIL_COMMAND);
      begin
         Service.Thumbnail_Command := EL.Expressions.Create_Expression (Command, Ctx);

      exception
         when E : others =>
            Log.Error ("Invalid thumbnail command: ", E, True);
      end;
   end Initialize;

   procedure Create_Thumbnail (Service : in Image_Service;
                               Source  : in String;
                               Into    : in String;
                               Width   : out Natural;
                               Height  : out Natural) is
      Ctx       : EL.Contexts.Default.Default_Context;
      Variables : aliased EL.Variables.Default.Default_Variable_Mapper;

      Proc    : Util.Processes.Process;
      Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      Variables.Bind ("src", Util.Beans.Objects.To_Object (Source));
      Variables.Bind ("dst", Util.Beans.Objects.To_Object (Into));
      Ctx.Set_Variable_Mapper (Variables'Unchecked_Access);
      declare
         Cmd     : constant Util.Beans.Objects.Object := Service.Thumbnail_Command.Get_Value (Ctx);
         Command : constant String := Util.Beans.Objects.To_String (Cmd);
         Input   : Util.Streams.Texts.Reader_Stream;
      begin
         Width  := 0;
         Height := 0;
         Pipe.Open (Command, Util.Processes.READ);
         Input.Initialize (null, Pipe'Unchecked_Access, 1024);
         while not Input.Is_Eof loop
            declare
               Line : Ada.Strings.Unbounded.Unbounded_String;
               Pos  : Natural;
               Sep  : Natural;
               Last : Natural;
            begin
               Input.Read_Line (Into  => Line, Strip => False);
               exit when Ada.Strings.Unbounded.Length (Line) = 0;
               Log.Info ("Received: {0}", Line);

               --  The '-verbose' option of ImageMagick reports information about the original
               --  image.  Extract the picture width and height.
               --  image.png PNG 120x282 120x282+0+0 8-bit DirectClass 34.4KB 0.000u 0:00.018
               Pos := Ada.Strings.Unbounded.Index (Line, " ");
               if Pos > 0 and Width = 0 then
                  Pos := Ada.Strings.Unbounded.Index (Line, " ", Pos + 1);
                  if Pos > 0 then
                     Sep := Ada.Strings.Unbounded.Index (Line, "x", Pos + 1);
                     Last := Ada.Strings.Unbounded.Index (Line, " ", Pos + 1);
                     if Sep > 0 and Sep < Last then
                        Width := Natural'Value (Ada.Strings.Unbounded.Slice (Line, Pos + 1, Sep - 1));
                        Height := Natural'Value (Ada.Strings.Unbounded.Slice (Line, Sep + 1, Last - 1));
                     end if;
                  end if;
               end if;
            end;
         end loop;
         Pipe.Close;

         Util.Processes.Wait (Proc);
         if Pipe.Get_Exit_Status /= 0 then
            Log.Error ("Command {0} exited with status {1}", Command,
                       Integer'Image (Pipe.Get_Exit_Status));
         end if;
      end;
   end Create_Thumbnail;

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Build_Thumbnail (Service : in Image_Service;
                              Id      : in ADO.Identifier;
                              File    : in AWA.Storages.Models.Storage_Ref'Class) is

      Storage_Service : constant AWA.Storages.Services.Storage_Service_Access := AWA.Storages.Modules.Get_Storage_Manager;
      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      DB          : ADO.Sessions.Master_Session := ASC.Get_Master_Session (Ctx);
      Img         : AWA.Images.Models.Image_Ref;
      Local_Path  : Ada.Strings.Unbounded.Unbounded_String;
      Target_File : AWA.Storages.Storage_File;
      Local_File  : AWA.Storages.Storage_File;
      Width       : Natural;
      Height      : Natural;
   begin
      Img.Load (DB, Id);
      Storage_Service.Get_Local_File (From => Img.Get_Storage.Get_Id, Into => Local_File);
      Storage_Service.Create_Local_File (Target_File);
      Service.Create_Thumbnail (AWA.Storages.Get_Path (Local_File),
                                AWA.Storages.Get_Path (Target_File), Width, Height);
      Img.Set_Width (Width);
      Img.Set_Height (Height);
      Img.Set_Thumb_Width (64);
      Img.Set_Thumb_Height (64);
      Ctx.Start;
      Img.Save (DB);
--        Storage_Service.Save (Target_File);
      Ctx.Commit;
   end Build_Thumbnail;

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Create_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class) is
      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Img : AWA.Images.Models.Image_Ref;
   begin
      Ctx.Start;
      Img.Set_Width (0);
      Img.Set_Height (0);
      Img.Set_Thumb_Height (0);
      Img.Set_Thumb_Width (0);
      Img.Set_Storage (File);
      Img.Save (DB);
      Ctx.Commit;
   end Create_Image;

   --  Deletes the storage instance.
   procedure Delete_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class) is
   begin
      null;
   end Delete_Image;

end AWA.Images.Services;

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

with Util.Processes;
with Util.Beans.Objects;
with Util.Log.Loggers;
with Util.Streams.Pipes;
with Util.Streams.Texts;

with ADO.Sessions;

with AWA.Images.Models;
with AWA.Services.Contexts;
with AWA.Storages.Services;
with AWA.Storages.Modules;
with Ada.Strings.Unbounded;

with EL.Variables.Default;
with EL.Contexts.Default;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
package body AWA.Images.Services is

   package ASC renames Awa.Services.Contexts;

   --  ------------------------------
   --  Image Service
   --  ------------------------------

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Images.Services");

   --  ------------------------------
   --  Initializes the storage service.
   --  ------------------------------
   overriding
   procedure Initialize (Service : in out Image_Service;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      AWA.Modules.Module_Manager (Service).Initialize (Module);

      declare
         Ctx     : EL.Contexts.Default.Default_Context;
         Command : constant String := Module.Get_Config (PARAM_THUMBNAIL_COMMAND);
      begin
         Service.Thumbnail_Command := EL.Expressions.Create_Expression (Command, Ctx);

      exception
         when E : others =>
            Log.Error ("Invalid thumbnail command: ", E, True);
      end;
   end Initialize;

   procedure Create_Thumbnail (Service : in Image_Service;
                               Source  : in String;
                               Into    : in String;
                               Width   : out Natural;
                               Height  : out Natural) is
      Ctx       : EL.Contexts.Default.Default_Context;
      Variables : aliased EL.Variables.Default.Default_Variable_Mapper;

      Proc    : Util.Processes.Process;
      Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      Variables.Bind ("src", Util.Beans.Objects.To_Object (Source));
      Variables.Bind ("dst", Util.Beans.Objects.To_Object (Into));
      Ctx.Set_Variable_Mapper (Variables'Unchecked_Access);
      declare
         Cmd     : constant Util.Beans.Objects.Object := Service.Thumbnail_Command.Get_Value (Ctx);
         Command : constant String := Util.Beans.Objects.To_String (Cmd);
         Input   : Util.Streams.Texts.Reader_Stream;
      begin
         Width  := 0;
         Height := 0;
         Pipe.Open (Command, Util.Processes.READ);
         Input.Initialize (null, Pipe'Unchecked_Access, 1024);
         while not Input.Is_Eof loop
            declare
               Line : Ada.Strings.Unbounded.Unbounded_String;
               Pos  : Natural;
               Sep  : Natural;
               Last : Natural;
            begin
               Input.Read_Line (Into  => Line, Strip => False);
               exit when Ada.Strings.Unbounded.Length (Line) = 0;
               Log.Info ("Received: {0}", Line);

               --  The '-verbose' option of ImageMagick reports information about the original
               --  image.  Extract the picture width and height.
               --  image.png PNG 120x282 120x282+0+0 8-bit DirectClass 34.4KB 0.000u 0:00.018
               Pos := Ada.Strings.Unbounded.Index (Line, " ");
               if Pos > 0 and Width = 0 then
                  Pos := Ada.Strings.Unbounded.Index (Line, " ", Pos + 1);
                  if Pos > 0 then
                     Sep := Ada.Strings.Unbounded.Index (Line, "x", Pos + 1);
                     Last := Ada.Strings.Unbounded.Index (Line, "=", Pos + 1);
                     if Sep > 0 and Sep < Last then
                        Log.Info ("Dimension {0} - {1}..{2}",
                                  Ada.Strings.Unbounded.Slice (Line, Pos, Last),
                                  Natural'Image (Pos), Natural'Image (Last));
                        Width := Natural'Value (Ada.Strings.Unbounded.Slice (Line, Pos + 1, Sep - 1));
                        Height := Natural'Value (Ada.Strings.Unbounded.Slice (Line, Sep + 1, Last - 1));
                     end if;
                  end if;
               end if;
            end;
         end loop;
         Pipe.Close;

         Util.Processes.Wait (Proc);
         if Pipe.Get_Exit_Status /= 0 then
            Log.Error ("Command {0} exited with status {1}", Command,
                       Integer'Image (Pipe.Get_Exit_Status));
         end if;
      end;
   end Create_Thumbnail;

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Build_Thumbnail (Service : in Image_Service;
                              Id      : in ADO.Identifier;
                              File    : in AWA.Storages.Models.Storage_Ref'Class) is

      Storage_Service : constant AWA.Storages.Services.Storage_Service_Access := AWA.Storages.Modules.Get_Storage_Manager;
      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      DB          : ADO.Sessions.Master_Session := ASC.Get_Master_Session (Ctx);
      Img         : AWA.Images.Models.Image_Ref;
      Local_Path  : Ada.Strings.Unbounded.Unbounded_String;
      Target_File : AWA.Storages.Storage_File;
      Local_File  : AWA.Storages.Storage_File;
      Width       : Natural;
      Height      : Natural;
   begin
      Img.Load (DB, Id);
      Storage_Service.Get_Local_File (From => Img.Get_Storage.Get_Id, Into => Local_File);
      Storage_Service.Create_Local_File (Target_File);
      Service.Create_Thumbnail (AWA.Storages.Get_Path (Local_File),
                                AWA.Storages.Get_Path (Target_File), Width, Height);
      Img.Set_Width (Width);
      Img.Set_Height (Height);
      Img.Set_Thumb_Width (64);
      Img.Set_Thumb_Height (64);
      Ctx.Start;
      Img.Save (DB);
--        Storage_Service.Save (Target_File);
      Ctx.Commit;
   end Build_Thumbnail;

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Create_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class) is
      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Img : AWA.Images.Models.Image_Ref;
   begin
      Ctx.Start;
      Img.Set_Width (0);
      Img.Set_Height (0);
      Img.Set_Thumb_Height (0);
      Img.Set_Thumb_Width (0);
      Img.Set_Storage (File);
      Img.Save (DB);
      Ctx.Commit;
   end Create_Image;

   --  Deletes the storage instance.
   procedure Delete_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class) is
   begin
      null;
   end Delete_Image;

end AWA.Images.Services;

Fix extraction of image dimension

Fix extraction of image dimension


-----------------------------------------------------------------------
--  awa-wikis-tests -- Unit tests for wikis module
--  Copyright (C) 2018, 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 Util.Test_Caller;
with Util.Strings;

with ADO;
with Servlet.Streams;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Tests;
with AWA.Tests.Helpers.Users;
with AWA.Storages.Beans;
with AWA.Storages.Models;
with AWA.Storages.Services;
with AWA.Storages.Modules;
with AWA.Services.Contexts;
with Security.Contexts;

package body AWA.Wikis.Tests is

   use Ada.Strings.Unbounded;
   use AWA.Tests;
   use type AWA.Storages.Services.Storage_Service_Access;

   package Caller is new Util.Test_Caller (Test, "Wikis.Beans");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load_List (Anonymous)",
                       Test_Anonymous_Access'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Save",
                       Test_Create_Wiki'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load (missing)",
                       Test_Missing_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load (image)",
                       Test_Page_With_Image'Access);
   end Add_Tests;

   --  ------------------------------
   --  Setup an image for the wiki page.
   --  ------------------------------
   procedure Make_Wiki_Image (T : in out Test) is
      Sec_Ctx : Security.Contexts.Security_Context;
      Context : AWA.Services.Contexts.Service_Context;
      Folder  : AWA.Storages.Beans.Folder_Bean;
      Store   : AWA.Storages.Models.Storage_Ref;
      Mgr     : AWA.Storages.Services.Storage_Service_Access;
      Outcome : Ada.Strings.Unbounded.Unbounded_String;
      Path    : constant String
        := Util.Tests.Get_Path ("regtests/files/images/Ada-Lovelace.jpg");
      Wiki      : constant String := To_String (T.Wiki_Ident);
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      Mgr := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (Mgr /= null, "Null storage manager");

      --  Make a storage folder.
      Folder.Module := AWA.Storages.Modules.Get_Storage_Module;
      Folder.Set_Name ("Images");
      Folder.Save (Outcome);

      Store.Set_Folder (Folder);
      Store.Set_Is_Public (True);
      Store.Set_Mime_Type ("image/jpg");
      Store.Set_Name ("Ada Lovelace");
      Mgr.Save (Store, Path, AWA.Storages.Models.FILE);

      declare
         Request : ASF.Requests.Mockup.Request;
         Reply   : ASF.Responses.Mockup.Response;
         Id      : constant String := ADO.Identifier'Image (Store.Get_Id);
      begin
         T.Image_Ident := To_Unbounded_String (Id (Id'First + 1 .. Id'Last));
         AWA.Tests.Helpers.Users.Login ("test-storage@test.com", Request);
         ASF.Tests.Do_Get (Request, Reply,
                           "/wikis/images/" & Wiki & "/"
                           & Id (Id'First + 1 .. Id'Last)
                           & "/original/Ada-Lovelace.jpg",
                           "wiki-image-get-Ada-Lovelace.jpg");
         ASF.Tests.Assert_Header (T, "Content-Type", "image/jpg", Reply);
         Util.Tests.Assert_Equals (T, Servlet.Responses.SC_OK,
                                   Reply.Get_Status,
                                   "Invalid response for image");
      end;
   end Make_Wiki_Image;

   --  ------------------------------
   --  Get some access on the wiki as anonymous users.
   --  ------------------------------
   procedure Verify_Anonymous (T     : in out Test;
                               Page  : in String;
                               Title : in String) is
      pragma Unreferenced (Title);
      function Get_Link (Title : in String) return String;

      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;

      function Get_Link (Title : in String) return String is
         Stream  : Servlet.Streams.Print_Stream := Reply.Get_Output_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Reply.Read_Content (Content);
         Stream.Write (Content);
         return AWA.Tests.Helpers.Extract_Link (To_String (Content), Title);
      end Get_Link;

   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/tags/" & Wiki,
                        "wiki-list-tagged.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki tag page is invalid");

      if Page'Length > 0 then
         ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/" & Page,
                           "wiki-page-" & Page & ".html");
         ASF.Tests.Assert_Contains (T, "The wiki page content", Reply,
                                    "Wiki page " & Page & " is invalid");
         declare
            Info    : constant String := Get_Link ("Info");
            History : constant String := Get_Link ("History");
         begin
            Util.Tests.Assert_Matches (T, "/asfunit/wikis/info/[0-9]+/[0-9]+$", Info,
                                    "Invalid wiki info link in the response");
            Util.Tests.Assert_Matches (T, "/asfunit/wikis/history/[0-9]+/[0-9]+$", History,
                                       "Invalid wiki history link in the response");

            --  Get the information page.
            ASF.Tests.Do_Get (Request, Reply, Info (Info'First + 8 .. Info'Last),
                              "wiki-info-" & Page & ".html");
            ASF.Tests.Assert_Contains (T, "wiki-word-list", Reply,
                                       "Wiki info page " & Page & " is invalid");

            --  Get the history page.
            ASF.Tests.Do_Get (Request, Reply, History (History'First + 8 .. History'Last),
                              "wiki-history-" & Page & ".html");
            ASF.Tests.Assert_Contains (T, "wiki-page-version", Reply,
                                       "Wiki history page " & Page & " is invalid");

         end;
      end if;
   end Verify_Anonymous;

   --  ------------------------------
   --  Verify that the wiki lists contain the given page.
   --  ------------------------------
   procedure Verify_List_Contains (T    : in out Test;
                                   Page : in String) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list recent page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/popular",
                        "wiki-list-popular.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list popular page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list popular page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/name",
                        "wiki-list-name.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list name page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list name page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/name/grid",
                        "wiki-list-name-grid.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list name/grid page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list name/grid page does not reference the page");

   end Verify_List_Contains;

   --  ------------------------------
   --  Test access to the blog as anonymous user.
   --  ------------------------------
   procedure Test_Anonymous_Access (T : in out Test) is
   begin
      T.Verify_Anonymous ("", "");
   end Test_Anonymous_Access;

   --  ------------------------------
   --  Create a wiki page.
   --  ------------------------------
   procedure Create_Page (T       : in out Test;
                          Request : in out ASF.Requests.Mockup.Request;
                          Reply   : in out ASF.Responses.Mockup.Response;
                          Name    : in String;
                          Title   : in String) is
   begin
      Request.Set_Parameter ("page-wiki-id", To_String (T.Wiki_Ident));
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("page-title", Title);
      Request.Set_Parameter ("text", "# Main title" & ASCII.LF
                             & "* The wiki page content." & ASCII.LF
                             & "* Second item." & ASCII.LF
                             & ASCII.LF
                             & "![Ada Lovelace](Images/Ada-Lovelace.jpg)");
      Request.Set_Parameter ("name", Name);
      Request.Set_Parameter ("comment", "Created wiki page " & Name);
      Request.Set_Parameter ("save", "1");
      Request.Set_Parameter ("page-is-public", "1");
      Request.Set_Parameter ("wiki-format", "FORMAT_MARKDOWN");
      ASF.Tests.Do_Post (Request, Reply, "/wikis/create.html", "create-wiki.html");

      T.Page_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/view/"
                                                & To_String (T.Wiki_Ident) & "/");

      Util.Tests.Assert_Equals (T, Name, To_String (T.Page_Ident),
                                "Invalid redirect after wiki page creation");

      --  Remove the 'wikiPage' bean from the request so that we get a new instance
      --  for the next call.
      Request.Remove_Attribute ("wikiPage");
   end Create_Page;

   --  ------------------------------
   --  Test creation of blog by simulating web requests.
   --  ------------------------------
   procedure Test_Create_Wiki (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      Request.Set_Parameter ("title", "The Wiki Space Title");
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("create", "1");
      ASF.Tests.Do_Post (Request, Reply, "/wikis/setup.html", "setup-wiki.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after wiki space creation");
      declare
         Ident : constant String
           := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/list/");
         Pos   : constant Natural
           := Util.Strings.Index (Ident, '/');
      begin
         Util.Tests.Assert_Matches (T, "^[0-9]+/recent/grid$", Ident,
                                    "Invalid wiki space identifier in the response");
         T.Wiki_Ident := To_Unbounded_String (Ident (Ident'First .. Pos - 1));
      end;
      T.Create_Page (Request, Reply, "WikiPageTestName", "Wiki page title1");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      T.Create_Page (Request, Reply, "WikiSecondPageName", "Wiki page title2");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      T.Create_Page (Request, Reply, "WikiThirdPageName", "Wiki page title3");

      T.Verify_Anonymous ("WikiPageTestName", "Wiki page title1");
      T.Verify_Anonymous ("WikiSecondPageName", "Wiki page title2");
      T.Verify_Anonymous ("WikiThirdPageName", "Wiki page title3");

   end Test_Create_Wiki;

   --  ------------------------------
   --  Test getting a wiki page which does not exist.
   --  ------------------------------
   procedure Test_Missing_Page (T : in out Test) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/MissingPage",
                        "wiki-page-missing.html");
      ASF.Tests.Assert_Matches (T, ".title.Wiki page does not exist./title.", Reply,
                                "Wiki page 'MissingPage' is invalid",
                                ASF.Responses.SC_NOT_FOUND);
      ASF.Tests.Assert_Matches (T, ".h2.MissingPage./h2.", Reply,
                                "Wiki page 'MissingPage' header is invalid",
                                ASF.Responses.SC_NOT_FOUND);
   end Test_Missing_Page;

   --  ------------------------------
   --  Test creation of wiki page with an image.
   --  ------------------------------
   procedure Test_Page_With_Image (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Wiki      : constant String := To_String (T.Wiki_Ident);
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);

      T.Make_Wiki_Image;
      T.Create_Page (Request, Reply, "WikiImageTest", "Wiki image title3");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/WikiImageTest",
                        "wiki-image-test.html");
      ASF.Tests.Assert_Matches (T, "",
                                Reply,
                                "Wiki page missing image link",
                                ASF.Responses.SC_OK);

   end Test_Page_With_Image;

end AWA.Wikis.Tests;

-----------------------------------------------------------------------
--  awa-wikis-tests -- Unit tests for wikis module
--  Copyright (C) 2018, 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 Util.Test_Caller;
with Util.Strings;

with ADO;
with Servlet.Streams;
with ASF.Tests;
with AWA.Tests.Helpers.Users;
with AWA.Storages.Beans;
with AWA.Storages.Models;
with AWA.Storages.Services;
with AWA.Storages.Modules;
with AWA.Services.Contexts;
with Security.Contexts;

package body AWA.Wikis.Tests is

   use Ada.Strings.Unbounded;
   use AWA.Tests;
   use type AWA.Storages.Services.Storage_Service_Access;

   package Caller is new Util.Test_Caller (Test, "Wikis.Beans");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load_List (Anonymous)",
                       Test_Anonymous_Access'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Save",
                       Test_Create_Wiki'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load (missing)",
                       Test_Missing_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load (image)",
                       Test_Page_With_Image'Access);
   end Add_Tests;

   --  ------------------------------
   --  Setup an image for the wiki page.
   --  ------------------------------
   procedure Make_Wiki_Image (T : in out Test) is
      Sec_Ctx : Security.Contexts.Security_Context;
      Context : AWA.Services.Contexts.Service_Context;
      Folder  : AWA.Storages.Beans.Folder_Bean;
      Store   : AWA.Storages.Models.Storage_Ref;
      Mgr     : AWA.Storages.Services.Storage_Service_Access;
      Outcome : Ada.Strings.Unbounded.Unbounded_String;
      Path    : constant String
        := Util.Tests.Get_Path ("regtests/files/images/Ada-Lovelace.jpg");
      Wiki      : constant String := To_String (T.Wiki_Ident);
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      Mgr := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (Mgr /= null, "Null storage manager");

      --  Make a storage folder.
      Folder.Module := AWA.Storages.Modules.Get_Storage_Module;
      Folder.Set_Name ("Images");
      Folder.Save (Outcome);

      Store.Set_Folder (Folder);
      Store.Set_Is_Public (True);
      Store.Set_Mime_Type ("image/jpg");
      Store.Set_Name ("Ada Lovelace");
      Mgr.Save (Store, Path, AWA.Storages.Models.FILE);

      declare
         Request : ASF.Requests.Mockup.Request;
         Reply   : ASF.Responses.Mockup.Response;
         Id      : constant String := ADO.Identifier'Image (Store.Get_Id);
      begin
         T.Image_Ident := To_Unbounded_String (Id (Id'First + 1 .. Id'Last));
         AWA.Tests.Helpers.Users.Login ("test-storage@test.com", Request);
         ASF.Tests.Do_Get (Request, Reply,
                           "/wikis/images/" & Wiki & "/"
                           & Id (Id'First + 1 .. Id'Last)
                           & "/original/Ada-Lovelace.jpg",
                           "wiki-image-get-Ada-Lovelace.jpg");
         ASF.Tests.Assert_Header (T, "Content-Type", "image/jpg", Reply);
         Util.Tests.Assert_Equals (T, Servlet.Responses.SC_OK,
                                   Reply.Get_Status,
                                   "Invalid response for image");

         T.Image_Link := To_Unbounded_String ("/wikis/images/" & Wiki
                                              & "/" & Id (Id'First + 1 .. Id'Last)
                                              & "/default/Ada-Lovelace.jpg");
      end;
   end Make_Wiki_Image;

   --  ------------------------------
   --  Get some access on the wiki as anonymous users.
   --  ------------------------------
   procedure Verify_Anonymous (T     : in out Test;
                               Page  : in String;
                               Title : in String) is
      pragma Unreferenced (Title);
      function Get_Link (Title : in String) return String;

      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;

      function Get_Link (Title : in String) return String is
         Stream  : Servlet.Streams.Print_Stream := Reply.Get_Output_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Reply.Read_Content (Content);
         Stream.Write (Content);
         return AWA.Tests.Helpers.Extract_Link (To_String (Content), Title);
      end Get_Link;

   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/tags/" & Wiki,
                        "wiki-list-tagged.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki tag page is invalid");

      if Page'Length > 0 then
         ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/" & Page,
                           "wiki-page-" & Page & ".html");
         ASF.Tests.Assert_Contains (T, "The wiki page content", Reply,
                                    "Wiki page " & Page & " is invalid");
         declare
            Info    : constant String := Get_Link ("Info");
            History : constant String := Get_Link ("History");
         begin
            Util.Tests.Assert_Matches (T, "/asfunit/wikis/info/[0-9]+/[0-9]+$", Info,
                                    "Invalid wiki info link in the response");
            Util.Tests.Assert_Matches (T, "/asfunit/wikis/history/[0-9]+/[0-9]+$", History,
                                       "Invalid wiki history link in the response");

            --  Get the information page.
            ASF.Tests.Do_Get (Request, Reply, Info (Info'First + 8 .. Info'Last),
                              "wiki-info-" & Page & ".html");
            ASF.Tests.Assert_Contains (T, "wiki-word-list", Reply,
                                       "Wiki info page " & Page & " is invalid");

            --  Get the history page.
            ASF.Tests.Do_Get (Request, Reply, History (History'First + 8 .. History'Last),
                              "wiki-history-" & Page & ".html");
            ASF.Tests.Assert_Contains (T, "wiki-page-version", Reply,
                                       "Wiki history page " & Page & " is invalid");

         end;
      end if;
   end Verify_Anonymous;

   --  ------------------------------
   --  Verify that the wiki lists contain the given page.
   --  ------------------------------
   procedure Verify_List_Contains (T    : in out Test;
                                   Page : in String) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list recent page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/popular",
                        "wiki-list-popular.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list popular page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list popular page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/name",
                        "wiki-list-name.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list name page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list name page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/name/grid",
                        "wiki-list-name-grid.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list name/grid page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list name/grid page does not reference the page");

   end Verify_List_Contains;

   --  ------------------------------
   --  Test access to the blog as anonymous user.
   --  ------------------------------
   procedure Test_Anonymous_Access (T : in out Test) is
   begin
      T.Verify_Anonymous ("", "");
   end Test_Anonymous_Access;

   --  ------------------------------
   --  Create a wiki page.
   --  ------------------------------
   procedure Create_Page (T       : in out Test;
                          Request : in out ASF.Requests.Mockup.Request;
                          Reply   : in out ASF.Responses.Mockup.Response;
                          Name    : in String;
                          Title   : in String) is
   begin
      Request.Set_Parameter ("page-wiki-id", To_String (T.Wiki_Ident));
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("page-title", Title);
      Request.Set_Parameter ("text", "# Main title" & ASCII.LF
                             & "* The wiki page content." & ASCII.LF
                             & "* Second item." & ASCII.LF
                             & ASCII.LF
                             & "![Ada Lovelace](Images/Ada-Lovelace.jpg)");
      Request.Set_Parameter ("name", Name);
      Request.Set_Parameter ("comment", "Created wiki page " & Name);
      Request.Set_Parameter ("save", "1");
      Request.Set_Parameter ("page-is-public", "1");
      Request.Set_Parameter ("wiki-format", "FORMAT_MARKDOWN");
      ASF.Tests.Do_Post (Request, Reply, "/wikis/create.html", "create-wiki.html");

      T.Page_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/view/"
                                                & To_String (T.Wiki_Ident) & "/");

      Util.Tests.Assert_Equals (T, Name, To_String (T.Page_Ident),
                                "Invalid redirect after wiki page creation");

      --  Remove the 'wikiPage' bean from the request so that we get a new instance
      --  for the next call.
      Request.Remove_Attribute ("wikiPage");
   end Create_Page;

   --  ------------------------------
   --  Test creation of blog by simulating web requests.
   --  ------------------------------
   procedure Test_Create_Wiki (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      Request.Set_Parameter ("title", "The Wiki Space Title");
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("create", "1");
      ASF.Tests.Do_Post (Request, Reply, "/wikis/setup.html", "setup-wiki.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after wiki space creation");
      declare
         Ident : constant String
           := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/list/");
         Pos   : constant Natural
           := Util.Strings.Index (Ident, '/');
      begin
         Util.Tests.Assert_Matches (T, "^[0-9]+/recent/grid$", Ident,
                                    "Invalid wiki space identifier in the response");
         T.Wiki_Ident := To_Unbounded_String (Ident (Ident'First .. Pos - 1));
      end;
      T.Create_Page (Request, Reply, "WikiPageTestName", "Wiki page title1");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      T.Create_Page (Request, Reply, "WikiSecondPageName", "Wiki page title2");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      T.Create_Page (Request, Reply, "WikiThirdPageName", "Wiki page title3");

      T.Verify_Anonymous ("WikiPageTestName", "Wiki page title1");
      T.Verify_Anonymous ("WikiSecondPageName", "Wiki page title2");
      T.Verify_Anonymous ("WikiThirdPageName", "Wiki page title3");

   end Test_Create_Wiki;

   --  ------------------------------
   --  Test getting a wiki page which does not exist.
   --  ------------------------------
   procedure Test_Missing_Page (T : in out Test) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/MissingPage",
                        "wiki-page-missing.html");
      ASF.Tests.Assert_Matches (T, ".title.Wiki page does not exist./title.", Reply,
                                "Wiki page 'MissingPage' is invalid",
                                ASF.Responses.SC_NOT_FOUND);
      ASF.Tests.Assert_Matches (T, ".h2.MissingPage./h2.", Reply,
                                "Wiki page 'MissingPage' header is invalid",
                                ASF.Responses.SC_NOT_FOUND);
   end Test_Missing_Page;

   --  ------------------------------
   --  Test creation of wiki page with an image.
   --  ------------------------------
   procedure Test_Page_With_Image (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Wiki      : constant String := To_String (T.Wiki_Ident);
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);

      T.Make_Wiki_Image;
      T.Create_Page (Request, Reply, "WikiImageTest", "Wiki image title3");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/WikiImageTest",
                        "wiki-image-test.html");
      ASF.Tests.Assert_Matches (T, "",
                                Reply,
                                "Wiki page missing image link",
                                ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply,
                        To_String (T.Image_Link),
                        "wiki-image-get-Ada-Lovelace.jpg");
      ASF.Tests.Assert_Header (T, "Content-Type", "image/jpg", Reply);
      Util.Tests.Assert_Equals (T, Servlet.Responses.SC_OK,
                                Reply.Get_Status,
                                "Invalid response for image");

   end Test_Page_With_Image;

end AWA.Wikis.Tests;

Update the Test_Page_With_Image test to get the image included in the page through the wiki image servlet


-----------------------------------------------------------------------
--  mat-formats - Format various types for the console or GUI interface
--  Copyright (C) 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.Strings.Unbounded;

with MAT.Types;
with MAT.Events.Targets;
package MAT.Formats is

   --  Format the address into a string.
   function Addr (Value : in MAT.Types.Target_Addr) return String;

   --  Format the size into a string.
   function Size (Value : in MAT.Types.Target_Size) return String;

   --  Format a file, line, function information into a string.
   function Location (File : in Ada.Strings.Unbounded.Unbounded_String;
                      Line : in Natural;
                      Func : in Ada.Strings.Unbounded.Unbounded_String) return String;

   --  Format a short description of the event.
   function Event (Item    : in MAT.Events.Targets.Probe_Event_Type;
                   Related : in MAT.Events.Targets.Target_Event_Vector) return String;

end MAT.Formats;

-----------------------------------------------------------------------
--  mat-formats - Format various types for the console or GUI interface
--  Copyright (C) 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.Strings.Unbounded;

with MAT.Types;
with MAT.Events.Targets;
package MAT.Formats is

   --  Format the address into a string.
   function Addr (Value : in MAT.Types.Target_Addr) return String;

   --  Format the size into a string.
   function Size (Value : in MAT.Types.Target_Size) return String;

   --  Format the time relative to the start time.
   function Time (Value : in MAT.Types.Target_Tick_Ref;
                  Start : in MAT.Types.Target_Tick_Ref) return String;

   --  Format a file, line, function information into a string.
   function Location (File : in Ada.Strings.Unbounded.Unbounded_String;
                      Line : in Natural;
                      Func : in Ada.Strings.Unbounded.Unbounded_String) return String;

   --  Format a short description of the event.
   function Event (Item    : in MAT.Events.Targets.Probe_Event_Type;
                   Related : in MAT.Events.Targets.Target_Event_Vector) return String;

end MAT.Formats;

Declare the Time function to format a time


-----------------------------------------------------------------------
--  Clients - Abstract representation of client information
--  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.
-----------------------------------------------------------------------
package body MAT.Targets is

   --  ------------------------------
   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
   begin
      MAT.Memory.Targets.Initialize (Memory => Target.Memory,
                                     Reader => Reader);
   end Initialize;

end MAT.Targets;

-----------------------------------------------------------------------
--  Clients - Abstract representation of client information
--  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.
-----------------------------------------------------------------------
package body MAT.Targets is

   --  ------------------------------
   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
   begin
      MAT.Memory.Targets.Initialize (Memory => Target.Memory,
                                     Reader => Reader);
   end Initialize;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Process : out Target_Process_Type_Access) is
   begin
      Process := new Target_Process_Type;
      Process.Pid := Pid;
   end Create_Process;

end MAT.Targets;

Implement the Create_Process procedure

Implement the Create_Process procedure


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

with Ada.Directories;

with Util.Files;
with Util.Log.Loggers;

with EL.Variables;
with ASF.Applications.Main;
with ASF.Views.Nodes.Facelets;
package body ASF.Contexts.Facelets is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("ASF.Contexts.Facelets");

   --  ------------------------------
   --  Get the EL context for evaluating expressions.
   --  ------------------------------
   function Get_ELContext (Context : in Facelet_Context)
                           return EL.Contexts.ELContext_Access is
   begin
      return Context.Context;
   end Get_ELContext;

   --  ------------------------------
   --  Set the EL context for evaluating expressions.
   --  ------------------------------
   procedure Set_ELContext (Context   : in out Facelet_Context;
                            ELContext : in EL.Contexts.ELContext_Access) is
   begin
      Context.Context := ELContext;
   end Set_ELContext;

   --  ------------------------------
   --  Get the function mapper associated with the EL context.
   --  ------------------------------
   function Get_Function_Mapper (Context : in Facelet_Context)
                                 return EL.Functions.Function_Mapper_Access is
      use EL.Contexts;
   begin
      if Context.Context = null then
         return null;
      else
         return Context.Context.Get_Function_Mapper;
      end if;
   end Get_Function_Mapper;

   --  ------------------------------
   --  Set the attribute having given name with the value.
   --  ------------------------------
   procedure Set_Attribute (Context : in out Facelet_Context;
                            Name    : in String;
                            Value   : in EL.Objects.Object) is
   begin
      null;
   end Set_Attribute;

   --  ------------------------------
   --  Set the attribute having given name with the value.
   --  ------------------------------
   procedure Set_Attribute (Context : in out Facelet_Context;
                            Name    : in Unbounded_String;
                            Value   : in EL.Objects.Object) is
   begin
      null;
   end Set_Attribute;

   --  ------------------------------
   --  Set the attribute having given name with the expression.
   --  ------------------------------
   procedure Set_Variable (Context : in out Facelet_Context;
                           Name    : in Unbounded_String;
                           Value   : in EL.Expressions.Expression) is
      Mapper : constant access EL.Variables.Variable_Mapper'Class
        := Context.Context.Get_Variable_Mapper;
   begin
      if Mapper /= null then
         Mapper.Set_Variable (Name, Value);
      end if;
   end Set_Variable;

   --  Set the attribute having given name with the expression.
   procedure Set_Variable (Context : in out Facelet_Context;
                           Name    : in String;
                           Value   : in EL.Expressions.Expression) is
      N : Unbounded_String := To_Unbounded_String (Name);
   begin
      Set_Variable (Context, N, Value);
   end Set_Variable;

   --  ------------------------------
   --  Include the facelet from the given source file.
   --  The included views appended to the parent component tree.
   --  ------------------------------
   procedure Include_Facelet (Context : in out Facelet_Context;
                              Source  : in String;
                              Parent  : in Base.UIComponent_Access) is
   begin
      null;
   end Include_Facelet;

   --  ------------------------------
   --  Include the definition having the given name.
   --  ------------------------------
   procedure Include_Definition (Context : in out Facelet_Context;
                                 Name    : in Unbounded_String;
                                 Parent  : in Base.UIComponent_Access;
                                 Found   : out Boolean) is
      Node      : Composition_Tag_Node;
      Iter      : Defines_Vector.Cursor := Context.Defines.Last;
      The_Name  : aliased constant String := To_String (Name);
   begin
      if Context.Inserts.Contains (The_Name'Unchecked_Access) then
         Found := True;
         return;
      end if;
      Context.Inserts.Insert (The_Name'Unchecked_Access);
      while Defines_Vector.Has_Element (Iter) loop
         Node := Defines_Vector.Element (Iter);
         Node.Include_Definition (Parent  => Parent,
                                  Context => Context,
                                  Name    => Name,
                                  Found   => Found);
         if Found then
            Context.Inserts.Delete (The_Name'Unchecked_Access);
            return;
         end if;
         Defines_Vector.Previous (Iter);
      end loop;
      Found := False;
      Context.Inserts.Delete (The_Name'Unchecked_Access);
   end Include_Definition;

   --  ------------------------------
   --  Push into the current facelet context the <ui:define> nodes contained in
   --  the composition/decorate tag.
   --  ------------------------------
   procedure Push_Defines (Context : in out Facelet_Context;
                           Node : access ASF.Views.Nodes.Facelets.Composition_Tag_Node) is
   begin
      Context.Defines.Append (Node.all'Access);
   end Push_Defines;

   --  ------------------------------
   --  Pop from the current facelet context the <ui:define> nodes.
   --  ------------------------------
   procedure Pop_Defines (Context : in out Facelet_Context) is
      use Ada.Containers;
   begin
      if Context.Defines.Length > 0 then
         Context.Defines.Delete_Last;
      end if;
   end Pop_Defines;

   --  ------------------------------
   --  Set the path to resolve relative facelet paths and get the previous path.
   --  ------------------------------
   procedure Set_Relative_Path (Context  : in out Facelet_Context;
                                Path     : in String;
                                Previous : out Unbounded_String) is
   begin
      Log.Debug ("Set facelet relative path: {0}", Path);

      Previous := Context.Path;
      Context.Path := To_Unbounded_String (Ada.Directories.Containing_Directory (Path));
   end Set_Relative_Path;

   --  ------------------------------
   --  Set the path to resolve relative facelet paths.
   --  ------------------------------
   procedure Set_Relative_Path (Context  : in out Facelet_Context;
                                Path     : in Unbounded_String) is
   begin
      Log.Debug ("Set facelet relative path: {0}", Path);

      Context.Path := Path;
   end Set_Relative_Path;

   --  ------------------------------
   --  Resolve the facelet relative path
   --  ------------------------------
   function Resolve_Path (Context : Facelet_Context;
                          Path    : String) return String is
   begin
      if Path (Path'First) = '/' then
         return Path;
      else
         Log.Debug ("Resolve {0} with context {1}", Path, To_String (Context.Path));
         return Util.Files.Compose (To_String (Context.Path), Path);
      end if;
   end Resolve_Path;

   --  ------------------------------
   --  Get a converter from a name.
   --  Returns the converter object or null if there is no converter.
   --  ------------------------------
   function Get_Converter (Context : in Facelet_Context;
                           Name    : in EL.Objects.Object)
                           return ASF.Converters.Converter_Access is
   begin
      return Facelet_Context'Class (Context).Get_Application.Find (Name);
   end Get_Converter;

   --  ------------------------------
   --  Get a validator from a name.
   --  Returns the validator object or null if there is no validator.
   --  ------------------------------
   function Get_Validator (Context : in Facelet_Context;
                           Name    : in EL.Objects.Object)
                           return ASF.Validators.Validator_Access is
   begin
      return Facelet_Context'Class (Context).Get_Application.Find_Validator (Name);
   end Get_Validator;

end ASF.Contexts.Facelets;

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

with Ada.Directories;

with Util.Files;
with Util.Log.Loggers;

with EL.Variables;
with ASF.Applications.Main;
with ASF.Views.Nodes.Facelets;
package body ASF.Contexts.Facelets is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("ASF.Contexts.Facelets");

   --  ------------------------------
   --  Get the EL context for evaluating expressions.
   --  ------------------------------
   function Get_ELContext (Context : in Facelet_Context)
                           return EL.Contexts.ELContext_Access is
   begin
      return Context.Context;
   end Get_ELContext;

   --  ------------------------------
   --  Set the EL context for evaluating expressions.
   --  ------------------------------
   procedure Set_ELContext (Context   : in out Facelet_Context;
                            ELContext : in EL.Contexts.ELContext_Access) is
   begin
      Context.Context := ELContext;
   end Set_ELContext;

   --  ------------------------------
   --  Get the function mapper associated with the EL context.
   --  ------------------------------
   function Get_Function_Mapper (Context : in Facelet_Context)
                                 return EL.Functions.Function_Mapper_Access is
      use EL.Contexts;
   begin
      if Context.Context = null then
         return null;
      else
         return Context.Context.Get_Function_Mapper;
      end if;
   end Get_Function_Mapper;

   --  ------------------------------
   --  Set the attribute having given name with the value.
   --  ------------------------------
   procedure Set_Attribute (Context : in out Facelet_Context;
                            Name    : in String;
                            Value   : in EL.Objects.Object) is
   begin
      null;
   end Set_Attribute;

   --  ------------------------------
   --  Set the attribute having given name with the value.
   --  ------------------------------
   procedure Set_Attribute (Context : in out Facelet_Context;
                            Name    : in Unbounded_String;
                            Value   : in EL.Objects.Object) is
   begin
      null;
   end Set_Attribute;

   --  ------------------------------
   --  Set the attribute having given name with the expression.
   --  ------------------------------
   procedure Set_Variable (Context : in out Facelet_Context;
                           Name    : in Unbounded_String;
                           Value   : in EL.Expressions.Expression) is
      Mapper : constant access EL.Variables.Variable_Mapper'Class
        := Context.Context.Get_Variable_Mapper;
   begin
      if Mapper /= null then
         Mapper.Set_Variable (Name, Value);
      end if;
   end Set_Variable;

   --  Set the attribute having given name with the expression.
   procedure Set_Variable (Context : in out Facelet_Context;
                           Name    : in String;
                           Value   : in EL.Expressions.Expression) is
      N : constant Unbounded_String := To_Unbounded_String (Name);
   begin
      Set_Variable (Context, N, Value);
   end Set_Variable;

   --  ------------------------------
   --  Include the facelet from the given source file.
   --  The included views appended to the parent component tree.
   --  ------------------------------
   procedure Include_Facelet (Context : in out Facelet_Context;
                              Source  : in String;
                              Parent  : in Base.UIComponent_Access) is
   begin
      null;
   end Include_Facelet;

   --  ------------------------------
   --  Include the definition having the given name.
   --  ------------------------------
   procedure Include_Definition (Context : in out Facelet_Context;
                                 Name    : in Unbounded_String;
                                 Parent  : in Base.UIComponent_Access;
                                 Found   : out Boolean) is
      Node      : Composition_Tag_Node;
      Iter      : Defines_Vector.Cursor := Context.Defines.Last;
      The_Name  : aliased constant String := To_String (Name);
   begin
      if Context.Inserts.Contains (The_Name'Unchecked_Access) then
         Found := True;
         return;
      end if;
      Context.Inserts.Insert (The_Name'Unchecked_Access);
      while Defines_Vector.Has_Element (Iter) loop
         Node := Defines_Vector.Element (Iter);
         Node.Include_Definition (Parent  => Parent,
                                  Context => Context,
                                  Name    => Name,
                                  Found   => Found);
         if Found then
            Context.Inserts.Delete (The_Name'Unchecked_Access);
            return;
         end if;
         Defines_Vector.Previous (Iter);
      end loop;
      Found := False;
      Context.Inserts.Delete (The_Name'Unchecked_Access);
   end Include_Definition;

   --  ------------------------------
   --  Push into the current facelet context the <ui:define> nodes contained in
   --  the composition/decorate tag.
   --  ------------------------------
   procedure Push_Defines (Context : in out Facelet_Context;
                           Node : access ASF.Views.Nodes.Facelets.Composition_Tag_Node) is
   begin
      Context.Defines.Append (Node.all'Access);
   end Push_Defines;

   --  ------------------------------
   --  Pop from the current facelet context the <ui:define> nodes.
   --  ------------------------------
   procedure Pop_Defines (Context : in out Facelet_Context) is
      use Ada.Containers;
   begin
      if Context.Defines.Length > 0 then
         Context.Defines.Delete_Last;
      end if;
   end Pop_Defines;

   --  ------------------------------
   --  Set the path to resolve relative facelet paths and get the previous path.
   --  ------------------------------
   procedure Set_Relative_Path (Context  : in out Facelet_Context;
                                Path     : in String;
                                Previous : out Unbounded_String) is
   begin
      Log.Debug ("Set facelet relative path: {0}", Path);

      Previous := Context.Path;
      Context.Path := To_Unbounded_String (Ada.Directories.Containing_Directory (Path));
   end Set_Relative_Path;

   --  ------------------------------
   --  Set the path to resolve relative facelet paths.
   --  ------------------------------
   procedure Set_Relative_Path (Context  : in out Facelet_Context;
                                Path     : in Unbounded_String) is
   begin
      Log.Debug ("Set facelet relative path: {0}", Path);

      Context.Path := Path;
   end Set_Relative_Path;

   --  ------------------------------
   --  Resolve the facelet relative path
   --  ------------------------------
   function Resolve_Path (Context : Facelet_Context;
                          Path    : String) return String is
   begin
      if Path (Path'First) = '/' then
         return Path;
      else
         Log.Debug ("Resolve {0} with context {1}", Path, To_String (Context.Path));
         return Util.Files.Compose (To_String (Context.Path), Path);
      end if;
   end Resolve_Path;

   --  ------------------------------
   --  Get a converter from a name.
   --  Returns the converter object or null if there is no converter.
   --  ------------------------------
   function Get_Converter (Context : in Facelet_Context;
                           Name    : in EL.Objects.Object)
                           return ASF.Converters.Converter_Access is
   begin
      return Facelet_Context'Class (Context).Get_Application.Find (Name);
   end Get_Converter;

   --  ------------------------------
   --  Get a validator from a name.
   --  Returns the validator object or null if there is no validator.
   --  ------------------------------
   function Get_Validator (Context : in Facelet_Context;
                           Name    : in EL.Objects.Object)
                           return ASF.Validators.Validator_Access is
   begin
      return Facelet_Context'Class (Context).Get_Application.Find_Validator (Name);
   end Get_Validator;

end ASF.Contexts.Facelets;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  Memory Events - Definition and Analysis of memory events
--  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 Util.Log.Loggers;

with MAT.Types;
with MAT.Readers.Marshaller;
with MAT.Memory;
package body MAT.Memory.Readers is

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

   MSG_MALLOC  : constant MAT.Events.Internal_Reference := 0;
   MSG_FREE    : constant MAT.Events.Internal_Reference := 1;
   MSG_REALLOC : constant MAT.Events.Internal_Reference := 2;

   M_SIZE     : constant MAT.Events.Internal_Reference := 1;
   M_FRAME    : constant MAT.Events.Internal_Reference := 2;
   M_ADDR     : constant MAT.Events.Internal_Reference := 3;
   M_OLD_ADDR : constant MAT.Events.Internal_Reference := 4;
   M_THREAD   : constant MAT.Events.Internal_Reference := 5;
   M_UNKNOWN  : constant MAT.Events.Internal_Reference := 6;
   M_TIME     : constant MAT.Events.Internal_Reference := 7;
   --  Defines the possible data kinds which are recognized by
   --  the memory unmarshaller.  All others are ignored.

   SIZE_NAME  : aliased constant String := "size";
   FRAME_NAME : aliased constant String := "frame";
   ADDR_NAME  : aliased constant String := "pointer";
   OLD_NAME   : aliased constant String := "old-pointer";
   THREAD_NAME : aliased constant String := "thread";
   TIME_NAME   : aliased constant String := "time";

   Memory_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => SIZE_NAME'Access, Size => 0,
            Kind => MAT.Events.T_SIZE_T, Ref => M_SIZE),
      2 => (Name => FRAME_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_FRAME),
      3 => (Name => ADDR_NAME'Access, Size => 0,
            Kind => MAT.Events.T_POINTER, Ref => M_ADDR),
      4 => (Name => OLD_NAME'Access, Size => 0,
            Kind => MAT.Events.T_POINTER, Ref => M_OLD_ADDR),
      5 => (Name => THREAD_NAME'Access, Size => 0,
            Kind => MAT.Events.T_THREAD, Ref => M_THREAD),
      6 => (Name => TIME_NAME'Access, Size => 0,
            Kind => MAT.Events.T_TIME, Ref => M_TIME));

   procedure Unmarshall_Allocation (Msg      : in out MAT.Readers.Message;
                                    Slot     : in out Allocation;
                                    Addr     : in out MAT.Types.Target_Addr;
                                    Old_Addr : in out MAT.Types.Target_Addr;
                                    Defs     : in MAT.Events.Attribute_Table);

   ----------------------
   --  Register the reader to extract and analyze memory events.
   ----------------------
   procedure Register (Into   : in out MAT.Readers.Manager_Base'Class;
                       Reader : in Memory_Reader_Access) is
   begin
      Into.Register_Reader (Reader.all'Access, "malloc", MSG_MALLOC,
                            Memory_Attributes'Access);
      Into.Register_Reader (Reader.all'Access, "free", MSG_FREE,
                            Memory_Attributes'Access);
      Into.Register_Reader (Reader.all'Access, "realloc", MSG_REALLOC,
                            Memory_Attributes'Access);
   end Register;

   ----------------------
   --  Unmarshall from the message the memory slot information.
   --  The data is described by the Defs table.
   ----------------------
   procedure Unmarshall_Allocation (Msg      : in out MAT.Readers.Message;
                                    Slot     : in out Allocation;
                                    Addr     : in out MAT.Types.Target_Addr;
                                    Old_Addr : in out MAT.Types.Target_Addr;
                                    Defs     : in MAT.Events.Attribute_Table) is
   begin
      for I in Defs'Range loop
         declare
            Def : MAT.Events.Attribute renames Defs (I);
         begin
            case Def.Ref is
               when M_SIZE =>
                  Slot.Size := MAT.Readers.Marshaller.Get_Target_Size (Msg.Buffer, Def.Kind);

               when M_ADDR =>
                  Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when M_OLD_ADDR =>
                  Old_Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when M_UNKNOWN =>
                  MAT.Readers.Marshaller.Skip (Msg.Buffer, Def.Size);

               when others =>
                  MAT.Readers.Marshaller.Skip (Msg.Buffer, Def.Size);
            end case;
         end;
      end loop;
   end Unmarshall_Allocation;

   overriding
   procedure Dispatch (For_Servant : in out Memory_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Frame       : in MAT.Events.Frame_Info;
                       Msg         : in out MAT.Readers.Message) is
      Slot     : Allocation;
      Addr     : MAT.Types.Target_Addr := 0;
      Old_Addr : MAT.Types.Target_Addr := 0;
   begin
      case Id is
         when MSG_MALLOC =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            For_Servant.Data.Create_Frame (Pc     => Frame.Frame (1 .. Frame.Cur_Depth),
                                           Result => Slot.Frame);
            For_Servant.Data.Probe_Malloc (Addr, Slot);

         when MSG_FREE =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            For_Servant.Data.Probe_Free (Addr, Slot);

         when MSG_REALLOC =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            For_Servant.Data.Create_Frame (Pc     => Frame.Frame (1 .. Frame.Cur_Depth),
                                           Result => Slot.Frame);
            For_Servant.Data.Probe_Realloc (Addr, Old_Addr, Slot);

         when others =>
            raise Program_Error;

      end case;
   end Dispatch;

end MAT.Memory.Readers;

-----------------------------------------------------------------------
--  Memory Events - Definition and Analysis of memory events
--  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 Util.Log.Loggers;

with MAT.Types;
with MAT.Readers.Marshaller;
with MAT.Memory;
package body MAT.Memory.Readers is

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

   MSG_MALLOC  : constant MAT.Events.Internal_Reference := 0;
   MSG_FREE    : constant MAT.Events.Internal_Reference := 1;
   MSG_REALLOC : constant MAT.Events.Internal_Reference := 2;

   M_SIZE     : constant MAT.Events.Internal_Reference := 1;
   M_FRAME    : constant MAT.Events.Internal_Reference := 2;
   M_ADDR     : constant MAT.Events.Internal_Reference := 3;
   M_OLD_ADDR : constant MAT.Events.Internal_Reference := 4;
   M_THREAD   : constant MAT.Events.Internal_Reference := 5;
   M_UNKNOWN  : constant MAT.Events.Internal_Reference := 6;
   M_TIME     : constant MAT.Events.Internal_Reference := 7;
   --  Defines the possible data kinds which are recognized by
   --  the memory unmarshaller.  All others are ignored.

   SIZE_NAME  : aliased constant String := "size";
   FRAME_NAME : aliased constant String := "frame";
   ADDR_NAME  : aliased constant String := "pointer";
   OLD_NAME   : aliased constant String := "old-pointer";
   THREAD_NAME : aliased constant String := "thread";
   TIME_NAME   : aliased constant String := "time";

   Memory_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => SIZE_NAME'Access, Size => 0,
            Kind => MAT.Events.T_SIZE_T, Ref => M_SIZE),
      2 => (Name => FRAME_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_FRAME),
      3 => (Name => ADDR_NAME'Access, Size => 0,
            Kind => MAT.Events.T_POINTER, Ref => M_ADDR),
      4 => (Name => OLD_NAME'Access, Size => 0,
            Kind => MAT.Events.T_POINTER, Ref => M_OLD_ADDR),
      5 => (Name => THREAD_NAME'Access, Size => 0,
            Kind => MAT.Events.T_THREAD, Ref => M_THREAD),
      6 => (Name => TIME_NAME'Access, Size => 0,
            Kind => MAT.Events.T_TIME, Ref => M_TIME));

   procedure Unmarshall_Allocation (Msg      : in out MAT.Readers.Message;
                                    Slot     : in out Allocation;
                                    Addr     : in out MAT.Types.Target_Addr;
                                    Old_Addr : in out MAT.Types.Target_Addr;
                                    Defs     : in MAT.Events.Attribute_Table);

   ----------------------
   --  Register the reader to extract and analyze memory events.
   ----------------------
   procedure Register (Into   : in out MAT.Readers.Manager_Base'Class;
                       Reader : in Memory_Reader_Access) is
   begin
      Into.Register_Reader (Reader.all'Access, "malloc", MSG_MALLOC,
                            Memory_Attributes'Access);
      Into.Register_Reader (Reader.all'Access, "free", MSG_FREE,
                            Memory_Attributes'Access);
      Into.Register_Reader (Reader.all'Access, "realloc", MSG_REALLOC,
                            Memory_Attributes'Access);
   end Register;

   ----------------------
   --  Unmarshall from the message the memory slot information.
   --  The data is described by the Defs table.
   ----------------------
   procedure Unmarshall_Allocation (Msg      : in out MAT.Readers.Message;
                                    Slot     : in out Allocation;
                                    Addr     : in out MAT.Types.Target_Addr;
                                    Old_Addr : in out MAT.Types.Target_Addr;
                                    Defs     : in MAT.Events.Attribute_Table) is
   begin
      for I in Defs'Range loop
         declare
            Def : MAT.Events.Attribute renames Defs (I);
         begin
            case Def.Ref is
               when M_SIZE =>
                  Slot.Size := MAT.Readers.Marshaller.Get_Target_Size (Msg.Buffer, Def.Kind);

               when M_ADDR =>
                  Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when M_OLD_ADDR =>
                  Old_Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when M_UNKNOWN =>
                  MAT.Readers.Marshaller.Skip (Msg.Buffer, Def.Size);

               when others =>
                  MAT.Readers.Marshaller.Skip (Msg.Buffer, Def.Size);
            end case;
         end;
      end loop;
   end Unmarshall_Allocation;

   overriding
   procedure Dispatch (For_Servant : in out Memory_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Frame       : in MAT.Events.Frame_Info;
                       Msg         : in out MAT.Readers.Message) is
      Slot     : Allocation;
      Addr     : MAT.Types.Target_Addr := 0;
      Old_Addr : MAT.Types.Target_Addr := 0;
   begin
      Slot.Thread := Frame.Thread;
      Slot.Time   := Frame.Time;
      case Id is
         when MSG_MALLOC =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            For_Servant.Data.Create_Frame (Pc     => Frame.Frame (1 .. Frame.Cur_Depth),
                                           Result => Slot.Frame);
            For_Servant.Data.Probe_Malloc (Addr, Slot);

         when MSG_FREE =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            For_Servant.Data.Probe_Free (Addr, Slot);

         when MSG_REALLOC =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            For_Servant.Data.Create_Frame (Pc     => Frame.Frame (1 .. Frame.Cur_Depth),
                                           Result => Slot.Frame);
            For_Servant.Data.Probe_Realloc (Addr, Old_Addr, Slot);

         when others =>
            raise Program_Error;

      end case;
   end Dispatch;

end MAT.Memory.Readers;

Save the current thread and time information in the memory slot