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

with Gtk.Enums;
with Gtk.Tree_View_Column;

with Util.Log.Loggers;
package body MAT.Consoles.Gtkmat is

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

   --  ------------------------------
   --  Initialize the console to display the result in the Gtk frame.
   --  ------------------------------
   procedure Initialize (Console : in out Console_Type;
                         Frame   : in Gtk.Frame.Gtk_Frame) is
   begin
      Gtk.Scrolled_Window.Gtk_New (Console.Scrolled);
      Gtk.Cell_Renderer_Text.Gtk_New (Console.Col_Text);
      Console.Scrolled.Set_Policy (Gtk.Enums.Policy_Always, Gtk.Enums.Policy_Always);
      Console.Frame := Frame;
      Console.Frame.Add (Console.Scrolled);
      Console.Col_Text.Ref;
      --        Console.Frame.Show_All;
   end Initialize;

   --  Report a notice message.
   overriding
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is
   begin
      null;
   end Notice;

   --  Report an error message.
   overriding
   procedure Error (Console : in out Console_Type;
                    Message : in String) is
   begin
      null;
   end Error;

   --  Print the field value for the given field.
   overriding
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String) is
   begin
      Log.Debug ("Field {0} - {1}", Field_Type'Image (Field), Value);
      Gtk.List_Store.Set (Console.List, Console.Current_Row, Console.Indexes (Field), Value);
   end Print_Field;

   --  Print the title for the given field.
   overriding
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is
      Pos : constant Positive := Console.Field_Count;
   begin
      Console.Indexes (Field) := Glib.Gint (Pos - 1);
      Console.Columns (Pos).Field := Field;
      Console.Columns (Pos).Title := Ada.Strings.Unbounded.To_Unbounded_String (Title);
   end Print_Title;

   --  Start a new title in a report.
   overriding
   procedure Start_Title (Console : in out Console_Type) is
   begin
      Console.Field_Count := 0;
      Console.Sizes := (others => 0);
      Console.Cols := (others => 1);
      Console.Indexes := (others => 0);
   end Start_Title;

   --  Finish a new title in a report.
   procedure End_Title (Console : in out Console_Type) is
      use type Glib.Guint;
      use type Glib.Gint;
      use type Gtk.Tree_View.Gtk_Tree_View;
      use Gtk.List_Store;

      Types : Glib.GType_Array (0 .. Glib.Guint (Console.Field_Count) - 1)
        := (others => Glib.GType_String);
      Col      : Gtk.Tree_View_Column.Gtk_Tree_View_Column;
      Num : Glib.Gint;
   begin
      Gtk.List_Store.Gtk_New (Console.List, Types);

      if Console.Tree /= null then
         Console.Tree.Destroy;
      end if;
      Gtk.Tree_View.Gtk_New (Console.Tree);

      for I in 1 .. Console.Field_Count loop
         Gtk.Tree_View_Column.Gtk_New (Col);
         Num := Console.Tree.Append_Column (Col);
         Col.Set_Sort_Column_Id (Glib.Gint (I) - 1);
         Col.Set_Title (Ada.Strings.Unbounded.To_String (Console.Columns (I).Title));
         Col.Pack_Start (Console.Col_Text, True);
         Col.Set_Sizing (Gtk.Tree_View_Column.Tree_View_Column_Autosize);
         Col.Add_Attribute (Console.Col_Text, "text", Glib.Gint (I) - 1);
      end loop;
      Console.Tree.Set_Model (+Console.List);
      Console.Scrolled.Add (Console.Tree);
      Console.Scrolled.Show_All;
   end End_Title;

   --  Start a new row in a report.
   overriding
   procedure Start_Row (Console : in out Console_Type) is
   begin
      Console.List.Append (Console.Current_Row);
   end Start_Row;

   --  Finish a new row in a report.
   overriding
   procedure End_Row (Console : in out Console_Type) is
   begin
      null;
   end End_Row;

end MAT.Consoles.Gtkmat;

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

with Gtk.Enums;
with Gtk.Tree_View_Column;

with Util.Log.Loggers;
package body MAT.Consoles.Gtkmat is

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

   --  ------------------------------
   --  Initialize the console to display the result in the Gtk frame.
   --  ------------------------------
   procedure Initialize (Console : in out Console_Type;
                         Frame   : in Gtk.Frame.Gtk_Frame) is
   begin
      Gtk.Scrolled_Window.Gtk_New (Console.Scrolled);
      Gtk.Cell_Renderer_Text.Gtk_New (Console.Col_Text);
      Console.Scrolled.Set_Policy (Gtk.Enums.Policy_Always, Gtk.Enums.Policy_Always);
      Console.Frame := Frame;
      Console.Frame.Add (Console.Scrolled);
      Console.Col_Text.Ref;
      --        Console.Frame.Show_All;
   end Initialize;

   --  Report a notice message.
   overriding
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is
   begin
      null;
   end Notice;

   --  Report an error message.
   overriding
   procedure Error (Console : in out Console_Type;
                    Message : in String) is
   begin
      null;
   end Error;

   --  Print the field value for the given field.
   overriding
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String;
                          Justify : in Justify_Type := J_LEFT) is
   begin
      Log.Debug ("Field {0} - {1}", Field_Type'Image (Field), Value);
      Gtk.List_Store.Set (Console.List, Console.Current_Row, Console.Indexes (Field), Value);
   end Print_Field;

   --  Print the title for the given field.
   overriding
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is
      Pos : constant Positive := Console.Field_Count;
   begin
      Console.Indexes (Field) := Glib.Gint (Pos - 1);
      Console.Columns (Pos).Field := Field;
      Console.Columns (Pos).Title := Ada.Strings.Unbounded.To_Unbounded_String (Title);
   end Print_Title;

   --  Start a new title in a report.
   overriding
   procedure Start_Title (Console : in out Console_Type) is
   begin
      Console.Field_Count := 0;
      Console.Sizes := (others => 0);
      Console.Cols := (others => 1);
      Console.Indexes := (others => 0);
   end Start_Title;

   --  Finish a new title in a report.
   procedure End_Title (Console : in out Console_Type) is
      use type Glib.Guint;
      use type Glib.Gint;
      use type Gtk.Tree_View.Gtk_Tree_View;
      use Gtk.List_Store;

      Types : Glib.GType_Array (0 .. Glib.Guint (Console.Field_Count) - 1)
        := (others => Glib.GType_String);
      Col      : Gtk.Tree_View_Column.Gtk_Tree_View_Column;
      Num : Glib.Gint;
   begin
      Gtk.List_Store.Gtk_New (Console.List, Types);

      if Console.Tree /= null then
         Console.Tree.Destroy;
      end if;
      Gtk.Tree_View.Gtk_New (Console.Tree);

      for I in 1 .. Console.Field_Count loop
         Gtk.Tree_View_Column.Gtk_New (Col);
         Num := Console.Tree.Append_Column (Col);
         Col.Set_Sort_Column_Id (Glib.Gint (I) - 1);
         Col.Set_Title (Ada.Strings.Unbounded.To_String (Console.Columns (I).Title));
         Col.Pack_Start (Console.Col_Text, True);
         Col.Set_Sizing (Gtk.Tree_View_Column.Tree_View_Column_Autosize);
         Col.Add_Attribute (Console.Col_Text, "text", Glib.Gint (I) - 1);
      end loop;
      Console.Tree.Set_Model (+Console.List);
      Console.Scrolled.Add (Console.Tree);
      Console.Scrolled.Show_All;
   end End_Title;

   --  Start a new row in a report.
   overriding
   procedure Start_Row (Console : in out Console_Type) is
   begin
      Console.List.Append (Console.Current_Row);
   end Start_Row;

   --  Finish a new row in a report.
   overriding
   procedure End_Row (Console : in out Console_Type) is
   begin
      null;
   end End_Row;

end MAT.Consoles.Gtkmat;

Add a Justify parameter to the Print_Field procedure


-----------------------------------------------------------------------
--  awa-events -- AWA Events
--  Copyright (C) 2012, 2015, 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 ADO.Sessions.Entities;
package body AWA.Events is

   --  ------------------------------
   --  Set the event type which identifies the event.
   --  ------------------------------
   procedure Set_Event_Kind (Event : in out Module_Event;
                             Kind  : in Event_Index) is
   begin
      Event.Kind := Kind;
   end Set_Event_Kind;

   --  ------------------------------
   --  Get the event type which identifies the event.
   --  ------------------------------
   function Get_Event_Kind (Event : in Module_Event) return Event_Index is
   begin
      return Event.Kind;
   end Get_Event_Kind;

   --  ------------------------------
   --  Set a parameter on the message.
   --  ------------------------------
   procedure Set_Parameter (Event  : in out Module_Event;
                            Name   : in String;
                            Value  : in String) is
   begin
      Event.Props.Include (Name, Util.Beans.Objects.To_Object (Value));
   end Set_Parameter;

   --  ------------------------------
   --  Get the parameter with the given name.
   --  ------------------------------
   function Get_Parameter (Event : in Module_Event;
                           Name  : in String) return String is
      Pos : constant Util.Beans.Objects.Maps.Cursor := Event.Props.Find (Name);
   begin
      if Util.Beans.Objects.Maps.Has_Element (Pos) then
         return Util.Beans.Objects.To_String (Util.Beans.Objects.Maps.Element (Pos));
      else
         return "";
      end if;
   end Get_Parameter;

   --  ------------------------------
   --  Set the parameters of the message.
   --  ------------------------------
   procedure Set_Parameters (Event      : in out Module_Event;
                             Parameters : in Util.Beans.Objects.Maps.Map) is
   begin
      Event.Props := Parameters;
   end Set_Parameters;

   --  ------------------------------
   --  Get the value that corresponds to the parameter with the given name.
   --  ------------------------------
   function Get_Value (Event : in Module_Event;
                       Name  : in String) return Util.Beans.Objects.Object is
   begin
      if Event.Props.Contains (Name) then
         return Event.Props.Element (Name);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the entity identifier associated with the event.
   --  ------------------------------
   function Get_Entity_Identifier (Event : in Module_Event) return ADO.Identifier is
   begin
      return Event.Entity;
   end Get_Entity_Identifier;

   --  ------------------------------
   --  Set the entity identifier associated with the event.
   --  ------------------------------
   procedure Set_Entity_Identifier (Event : in out Module_Event;
                                    Id    : in ADO.Identifier) is
   begin
      Event.Entity := Id;
   end Set_Entity_Identifier;

   --  ------------------------------
   --  Set the database entity associated with the event.
   --  ------------------------------
   procedure Set_Entity (Event   : in out Module_Event;
                         Entity  : in ADO.Objects.Object_Ref'Class;
                         Session : in ADO.Sessions.Session'Class) is
      Key : constant ADO.Objects.Object_Key := Entity.Get_Key;
   begin
      Event.Entity := ADO.Objects.Get_Value (Key);
      Event.Entity_Type := ADO.Sessions.Entities.Find_Entity_Type (Session, Key);
   end Set_Entity;

   --  ------------------------------
   --  Copy the event properties to the map passed in <tt>Into</tt>.
   --  ------------------------------
   procedure Copy (Event : in Module_Event;
                   Into  : in out Util.Beans.Objects.Maps.Map) is
   begin
      Into := Event.Props;
   end Copy;

   --  ------------------------------
   --  Make and return a copy of the event.
   --  ------------------------------
   function Copy (Event : in Module_Event) return Module_Event_Access is
      Result : constant Module_Event_Access := new Module_Event;
   begin
      Result.Kind := Event.Kind;
      Result.Props := Event.Props;
      return Result;
   end Copy;

end AWA.Events;

-----------------------------------------------------------------------
--  awa-events -- AWA Events
--  Copyright (C) 2012, 2015, 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 ADO.Sessions.Entities;
package body AWA.Events is

   --  ------------------------------
   --  Set the event type which identifies the event.
   --  ------------------------------
   procedure Set_Event_Kind (Event : in out Module_Event;
                             Kind  : in Event_Index) is
   begin
      Event.Kind := Kind;
   end Set_Event_Kind;

   --  ------------------------------
   --  Get the event type which identifies the event.
   --  ------------------------------
   function Get_Event_Kind (Event : in Module_Event) return Event_Index is
   begin
      return Event.Kind;
   end Get_Event_Kind;

   --  ------------------------------
   --  Set a parameter on the message.
   --  ------------------------------
   procedure Set_Parameter (Event  : in out Module_Event;
                            Name   : in String;
                            Value  : in String) is
   begin
      Event.Props.Include (Name, Util.Beans.Objects.To_Object (Value));
   end Set_Parameter;
   procedure Set_Parameter (Event  : in out Module_Event;
                            Name   : in String;
                            Value  : in Util.Beans.Objects.Object) is
   begin
      Event.Props.Include (Name, Value);
   end Set_Parameter;

   --  ------------------------------
   --  Get the parameter with the given name.
   --  ------------------------------
   function Get_Parameter (Event : in Module_Event;
                           Name  : in String) return String is
      Pos : constant Util.Beans.Objects.Maps.Cursor := Event.Props.Find (Name);
   begin
      if Util.Beans.Objects.Maps.Has_Element (Pos) then
         return Util.Beans.Objects.To_String (Util.Beans.Objects.Maps.Element (Pos));
      else
         return "";
      end if;
   end Get_Parameter;

   --  ------------------------------
   --  Set the parameters of the message.
   --  ------------------------------
   procedure Set_Parameters (Event      : in out Module_Event;
                             Parameters : in Util.Beans.Objects.Maps.Map) is
   begin
      Event.Props := Parameters;
   end Set_Parameters;

   --  ------------------------------
   --  Get the value that corresponds to the parameter with the given name.
   --  ------------------------------
   function Get_Value (Event : in Module_Event;
                       Name  : in String) return Util.Beans.Objects.Object is
   begin
      if Event.Props.Contains (Name) then
         return Event.Props.Element (Name);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the entity identifier associated with the event.
   --  ------------------------------
   function Get_Entity_Identifier (Event : in Module_Event) return ADO.Identifier is
   begin
      return Event.Entity;
   end Get_Entity_Identifier;

   --  ------------------------------
   --  Set the entity identifier associated with the event.
   --  ------------------------------
   procedure Set_Entity_Identifier (Event : in out Module_Event;
                                    Id    : in ADO.Identifier) is
   begin
      Event.Entity := Id;
   end Set_Entity_Identifier;

   --  ------------------------------
   --  Set the database entity associated with the event.
   --  ------------------------------
   procedure Set_Entity (Event   : in out Module_Event;
                         Entity  : in ADO.Objects.Object_Ref'Class;
                         Session : in ADO.Sessions.Session'Class) is
      Key : constant ADO.Objects.Object_Key := Entity.Get_Key;
   begin
      Event.Entity := ADO.Objects.Get_Value (Key);
      Event.Entity_Type := ADO.Sessions.Entities.Find_Entity_Type (Session, Key);
   end Set_Entity;

   --  ------------------------------
   --  Copy the event properties to the map passed in <tt>Into</tt>.
   --  ------------------------------
   procedure Copy (Event : in Module_Event;
                   Into  : in out Util.Beans.Objects.Maps.Map) is
   begin
      Into := Event.Props;
   end Copy;

   --  ------------------------------
   --  Make and return a copy of the event.
   --  ------------------------------
   function Copy (Event : in Module_Event) return Module_Event_Access is
      Result : constant Module_Event_Access := new Module_Event;
   begin
      Result.Kind := Event.Kind;
      Result.Props := Event.Props;
      return Result;
   end Copy;

end AWA.Events;

Implement Set_Parameter procedure with Object as value type


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "1";
   raven_version_minor : constant String := "76";
   copyright_years     : constant String := "2015-2021";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   spkg_nls          : constant String := "nls";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-8.0";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.32";
   default_pgsql     : constant String := "12";
   default_php       : constant String := "7.4";
   default_python3   : constant String := "3.8";
   default_ruby      : constant String := "2.7";
   default_tcltk     : constant String := "8.6";
   default_firebird  : constant String := "2.5";

   default_binutils  : constant String := "ravensys-binutils:standard";
   binutils_version  : constant String := "2.37";

   obsolete_binutils : constant String := "binutils:ravensys";  --  Remove line upon next update
   previous_binutils : constant String := "2.35.1";

   default_compiler  : constant String := "ravensys-gcc";
   compiler_version  : constant String := "11.2.0";
   default_comppath  : constant String := default_compiler;

   previous_default  : constant String := "gcc9";
   previous_compiler : constant String := "9.3.0";
   previous_comppath : constant String := previous_default;

   arc_ext           : constant String := ".tzst";
   jobs_per_cpu      : constant := 2;
   task_stack_limit  : constant := 10_000_000;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 64;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   raven_var      : constant String := "/var/ravenports";
   host_pkg8      : constant String := host_localbase & "/sbin/ravensw";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "1";
   raven_version_minor : constant String := "77";
   copyright_years     : constant String := "2015-2021";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   spkg_nls          : constant String := "nls";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-8.0";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.32";
   default_pgsql     : constant String := "12";
   default_php       : constant String := "7.4";
   default_python3   : constant String := "3.8";
   default_ruby      : constant String := "2.7";
   default_tcltk     : constant String := "8.6";
   default_firebird  : constant String := "2.5";

   default_binutils  : constant String := "ravensys-binutils:standard";
   binutils_version  : constant String := "2.37";

   obsolete_binutils : constant String := "binutils:ravensys";  --  Remove line upon next update
   previous_binutils : constant String := "2.35.1";

   default_compiler  : constant String := "ravensys-gcc";
   compiler_version  : constant String := "11.2.0";
   default_comppath  : constant String := default_compiler;

   previous_default  : constant String := "gcc9";
   previous_compiler : constant String := "9.3.0";
   previous_comppath : constant String := previous_default;

   arc_ext           : constant String := ".tzst";
   jobs_per_cpu      : constant := 2;
   task_stack_limit  : constant := 10_000_000;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 64;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   raven_var      : constant String := "/var/ravenports";
   host_pkg8      : constant String := host_localbase & "/sbin/ravensw";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

Bump version

Bump version


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

with System;

with Util.Properties;

with MAT.Types;
with MAT.Events;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access all Buffer_Type;

   type Message is record
      Kind   : MAT.Events.Event_Type;
      Size   : Natural;
      Buffer : Buffer_Ptr;
   end record;

   -----------------
   --  Abstract servant definition
   -----------------
   --  The Servant is a small proxy that binds the specific message
   --  handlers to the client specific dispatcher.
   type Reader_Base is abstract tagged limited private;
   type Reader_Access is access all Reader_Base'Class;

   procedure Dispatch (For_Servant : in out Reader_Base;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Msg         : in out Message) is abstract;
   --  Dispatch the message

--     procedure Bind (For_Servant : in out Reader_Base) is abstract;
   --  Bind the servant with the object adapter to register the
   --  events it recognizes.  This is called once we have all the
   --  information about the structures of events that we can
   --  receive.

   -----------------
   --  Ipc Client Manager
   -----------------
   --  The Manager is a kind of object adapter. It registers a collection
   --  of servants and dispatches incomming messages to those servants.
   type Manager_Base is tagged limited private;
   type Manager is access all Manager_Base'Class;

   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access);

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message);

private

   type Endian_Type is (BIG_ENDIAN, LITTLE_ENDIAN);

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Size    : Natural;
      Total   : Natural;
      Endian  : Endian_Type := LITTLE_ENDIAN;
   end record;

   type Reader_Base is abstract tagged limited record
      Owner : Manager := null;
   end record;

   --  Record a servant
   type Message_Handler is record
      For_Servant : Reader_Access;
      Id          : MAT.Events.Internal_Reference;
      Attributes  : MAT.Events.Const_Attribute_Table_Access;
      Mapping     : MAT.Events.Attribute_Table_Ptr;
   end record;

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type;

   use type MAT.Types.Uint16;

   package Reader_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Message_Handler,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=");

   --  Runtime handlers associated with the events.
   package Handler_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type     => MAT.Types.Uint16,
                                     Element_Type => Message_Handler,
                                     Hash         => Hash,
                                     Equivalent_Keys => "=");

   type Manager_Base is tagged limited record
      Readers     : Reader_Maps.Map;
      Handlers    : Handler_Maps.Map;
      Version     : MAT.Types.Uint16;
      Flags       : MAT.Types.Uint16;
      Probe       : MAT.Events.Attribute_Table_Ptr;
      Frame       : access MAT.Events.Frame_Info;
   end record;

   --  Read the event data stream headers with the event description.
   --  Configure the reader to analyze the data stream according to the event descriptions.
   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message);

   --  Read an event definition from the stream and configure the reader.
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message);

end MAT.Readers;

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

with System;

with Util.Properties;

with MAT.Types;
with MAT.Events;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access all Buffer_Type;

   type Message is record
      Kind   : MAT.Events.Event_Type;
      Size   : Natural;
      Buffer : Buffer_Ptr;
   end record;

   -----------------
   --  Abstract servant definition
   -----------------
   --  The Servant is a small proxy that binds the specific message
   --  handlers to the client specific dispatcher.
   type Reader_Base is abstract tagged limited private;
   type Reader_Access is access all Reader_Base'Class;

   procedure Dispatch (For_Servant : in out Reader_Base;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Frame       : in MAT.Events.Frame_Info;
                       Msg         : in out Message) is abstract;
   --  Dispatch the message

--     procedure Bind (For_Servant : in out Reader_Base) is abstract;
   --  Bind the servant with the object adapter to register the
   --  events it recognizes.  This is called once we have all the
   --  information about the structures of events that we can
   --  receive.

   -----------------
   --  Ipc Client Manager
   -----------------
   --  The Manager is a kind of object adapter. It registers a collection
   --  of servants and dispatches incomming messages to those servants.
   type Manager_Base is tagged limited private;
   type Manager is access all Manager_Base'Class;

   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access);

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message);

private

   type Endian_Type is (BIG_ENDIAN, LITTLE_ENDIAN);

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Size    : Natural;
      Total   : Natural;
      Endian  : Endian_Type := LITTLE_ENDIAN;
   end record;

   type Reader_Base is abstract tagged limited record
      Owner : Manager := null;
   end record;

   --  Record a servant
   type Message_Handler is record
      For_Servant : Reader_Access;
      Id          : MAT.Events.Internal_Reference;
      Attributes  : MAT.Events.Const_Attribute_Table_Access;
      Mapping     : MAT.Events.Attribute_Table_Ptr;
   end record;

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type;

   use type MAT.Types.Uint16;

   package Reader_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Message_Handler,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=");

   --  Runtime handlers associated with the events.
   package Handler_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type     => MAT.Types.Uint16,
                                     Element_Type => Message_Handler,
                                     Hash         => Hash,
                                     Equivalent_Keys => "=");

   type Manager_Base is tagged limited record
      Readers     : Reader_Maps.Map;
      Handlers    : Handler_Maps.Map;
      Version     : MAT.Types.Uint16;
      Flags       : MAT.Types.Uint16;
      Probe       : MAT.Events.Attribute_Table_Ptr;
      Frame       : access MAT.Events.Frame_Info;
   end record;

   --  Read the event data stream headers with the event description.
   --  Configure the reader to analyze the data stream according to the event descriptions.
   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message);

   --  Read an event definition from the stream and configure the reader.
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message);

end MAT.Readers;

Add the Frame info in the Dispatch operation


-----------------------------------------------------------------------
--  serialize-io-csv-tests -- Unit tests for CSV parser
--  Copyright (C) 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 Util.Test_Caller;

with Util.Serialize.Mappers.Tests;
package body Util.Serialize.IO.CSV.Tests is

   package Caller is new Util.Test_Caller (Test, "Serialize.IO.CSV");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.CSV.Parse (parse Ok)",
                       Test_Parser'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check various (basic) JSON valid strings (no mapper).
   --  ------------------------------
   procedure Test_Parser (T : in out Test) is
      use Util.Serialize.Mappers.Tests;

      procedure Check_Parse (Content : in String;
                             Expect   : in Integer);

      Mapping : aliased Util.Serialize.Mappers.Tests.Map_Test_Mapper.Mapper;

      Mapper  : aliased Util.Serialize.Mappers.Tests.Map_Test_Vector_Mapper.Mapper;

      procedure Check_Parse (Content : in String;
                             Expect : in Integer) is
         P : Parser;

         Value   : aliased Map_Test_Vector.Vector;
      begin
         P.Add_Mapping ("", Mapper'Unchecked_Access);
         Map_Test_Vector_Mapper.Set_Context (P, Value'Unchecked_Access);

         P.Parse_String (Content);

         T.Assert (not P.Has_Error, "Parse error for: " & Content);
         Util.Tests.Assert_Equals (T, 1, Integer (Value.Length), "Invalid result length");

         Util.Tests.Assert_Equals (T, Expect, Integer (Value.Element (1).Value), "Invalid value");
      end Check_Parse;

      HDR : constant String := "name,status,value,bool" & ASCII.CR & ASCII.LF;
   begin
      Mapping.Add_Mapping ("name", FIELD_NAME);
      Mapping.Add_Mapping ("value", FIELD_VALUE);
      Mapping.Add_Mapping ("status", FIELD_BOOL);
      Mapping.Add_Mapping ("bool", FIELD_BOOL);
      Mapper.Set_Mapping (Mapping'Unchecked_Access);

      Check_Parse (HDR & "joe,false,23,true", 23);
      Check_Parse (HDR & "billy,false,""12"",true", 12);
      Check_Parse (HDR & """John Potter"",false,""1234"",true", 1234);
      Check_Parse (HDR & """John" & ASCII.CR & "Potter"",False,""3234"",True", 3234);
      Check_Parse (HDR & """John" & ASCII.LF & "Potter"",False,""3234"",True", 3234);
   end Test_Parser;

end Util.Serialize.IO.CSV.Tests;

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

   package Caller is new Util.Test_Caller (Test, "Serialize.IO.CSV");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.CSV.Parse (parse Ok)",
                       Test_Parser'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.CSV.Write",
                       Test_Output'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check various (basic) JSON valid strings (no mapper).
   --  ------------------------------
   procedure Test_Parser (T : in out Test) is
      use Util.Serialize.Mappers.Tests;

      procedure Check_Parse (Content : in String;
                             Expect   : in Integer);

      Mapping : aliased Util.Serialize.Mappers.Tests.Map_Test_Mapper.Mapper;

      Mapper  : aliased Util.Serialize.Mappers.Tests.Map_Test_Vector_Mapper.Mapper;

      procedure Check_Parse (Content : in String;
                             Expect : in Integer) is
         P : Parser;

         Value   : aliased Map_Test_Vector.Vector;
      begin
         P.Add_Mapping ("", Mapper'Unchecked_Access);
         Map_Test_Vector_Mapper.Set_Context (P, Value'Unchecked_Access);

         P.Parse_String (Content);

         T.Assert (not P.Has_Error, "Parse error for: " & Content);
         Util.Tests.Assert_Equals (T, 1, Integer (Value.Length), "Invalid result length");

         Util.Tests.Assert_Equals (T, Expect, Integer (Value.Element (1).Value), "Invalid value");
      end Check_Parse;

      HDR : constant String := "name,status,value,bool" & ASCII.CR & ASCII.LF;
   begin
      Mapping.Add_Mapping ("name", FIELD_NAME);
      Mapping.Add_Mapping ("value", FIELD_VALUE);
      Mapping.Add_Mapping ("status", FIELD_BOOL);
      Mapping.Add_Mapping ("bool", FIELD_BOOL);
      Mapper.Set_Mapping (Mapping'Unchecked_Access);

      Check_Parse (HDR & "joe,false,23,true", 23);
      Check_Parse (HDR & "billy,false,""12"",true", 12);
      Check_Parse (HDR & """John Potter"",false,""1234"",true", 1234);
      Check_Parse (HDR & """John" & ASCII.CR & "Potter"",False,""3234"",True", 3234);
      Check_Parse (HDR & """John" & ASCII.LF & "Potter"",False,""3234"",True", 3234);
   end Test_Parser;

   --  ------------------------------
   --  Test the CSV output stream generation.
   --  ------------------------------
   procedure Test_Output (T : in out Test) is
      File   : aliased Util.Streams.Files.File_Stream;
      Stream : Util.Serialize.IO.CSV.Output_Stream;
      Expect : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.csv");
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.csv");
   begin
      File.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Path);
      Stream.Initialize (Output => File'Unchecked_Access, Input => null, Size => 10000);
      Util.Serialize.IO.JSON.Tests.Write_Stream (Stream);
      Stream.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "CSV output serialization");
   end Test_Output;

end Util.Serialize.IO.CSV.Tests;

Implement and register the Test_Output procedure


-----------------------------------------------------------------------
--  Render Tests - Unit tests for AWA Wiki rendering
--  Copyright (C) 2013, 2016, 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 Ada.Text_IO;
with Ada.Directories;

with Util.Measures;

with Wiki.Render.Wiki;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Filters.Autolink;
with Wiki.Filters.Variables;
with Wiki.Plugins.Templates;
with Wiki.Plugins.Conditions;
with Wiki.Plugins.Variables;
with Wiki.Streams.Text_IO;
with Wiki.Streams.Html.Text_IO;
with Wiki.Documents;
with Wiki.Parsers;
package body Wiki.Tests is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is

      use Ada.Directories;

      Result_File : constant String := To_String (T.Result);
      Dir         : constant String := Containing_Directory (Result_File);
      Doc         : Wiki.Documents.Document;
      Engine      : Wiki.Parsers.Parser;
      Toc_Filter  : aliased Wiki.Filters.TOC.TOC_Filter;
      Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
      Var_Filter  : aliased Wiki.Filters.Variables.Variable_Filter;
      Auto_Filter : aliased Wiki.Filters.Autolink.Autolink_Filter;
      Template    : aliased Wiki.Plugins.Templates.File_Template_Plugin;
      Condition   : aliased Wiki.Plugins.Conditions.Condition_Plugin;
      Variables   : aliased Wiki.Plugins.Variables.Variable_Plugin;
      List_Vars   : aliased Wiki.Plugins.Variables.List_Variable_Plugin;
      Input       : aliased Wiki.Streams.Text_IO.File_Input_Stream;
      Output      : aliased Wiki.Streams.Html.Text_IO.Html_File_Output_Stream;

      type Test_Factory is new Wiki.Plugins.Plugin_Factory with null record;

      --  Find a plugin knowing its name.
      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access;

      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access is
         pragma Unreferenced (Factory);
      begin
         if Name = "if" or Name = "else" or Name = "elsif" or Name = "end" then
            return Condition'Unchecked_Access;
         elsif Name = "set" then
            return Variables'Unchecked_Access;
         elsif Name = "list" then
            return List_Vars'Unchecked_Access;
         else
            return Template.Find (Name);
         end if;
      end Find;

      Local_Factory : aliased Test_Factory;
   begin
      if not Exists (Dir) then
         Create_Path (Dir);
      end if;
      Input.Open (Path => To_String (T.File),
                  Form => "WCEM=8");
      Output.Create (Result_File, "WCEM=8");
      Template.Set_Template_Path (Containing_Directory (To_String (T.File)));
      Condition.Append ("public", "");
      Condition.Append ("user", "admin");
      declare
         Time : Util.Measures.Stamp;
      begin
         Engine.Set_Syntax (T.Source);
         Engine.Set_Plugin_Factory (Local_Factory'Unchecked_Access);
         Engine.Add_Filter (Toc_Filter'Unchecked_Access);
         Engine.Add_Filter (Auto_Filter'Unchecked_Access);
         Engine.Add_Filter (Html_Filter'Unchecked_Access);
         Engine.Add_Filter (Var_Filter'Unchecked_Access);
         Engine.Parse (Input'Unchecked_Access, Doc);
         Util.Measures.Report (Time, "Parse " & To_String (T.Name));
         if T.Source = Wiki.SYNTAX_HTML then
            declare
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access, T.Format);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Wiki " & To_String (T.Name));
            end;
         elsif T.Is_Html then
            declare
               Renderer : aliased Wiki.Render.Html.Html_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Set_Render_TOC (True);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render HTML " & To_String (T.Name));
            end;
         else
            declare
               Renderer : aliased Wiki.Render.Text.Text_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Text " & To_String (T.Name));
            end;
         end if;
      end;
      Input.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

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

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

      procedure Add_Import_Tests;
      procedure Add_Wiki_Tests;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Wiki_Syntax;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.SYNTAX_MEDIA_WIKI;
                  elsif Ext = "markdown" then
                     Format := Wiki.SYNTAX_MARKDOWN;
                  else
                     Format := Wiki.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Wiki_Syntax'Range loop
                     case Syntax is
                        when Wiki.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
   end Add_Tests;

end Wiki.Tests;

-----------------------------------------------------------------------
--  Render Tests - Unit tests for AWA Wiki rendering
--  Copyright (C) 2013, 2016, 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 Ada.Text_IO;
with Ada.Directories;

with Util.Measures;

with Wiki.Render.Wiki;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Filters.Autolink;
with Wiki.Filters.Variables;
with Wiki.Plugins.Templates;
with Wiki.Plugins.Conditions;
with Wiki.Plugins.Variables;
with Wiki.Streams.Text_IO;
with Wiki.Streams.Html.Text_IO;
with Wiki.Documents;
with Wiki.Parsers;
package body Wiki.Tests is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is

      use Ada.Directories;

      Result_File : constant String := To_String (T.Result);
      Dir         : constant String := Containing_Directory (Result_File);
      Doc         : Wiki.Documents.Document;
      Engine      : Wiki.Parsers.Parser;
      Toc_Filter  : aliased Wiki.Filters.TOC.TOC_Filter;
      Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
      Var_Filter  : aliased Wiki.Filters.Variables.Variable_Filter;
      Auto_Filter : aliased Wiki.Filters.Autolink.Autolink_Filter;
      Template    : aliased Wiki.Plugins.Templates.File_Template_Plugin;
      Condition   : aliased Wiki.Plugins.Conditions.Condition_Plugin;
      Variables   : aliased Wiki.Plugins.Variables.Variable_Plugin;
      List_Vars   : aliased Wiki.Plugins.Variables.List_Variable_Plugin;
      Input       : aliased Wiki.Streams.Text_IO.File_Input_Stream;
      Output      : aliased Wiki.Streams.Html.Text_IO.Html_File_Output_Stream;

      type Test_Factory is new Wiki.Plugins.Plugin_Factory with null record;

      --  Find a plugin knowing its name.
      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access;

      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access is
         pragma Unreferenced (Factory);
      begin
         if Name = "if" or Name = "else" or Name = "elsif" or Name = "end" then
            return Condition'Unchecked_Access;
         elsif Name = "set" then
            return Variables'Unchecked_Access;
         elsif Name = "list" then
            return List_Vars'Unchecked_Access;
         else
            return Template.Find (Name);
         end if;
      end Find;

      Local_Factory : aliased Test_Factory;
   begin
      if not Exists (Dir) then
         Create_Path (Dir);
      end if;
      Input.Open (Path => To_String (T.File),
                  Form => "WCEM=8");
      Output.Create (Result_File, "WCEM=8");
      Template.Set_Template_Path (Containing_Directory (To_String (T.File)));
      Condition.Append ("public", "");
      Condition.Append ("user", "admin");
      declare
         Time : Util.Measures.Stamp;
      begin
         Engine.Set_Syntax (T.Source);
         Engine.Set_Plugin_Factory (Local_Factory'Unchecked_Access);
         Engine.Add_Filter (Toc_Filter'Unchecked_Access);
         Engine.Add_Filter (Auto_Filter'Unchecked_Access);
         Engine.Add_Filter (Html_Filter'Unchecked_Access);
         Engine.Add_Filter (Var_Filter'Unchecked_Access);
         Engine.Parse (Input'Unchecked_Access, Doc);
         Util.Measures.Report (Time, "Parse " & To_String (T.Name));
         if T.Source = Wiki.SYNTAX_HTML then
            declare
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access, T.Format);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Wiki " & To_String (T.Name));
            end;
         elsif T.Is_Html then
            declare
               Renderer : aliased Wiki.Render.Html.Html_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Set_Render_TOC (True);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render HTML " & To_String (T.Name));
            end;
         else
            declare
               Renderer : aliased Wiki.Render.Text.Text_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Text " & To_String (T.Name));
            end;
         end if;
      end;
      Input.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

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

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

      procedure Add_Import_Tests;
      procedure Add_Wiki_Tests;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Wiki_Syntax;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.SYNTAX_MEDIA_WIKI;
                  elsif Ext = "markdown" then
                     Format := Wiki.SYNTAX_MARKDOWN;
                  else
                     Format := Wiki.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Wiki_Syntax'Range loop
                     case Syntax is
                        when Wiki.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_MARKDOWN =>
                           Tst := Create_Test (Name & ".markdown", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
   end Add_Tests;

end Wiki.Tests;

Update the test to import HTML into Markdown and verify the result


-----------------------------------------------------------------------
--  awa-blogs-tests -- Unit tests for blogs module
--  Copyright (C) 2017, 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 ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Tests;
with AWA.Tests.Helpers.Users;

package body AWA.Blogs.Tests is

   use Ada.Strings.Unbounded;
   use AWA.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.List_Post (Anonymous)",
                       Test_Anonymous_Access'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.Create_Blog",
                       Test_Create_Blog'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.Update_Post",
                       Test_Update_Post'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.List_Post (Admin)",
                       Test_Admin_List_Posts'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.List_Comments (Admin)",
                       Test_Admin_List_Comments'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.Stats (Admin)",
                       Test_Admin_Blog_Stats'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.Update_Post (Publish_Date)",
                       Test_Update_Publish_Date'Access);
   end Add_Tests;

   --  ------------------------------
   --  Get some access on the blog as anonymous users.
   --  ------------------------------
   procedure Verify_Anonymous (T    : in out Test;
                               Post : in String) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/blogs/view.html", "blog-view.html");
      ASF.Tests.Assert_Contains (T, "Blog posts", Reply, "Blog view page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/blogs/tagged.html?tag=test", "blog-tagged.html");
      ASF.Tests.Assert_Contains (T, "Tag - test", Reply, "Blog tag page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/blogs/post.html?post=missing", "blog-missing.html");
      ASF.Tests.Assert_Matches (T, "The post you are looking for does not exist",
                                Reply, "Blog post missing page is invalid",
                                ASF.Responses.SC_NOT_FOUND);

      if Post = "" then
         return;
      end if;

      ASF.Tests.Do_Get (Request, Reply, "/blogs/post.html?post=" & Post, "blog-post.html");
      ASF.Tests.Assert_Matches (T, ".*The blog post.*content.*", Reply,
                                "Blog post page is invalid"
                                );

   end Verify_Anonymous;

   --  ------------------------------
   --  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;

   --  ------------------------------
   --  Test creation of blog by simulating web requests.
   --  ------------------------------
   procedure Test_Create_Blog (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Uuid      : constant String := Util.Tests.Get_Uuid;
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/blogs/admin/create-blog.html",
                        "create-blog-get.html");
      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK,
                "Invalid response after getting blog creation page");
      ASF.Tests.Assert_Matches (T, "<dl id=.title.*
<label for=.title.*"
                                & "
<input type=.text.*", Reply,
                                "Blog post admin page is missing input field");

      Request.Set_Parameter ("title", "The Blog Title");
      Request.Set_Parameter ("create-blog", "1");
      Request.Set_Parameter ("create", "1");
      ASF.Tests.Do_Post (Request, Reply, "/blogs/admin/create-blog.html", "create-blog.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after blog creation");
      declare
         Ident : constant String
            := Helpers.Extract_Redirect (Reply, "/asfunit/blogs/admin/create.html?id=");
      begin
         Util.Tests.Assert_Matches (T, "^[0-9]+$", Ident,
                                    "Invalid blog identifier in the response");
         T.Blog_Ident := To_Unbounded_String (Ident);

         Request.Set_Parameter ("post-blog-id", Ident);
         Request.Set_Parameter ("post", "1");
         Request.Set_Parameter ("post-title", "Post title");
         Request.Set_Parameter ("text", "The blog post content.");
         Request.Set_Parameter ("uri", Uuid);
         Request.Set_Parameter ("save", "1");
         Request.Set_Parameter ("post-status", "POST_PUBLISHED");
         Request.Set_Parameter ("allow-comment", "0");
         Request.Set_Parameter ("post-format", "FORMAT_DOTCLEAR");
         ASF.Tests.Do_Post (Request, Reply, "/blogs/admin/create.html", "create-post.html");

         T.Post_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/blogs/admin/"
                                                   & Ident & "/preview/");

         Util.Tests.Assert_Matches (T, "^[0-9]+$", To_String (T.Post_Ident),
                                    "Invalid post identifier in the response");
      end;

      --  Check public access to the post.
      T.Post_Uri := To_Unbounded_String (Uuid);
      T.Verify_Anonymous (Uuid);
   end Test_Create_Blog;

   --  ------------------------------
   --  Test updating a post by simulating web requests.
   --  ------------------------------
   procedure Test_Update_Post (T : in out Test) is
      Request    : ASF.Requests.Mockup.Request;
      Reply      : ASF.Responses.Mockup.Response;
      Uuid       : constant String := Util.Tests.Get_Uuid;
      Ident      : constant String := To_String (T.Blog_Ident);
      Post_Ident : Unbounded_String;
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);

      Request.Set_Parameter ("post-blog-id", Ident);
      Request.Set_Parameter ("post-id", To_String (T.Post_Ident));
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("post-title", "New post title");
      Request.Set_Parameter ("text", "The blog post new content.");
      Request.Set_Parameter ("uri", Uuid);
      Request.Set_Parameter ("save", "1");
      Request.Set_Parameter ("post-status", "POST_PUBLISHED");
      Request.Set_Parameter ("post-format", "FORMAT_DOTCLEAR");
      Request.Set_Parameter ("allow-comment", "0");
      ASF.Tests.Do_Post (Request, Reply, "/blogs/admin/edit.html", "edit-post.html");

      Post_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/blogs/admin/"
                                              & Ident & "/preview/");

      Util.Tests.Assert_Equals (T, To_String (T.Post_Ident), To_String (Post_Ident),
                                "Invalid post identifier returned after post update");
      T.Verify_Anonymous (Uuid);
   end Test_Update_Post;

   --  ------------------------------
   --  Test updating the publication date by simulating web requests.
   --  ------------------------------
   procedure Test_Update_Publish_Date (T : in out Test) is
      Request    : ASF.Requests.Mockup.Request;
      Reply      : ASF.Responses.Mockup.Response;
      Uuid       : constant String := Util.Tests.Get_Uuid;
      Ident      : constant String := To_String (T.Blog_Ident);
      Post_Ident : Unbounded_String;
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      Request.Set_Parameter ("post_id", To_String (T.Post_Ident));
      Request.Set_Parameter ("blog_id", Ident);
      ASF.Tests.Do_Get (Request, Reply, "/blogs/admin/edit.html", "edit-post-form.html");

      Request.Set_Parameter ("post-blog-id", Ident);
      Request.Set_Parameter ("post-id", To_String (T.Post_Ident));
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("post-title", "New post title");
      Request.Set_Parameter ("text", "The blog post new content.");
      Request.Set_Parameter ("uri", Uuid);
      Request.Set_Parameter ("save", "1");
      Request.Set_Parameter ("post-format", "FORMAT_DOTCLEAR");
      Request.Set_Parameter ("post-status", "POST_PUBLISHED");
      Request.Set_Parameter ("allow-comment", "0");
      Request.Set_Parameter ("publish-date", "");
      ASF.Tests.Do_Post (Request, Reply, "/blogs/admin/edit.html", "edit-post.html");

      Post_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/blogs/admin/"
                                              & Ident & "/preview/");

      Util.Tests.Assert_Equals (T, To_String (T.Post_Ident), To_String (Post_Ident),
                                "Invalid post identifier returned after post update");
      T.Verify_Anonymous (Uuid);
   end Test_Update_Publish_Date;

   --  ------------------------------
   --  Test listing the blog posts.
   --  ------------------------------
   procedure Test_Admin_List_Posts (T : in out Test) is
      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
      Ident   : constant String := To_String (T.Blog_Ident);
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/blogs/admin/list.html?id=" & Ident, "blog-list.html");
      ASF.Tests.Assert_Contains (T, "blog-post-list-header", Reply, "Blog admin page is invalid");
   end Test_Admin_List_Posts;

   --  ------------------------------
   --  Test listing the blog comments.
   --  ------------------------------
   procedure Test_Admin_List_Comments (T : in out Test) is
      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
      Ident   : constant String := To_String (T.Blog_Ident);
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/blogs/admin/list-comments.html?id=" & Ident,
                        "blog-list-comments.html");
      ASF.Tests.Assert_Contains (T, "blog-comment-list-header", Reply,
                                 "Blog admin comments page is invalid");
   end Test_Admin_List_Comments;

   --  ------------------------------
   --  Test getting the JSON blog stats (for graphs).
   --  ------------------------------
   procedure Test_Admin_Blog_Stats (T : in out Test) is
      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
      Ident   : constant String := To_String (T.Blog_Ident);
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/blogs/admin/" & Ident & "/stats",
                        "blog-stats.html");
      ASF.Tests.Assert_Contains (T, "data", Reply,
                                 "Blog admin stats page is invalid");
   end Test_Admin_Blog_Stats;

end AWA.Blogs.Tests;

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

with Util.Strings;
with Util.Test_Caller;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with Security.Contexts;
with ASF.Tests;
with AWA.Services.Contexts;
with AWA.Tests.Helpers.Users;
with AWA.Storages.Modules;
with AWA.Storages.Beans;
with AWA.Storages.Models;
with AWA.Storages.Services;

package body AWA.Blogs.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, "Blogs.Beans");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.List_Post (Anonymous)",
                       Test_Anonymous_Access'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.Create_Blog",
                       Test_Create_Blog'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.Update_Post",
                       Test_Update_Post'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.List_Post (Admin)",
                       Test_Admin_List_Posts'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.List_Comments (Admin)",
                       Test_Admin_List_Comments'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.Stats (Admin)",
                       Test_Admin_Blog_Stats'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Beans.Update_Post (Publish_Date)",
                       Test_Update_Publish_Date'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Servlets.Load",
                       Test_Image_Blog'Access);
   end Add_Tests;

   --  ------------------------------
   --  Get some access on the blog as anonymous users.
   --  ------------------------------
   procedure Verify_Anonymous (T    : in out Test;
                               Post : in String) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/blogs/view.html", "blog-view.html");
      ASF.Tests.Assert_Contains (T, "Blog posts", Reply, "Blog view page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/blogs/tagged.html?tag=test", "blog-tagged.html");
      ASF.Tests.Assert_Contains (T, "Tag - test", Reply, "Blog tag page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/blogs/post.html?post=missing", "blog-missing.html");
      ASF.Tests.Assert_Matches (T, "The post you are looking for does not exist",
                                Reply, "Blog post missing page is invalid",
                                ASF.Responses.SC_NOT_FOUND);

      if Post = "" then
         return;
      end if;

      ASF.Tests.Do_Get (Request, Reply, "/blogs/post.html?post=" & Post, "blog-post.html");
      ASF.Tests.Assert_Matches (T, ".*The blog post.*content.*", Reply,
                                "Blog post page is invalid"
                                );

   end Verify_Anonymous;

   --  ------------------------------
   --  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;

   --  ------------------------------
   --  Test creation of blog by simulating web requests.
   --  ------------------------------
   procedure Test_Create_Blog (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Uuid      : constant String := Util.Tests.Get_Uuid;
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/blogs/admin/create-blog.html",
                        "create-blog-get.html");
      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK,
                "Invalid response after getting blog creation page");
      ASF.Tests.Assert_Matches (T, "<dl id=.title.*
<label for=.title.*"
                                & "
<input type=.text.*", Reply,
                                "Blog post admin page is missing input field");

      Request.Set_Parameter ("title", "The Blog Title");
      Request.Set_Parameter ("create-blog", "1");
      Request.Set_Parameter ("create", "1");
      ASF.Tests.Do_Post (Request, Reply, "/blogs/admin/create-blog.html", "create-blog.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after blog creation");
      declare
         Ident : constant String
            := Helpers.Extract_Redirect (Reply, "/asfunit/blogs/admin/create.html?id=");
      begin
         Util.Tests.Assert_Matches (T, "^[0-9]+$", Ident,
                                    "Invalid blog identifier in the response");
         T.Blog_Ident := To_Unbounded_String (Ident);

         Request.Set_Parameter ("post-blog-id", Ident);
         Request.Set_Parameter ("post", "1");
         Request.Set_Parameter ("post-title", "Post title");
         Request.Set_Parameter ("text", "The blog post content.");
         Request.Set_Parameter ("uri", Uuid);
         Request.Set_Parameter ("save", "1");
         Request.Set_Parameter ("post-status", "POST_PUBLISHED");
         Request.Set_Parameter ("allow-comment", "0");
         Request.Set_Parameter ("post-format", "FORMAT_DOTCLEAR");
         ASF.Tests.Do_Post (Request, Reply, "/blogs/admin/create.html", "create-post.html");

         T.Post_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/blogs/admin/"
                                                   & Ident & "/preview/");

         Util.Tests.Assert_Matches (T, "^[0-9]+$", To_String (T.Post_Ident),
                                    "Invalid post identifier in the response");
      end;

      --  Check public access to the post.
      T.Post_Uri := To_Unbounded_String (Uuid);
      T.Verify_Anonymous (Uuid);
   end Test_Create_Blog;

   --  ------------------------------
   --  Test updating a post by simulating web requests.
   --  ------------------------------
   procedure Test_Update_Post (T : in out Test) is
      Request    : ASF.Requests.Mockup.Request;
      Reply      : ASF.Responses.Mockup.Response;
      Uuid       : constant String := Util.Tests.Get_Uuid;
      Ident      : constant String := To_String (T.Blog_Ident);
      Post_Ident : Unbounded_String;
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);

      Request.Set_Parameter ("post-blog-id", Ident);
      Request.Set_Parameter ("post-id", To_String (T.Post_Ident));
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("post-title", "New post title");
      Request.Set_Parameter ("text", "The blog post new content.");
      Request.Set_Parameter ("uri", Uuid);
      Request.Set_Parameter ("save", "1");
      Request.Set_Parameter ("post-status", "POST_PUBLISHED");
      Request.Set_Parameter ("post-format", "FORMAT_DOTCLEAR");
      Request.Set_Parameter ("allow-comment", "0");
      ASF.Tests.Do_Post (Request, Reply, "/blogs/admin/edit.html", "edit-post.html");

      Post_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/blogs/admin/"
                                              & Ident & "/preview/");

      Util.Tests.Assert_Equals (T, To_String (T.Post_Ident), To_String (Post_Ident),
                                "Invalid post identifier returned after post update");
      T.Verify_Anonymous (Uuid);
   end Test_Update_Post;

   --  ------------------------------
   --  Test updating the publication date by simulating web requests.
   --  ------------------------------
   procedure Test_Update_Publish_Date (T : in out Test) is
      Request    : ASF.Requests.Mockup.Request;
      Reply      : ASF.Responses.Mockup.Response;
      Uuid       : constant String := Util.Tests.Get_Uuid;
      Ident      : constant String := To_String (T.Blog_Ident);
      Post_Ident : Unbounded_String;
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      Request.Set_Parameter ("post_id", To_String (T.Post_Ident));
      Request.Set_Parameter ("blog_id", Ident);
      ASF.Tests.Do_Get (Request, Reply, "/blogs/admin/edit.html", "edit-post-form.html");

      Request.Set_Parameter ("post-blog-id", Ident);
      Request.Set_Parameter ("post-id", To_String (T.Post_Ident));
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("post-title", "New post title");
      Request.Set_Parameter ("text", "The blog post new content.");
      Request.Set_Parameter ("uri", Uuid);
      Request.Set_Parameter ("save", "1");
      Request.Set_Parameter ("post-format", "FORMAT_DOTCLEAR");
      Request.Set_Parameter ("post-status", "POST_PUBLISHED");
      Request.Set_Parameter ("allow-comment", "0");
      Request.Set_Parameter ("publish-date", "");
      ASF.Tests.Do_Post (Request, Reply, "/blogs/admin/edit.html", "edit-post.html");

      Post_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/blogs/admin/"
                                              & Ident & "/preview/");

      Util.Tests.Assert_Equals (T, To_String (T.Post_Ident), To_String (Post_Ident),
                                "Invalid post identifier returned after post update");
      T.Verify_Anonymous (Uuid);
   end Test_Update_Publish_Date;

   --  ------------------------------
   --  Test listing the blog posts.
   --  ------------------------------
   procedure Test_Admin_List_Posts (T : in out Test) is
      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
      Ident   : constant String := To_String (T.Blog_Ident);
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/blogs/admin/list.html?id=" & Ident, "blog-list.html");
      ASF.Tests.Assert_Contains (T, "blog-post-list-header", Reply, "Blog admin page is invalid");
   end Test_Admin_List_Posts;

   --  ------------------------------
   --  Test listing the blog comments.
   --  ------------------------------
   procedure Test_Admin_List_Comments (T : in out Test) is
      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
      Ident   : constant String := To_String (T.Blog_Ident);
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/blogs/admin/list-comments.html?id=" & Ident,
                        "blog-list-comments.html");
      ASF.Tests.Assert_Contains (T, "blog-comment-list-header", Reply,
                                 "Blog admin comments page is invalid");
   end Test_Admin_List_Comments;

   --  ------------------------------
   --  Test getting the JSON blog stats (for graphs).
   --  ------------------------------
   procedure Test_Admin_Blog_Stats (T : in out Test) is
      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
      Ident   : constant String := To_String (T.Blog_Ident);
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/blogs/admin/" & Ident & "/stats",
                        "blog-stats.html");
      ASF.Tests.Assert_Contains (T, "data", Reply,
                                 "Blog admin stats page is invalid");
   end Test_Admin_Blog_Stats;

   --  ------------------------------
   --  Test getting an image from the blog servlet.
   --  ------------------------------
   procedure Test_Image_Blog (T : in out Test) is
      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
      Post_Id : constant String := To_String (T.Post_Ident);
      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");
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      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_Mime_Type ("image/jpg");
      Store.Set_Name ("Ada-Lovelace.jpg");
      Mgr.Save (Store, Path, AWA.Storages.Models.FILE);

      --  First test to make sure we get a 404 error.
      ASF.Tests.Do_Get (Request, Reply, "/blogs/images/" & Post_Id & "/0/default/Ada-Lovelace.jpg",
                        "Ada-Lovelace.jpg");
      T.Assert (Reply.Get_Status = Servlet.Responses.SC_NOT_FOUND,
                "Invalid response after image get");

      --  Second test to get the image.
      declare
         Image_Ident : constant String := Util.Strings.Image (Natural (Store.Get_Id));
      begin
         ASF.Tests.Do_Get (Request, Reply, "/blogs/images/" & Post_Id & "/"
                           & Image_Ident & "/default/Ada-Lovelace.jpg",
                           "Ada-Lovelace.jpg");
         T.Assert (Reply.Get_Status = Servlet.Responses.SC_OK,
                   "Invalid response after image get");
      end;
   end Test_Image_Blog;

end AWA.Blogs.Tests;

Implement Test_Image_Blog to check that the blog image server is correct


-----------------------------------------------------------------------
--  awa-blogs-tests -- Unit tests for blogs module
--  Copyright (C) 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 Util.Tests;

package AWA.Blogs.Tests is

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

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

   --  Test creation of blog by simulating web requests.
   procedure Test_Create_Blog (T : in out Test);

end AWA.Blogs.Tests;

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

with Util.Tests;
with Ada.Strings.Unbounded;

package AWA.Blogs.Tests is

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

   type Test is new Util.Tests.Test with record
      Blog_Ident : Ada.Strings.Unbounded.Unbounded_String;
      Post_Ident : Ada.Strings.Unbounded.Unbounded_String;
      Post_Uri   : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   --  Get some access on the blog as anonymous users.
   procedure Verify_Anonymous (T    : in out Test;
                               Post : in String);

   --  Test access to the blog as anonymous user.
   procedure Test_Anonymous_Access (T : in out Test);

   --  Test creation of blog by simulating web requests.
   procedure Test_Create_Blog (T : in out Test);

   --  Test updating a post by simulating web requests.
   procedure Test_Update_Post (T : in out Test);

end AWA.Blogs.Tests;

Declare two new unit tests Test_Update_Post and Test_Anonymous_Access