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

with Util.Log;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;

with ADO.Drivers;
with ADO.Sequences;
package body ADO.Sessions is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("ADO.Sessions");

   procedure Check_Session (Database : in Session'Class) is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise NOT_OPEN;
      end if;
   end Check_Session;

   --  ---------
   --  Session
   --  ---------

   --  ------------------------------
   --  Get the session status.
   --  ------------------------------
   function Get_Status (Database : in Session) return ADO.Databases.Connection_Status is
   begin
      if Database.Impl = null then
         return ADO.Databases.CLOSED;
      end if;
      return Database.Impl.Database.Get_Status;
   end Get_Status;

   --  ------------------------------
   --  Close the session.
   --  ------------------------------
   procedure Close (Database : in out Session) is

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Session_Record,
                                    Name   => Session_Record_Access);

   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         Database.Impl.Database.Close;
         Database.Impl.Counter := Database.Impl.Counter - 1;
         if Database.Impl.Counter = 0 then
            Free (Database.Impl);
         end if;
--
--           if Database.Impl.Proxy /= null then
--              Database.Impl.Proxy.Counter := Database.Impl.Proxy.Counter - 1;
--           end if;
         Database.Impl := null;

      end if;
   end Close;

   --  ------------------------------
   --  Get the database connection.
   --  ------------------------------
   function Get_Connection (Database : in Session) return ADO.Databases.Connection'Class is
   begin
      Check_Session (Database);
      return Database.Impl.Database;
   end Get_Connection;

   --  ------------------------------
   --  Attach the object to the session.
   --  ------------------------------
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class) is
      pragma Unreferenced (Object);
   begin
      Check_Session (Database);
   end Attach;

   --  ------------------------------
   --  Check if the session contains the object identified by the given key.
   --  ------------------------------
   function Contains (Database : in Session;
                      Item     : in ADO.Objects.Object_Key) return Boolean is
   begin
      Check_Session (Database);
      return ADO.Objects.Cache.Contains (Database.Impl.Cache, Item);
   end Contains;

   --  ------------------------------
   --  Remove the object from the session cache.
   --  ------------------------------
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key) is
   begin
      Check_Session (Database);
      ADO.Objects.Cache.Remove (Database.Impl.Cache, Item);
   end Evict;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Context'Class)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         SQL  : constant String := Query.Get_SQL (Database.Impl.Database.Get_Driver_Index);
         Stmt : Query_Statement := Database.Impl.Database.Create_Statement (SQL);
      begin
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement and initialize the SQL statement with the query definition.
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Query_Definition_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Index : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
         SQL   : constant String := ADO.Queries.Get_SQL (Query, Index);
      begin
         return Database.Impl.Database.Create_Statement (SQL);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.SQL.Query'Class;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      if Query in ADO.Queries.Context'Class then
         declare
            Index : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
            SQL   : constant String := ADO.Queries.Context'Class (Query).Get_SQL (Index);
            Stmt  : Query_Statement := Database.Impl.Database.Create_Statement (SQL);
         begin
            Stmt.Set_Parameters (Query);
            return Stmt;
         end;
      else
         declare
            Stmt : Query_Statement := Database.Impl.Database.Create_Statement (Table);
         begin
            Stmt.Set_Parameters (Query);
            return Stmt;
         end;
      end if;
   end Create_Statement;

   --  ---------
   --  Master Session
   --  ---------

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Log.Info ("Begin transaction");

      Check_Session (Database);
      Database.Impl.Database.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Log.Info ("Commit transaction");

      Check_Session (Database);
      Database.Impl.Database.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Log.Info ("Rollback transaction");

      Check_Session (Database);
      Database.Impl.Database.Rollback;
   end Rollback;

   --  ------------------------------
   --  Allocate an identifier for the table.
   --  ------------------------------
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class) is
   begin
      Check_Session (Database);
      ADO.Sequences.Allocate (Database.Sequences.all, Id);
   end Allocate;

   --  ------------------------------
   --  Flush the objects that were modified.
   --  ------------------------------
   procedure Flush (Database : in out Master_Session) is
   begin
      Check_Session (Database);
   end Flush;

   overriding
   procedure Adjust (Object : in out Session) is
   begin
      if Object.Impl /= null then
         Object.Impl.Counter := Object.Impl.Counter + 1;
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
   begin
      if Object.Impl /= null then
         if Object.Impl.Counter = 1 then
            Object.Close;
         else
            Object.Impl.Counter := Object.Impl.Counter - 1;
         end if;
      end if;
   end Finalize;

   --  ------------------------------
   --  Create a delete statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   function Get_Session_Proxy (Database : in Session) return ADO.Objects.Session_Proxy_Access is
      use type ADO.Objects.Session_Proxy_Access;
   begin
      Check_Session (Database);
      if Database.Impl.Proxy = null then
         Database.Impl.Proxy := ADO.Objects.Create_Session_Proxy (Database.Impl);
      end if;
      return Database.Impl.Proxy;
   end Get_Session_Proxy;

end ADO.Sessions;

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

with Util.Log;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;

with ADO.Drivers;
with ADO.Sequences;
package body ADO.Sessions is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("ADO.Sessions");

   procedure Check_Session (Database : in Session'Class) is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise NOT_OPEN;
      end if;
   end Check_Session;

   --  ---------
   --  Session
   --  ---------

   --  ------------------------------
   --  Get the session status.
   --  ------------------------------
   function Get_Status (Database : in Session) return ADO.Databases.Connection_Status is
   begin
      if Database.Impl = null then
         return ADO.Databases.CLOSED;
      end if;
      return Database.Impl.Database.Get_Status;
   end Get_Status;

   --  ------------------------------
   --  Close the session.
   --  ------------------------------
   procedure Close (Database : in out Session) is

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Session_Record,
                                    Name   => Session_Record_Access);

   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         Database.Impl.Database.Close;
         Database.Impl.Counter := Database.Impl.Counter - 1;
         if Database.Impl.Counter = 0 then
            Free (Database.Impl);
         end if;
--
--           if Database.Impl.Proxy /= null then
--              Database.Impl.Proxy.Counter := Database.Impl.Proxy.Counter - 1;
--           end if;
         Database.Impl := null;

      end if;
   end Close;

   --  ------------------------------
   --  Get the database connection.
   --  ------------------------------
   function Get_Connection (Database : in Session) return ADO.Databases.Connection'Class is
   begin
      Check_Session (Database);
      return Database.Impl.Database;
   end Get_Connection;

   --  ------------------------------
   --  Attach the object to the session.
   --  ------------------------------
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class) is
      pragma Unreferenced (Object);
   begin
      Check_Session (Database);
   end Attach;

   --  ------------------------------
   --  Check if the session contains the object identified by the given key.
   --  ------------------------------
   function Contains (Database : in Session;
                      Item     : in ADO.Objects.Object_Key) return Boolean is
   begin
      Check_Session (Database);
      return ADO.Objects.Cache.Contains (Database.Impl.Cache, Item);
   end Contains;

   --  ------------------------------
   --  Remove the object from the session cache.
   --  ------------------------------
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key) is
   begin
      Check_Session (Database);
      ADO.Objects.Cache.Remove (Database.Impl.Cache, Item);
   end Evict;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Context'Class)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         SQL  : constant String := Query.Get_SQL (Database.Impl.Database.Get_Driver_Index);
         Stmt : Query_Statement := Database.Impl.Database.Create_Statement (SQL);
      begin
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement and initialize the SQL statement with the query definition.
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Query_Definition_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Index : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
         SQL   : constant String := ADO.Queries.Get_SQL (Query, Index);
      begin
         return Database.Impl.Database.Create_Statement (SQL);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.SQL.Query'Class;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      if False and Query in ADO.Queries.Context'Class then
         declare
            Index : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
            SQL   : constant String := ADO.Queries.Context'Class (Query).Get_SQL (Index);
            Stmt  : Query_Statement := Database.Impl.Database.Create_Statement (SQL);
         begin
            Stmt.Set_Parameters (Query);
            return Stmt;
         end;
      else
         declare
            Stmt : Query_Statement := Database.Impl.Database.Create_Statement (Table);
         begin
            if Query in ADO.Queries.Context'Class then
               declare
                  Index : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
                  SQL   : constant String := ADO.Queries.Context'Class (Query).Get_SQL (Index);
               begin
                  ADO.SQL.Append (Stmt.Get_Query.SQL, SQL);
               end;
            end if;
            Stmt.Set_Parameters (Query);
            return Stmt;
         end;
      end if;
   end Create_Statement;

   --  ---------
   --  Master Session
   --  ---------

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Log.Info ("Begin transaction");

      Check_Session (Database);
      Database.Impl.Database.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Log.Info ("Commit transaction");

      Check_Session (Database);
      Database.Impl.Database.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Log.Info ("Rollback transaction");

      Check_Session (Database);
      Database.Impl.Database.Rollback;
   end Rollback;

   --  ------------------------------
   --  Allocate an identifier for the table.
   --  ------------------------------
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class) is
   begin
      Check_Session (Database);
      ADO.Sequences.Allocate (Database.Sequences.all, Id);
   end Allocate;

   --  ------------------------------
   --  Flush the objects that were modified.
   --  ------------------------------
   procedure Flush (Database : in out Master_Session) is
   begin
      Check_Session (Database);
   end Flush;

   overriding
   procedure Adjust (Object : in out Session) is
   begin
      if Object.Impl /= null then
         Object.Impl.Counter := Object.Impl.Counter + 1;
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
   begin
      if Object.Impl /= null then
         if Object.Impl.Counter = 1 then
            Object.Close;
         else
            Object.Impl.Counter := Object.Impl.Counter - 1;
         end if;
      end if;
   end Finalize;

   --  ------------------------------
   --  Create a delete statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   function Get_Session_Proxy (Database : in Session) return ADO.Objects.Session_Proxy_Access is
      use type ADO.Objects.Session_Proxy_Access;
   begin
      Check_Session (Database);
      if Database.Impl.Proxy = null then
         Database.Impl.Proxy := ADO.Objects.Create_Session_Proxy (Database.Impl);
      end if;
      return Database.Impl.Proxy;
   end Get_Session_Proxy;

end ADO.Sessions;

Simplify the Create_Statement based on an external filter


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

--  == Writer interfaces ==
--  The <tt>Wiki.Writers</tt> package defines the interfaces used by the renderer to write
--  their outputs.
--
package Wiki.Writers is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Writer_Type is limited interface;
   type Writer_Type_Access is access all Writer_Type'Class;

   procedure Write (Writer  : in out Writer_Type;
                    Content : in Wide_Wide_String) is abstract;

   --  Write a single character to the string builder.
   procedure Write (Writer : in out Writer_Type;
                    Char   : in Wide_Wide_Character) is abstract;

   procedure Write (Writer  : in out Writer_Type;
                    Content : in Unbounded_Wide_Wide_String) is abstract;

   type Html_Writer_Type is limited interface and Writer_Type;
   type Html_Writer_Type_Access is access all Html_Writer_Type'Class;

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   procedure Write_Wide_Element (Writer  : in out Html_writer_Type;
                                 Name    : in String;
                                 Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Wide_Attribute (Writer  : in out Html_writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Start an XML element with the given name.
   procedure Start_Element (Writer : in out Html_Writer_Type;
                            Name   : in String) is abstract;

   --  Closes an XML element of the given name.
   procedure End_Element (Writer : in out Html_Writer_Type;
                          Name   : in String) is abstract;

   --  Write a text escaping any character as necessary.
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Attribute (Writer  : in out Html_writer_Type'Class;
                              Name    : in String;
                              Content : in String);

end Wiki.Writers;

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

--  == Writer interfaces ==
--  The <tt>Wiki.Writers</tt> package defines the interfaces used by the renderer to write
--  their outputs.
--
package Wiki.Writers is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Writer_Type is limited interface;
   type Writer_Type_Access is access all Writer_Type'Class;

   procedure Write (Writer  : in out Writer_Type;
                    Content : in Wide_Wide_String) is abstract;

   --  Write a single character to the string builder.
   procedure Write (Writer : in out Writer_Type;
                    Char   : in Wide_Wide_Character) is abstract;

   procedure Write (Writer  : in out Writer_Type;
                    Content : in Unbounded_Wide_Wide_String) is abstract;

   type Html_Writer_Type is limited interface and Writer_Type;
   type Html_Writer_Type_Access is access all Html_Writer_Type'Class;

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   procedure Write_Wide_Element (Writer  : in out Html_writer_Type;
                                 Name    : in String;
                                 Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Wide_Attribute (Writer  : in out Html_writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Wide_Attribute (Writer  : in out Html_writer_Type;
                                   Name    : in String;
                                   Content : in Wide_Wide_String) is abstract;

   --  Start an XML element with the given name.
   procedure Start_Element (Writer : in out Html_Writer_Type;
                            Name   : in String) is abstract;

   --  Closes an XML element of the given name.
   procedure End_Element (Writer : in out Html_Writer_Type;
                          Name   : in String) is abstract;

   --  Write a text escaping any character as necessary.
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Attribute (Writer  : in out Html_writer_Type'Class;
                              Name    : in String;
                              Content : in String);

end Wiki.Writers;

Declare a Write_Wide_Attribute procedure


-----------------------------------------------------------------------
--  util-texts-builders -- Text builder
--  Copyright (C) 2013, 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.
-----------------------------------------------------------------------
private with Ada.Finalization;

--  == Description ==
--  The <tt>Util.Texts.Builders</tt> generic package was designed to provide string builders.
--  The interface was designed to reduce memory copies as much as possible.
--
--    * The <tt>Builder</tt> type holds a list of chunks into which texts are appended.
--    * The builder type holds an initial chunk whose capacity is defined when the builder
--      instance is declared.
--    * There is only an <tt>Append</tt> procedure which allows to append text to the builder.
--      This is the only time when a copy is made.
--    * The package defines the <tt>Iterate</tt> operation that allows to get the content
--      collected by the builder.  When using the <tt>Iterate</tt> operation, no copy is
--      performed since chunks data are passed passed by reference.
--    * The type is limited to forbid copies of the builder instance.
--
--  == Example ==
--  First, instantiate the package for the element type (eg, String):
--
--    package String_Builder is new Util.Texts.Builders (Character, String);
--
--  Declare the string builder instance with its initial capacity:
--
--    Builder : String_Builder.Builder (256);
--
--  And append to it:
--
--    String_Builder.Append (Builder, "Hello");
--
--  To get the content collected in the builder instance, write a procedure that recieves
--  the chunk data as parameter:
--
--    procedure Collect (Item : in String) is ...
--
--  And use the <tt>Iterate</tt> operation:
--
--    String_Builder.Iterate (Builder, Collect'Access);
--
generic
   type Element_Type is (<>);
   type Input is array (Positive range <>) of Element_Type;
   Chunk_Size : Positive := 80;
package Util.Texts.Builders is

   pragma Preelaborate;

   type Builder (Len : Positive) is limited private;

   --  Get the length of the item builder.
   function Length (Source : in Builder) return Natural;

   --  Get the capacity of the builder.
   function Capacity (Source : in Builder) return Natural;

   --  Get the builder block size.
   function Block_Size (Source : in Builder) return Positive;

   --  Set the block size for the allocation of next chunks.
   procedure Set_Block_Size (Source : in out Builder;
                             Size   : in Positive);

   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   procedure Append (Source   : in out Builder;
                     New_Item : in Input);

   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   procedure Append (Source   : in out Builder;
                     New_Item : in Element_Type);

   --  Clear the source freeing any storage allocated for the buffer.
   procedure Clear (Source : in out Builder);

   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   procedure Iterate (Source  : in Builder;
                      Process : not null access procedure (Chunk : in Input));

   --  Get the buffer content as an array.
   function To_Array (Source : in Builder) return Input;

   --  Return the content starting from the tail and up to <tt>Length</tt> items.
   function Tail (Source : in Builder;
                  Length : in Natural) return Input;

   --  Call the <tt>Process</tt> procedure with the full buffer content, trying to avoid
   --  secondary stack copies as much as possible.
   generic
      with procedure Process (Content : in Input);
   procedure Get (Source : in Builder);

private

   pragma Inline (Length);
   pragma Inline (Iterate);

   type Block;
   type Block_Access is access all Block;

   type Block (Len : Positive) is limited record
      Next_Block : Block_Access;
      Last       : Natural := 0;
      Content    : Input (1 .. Len);
   end record;

   type Builder (Len : Positive) is new Ada.Finalization.Limited_Controlled with record
      Current    : Block_Access;
      Block_Size : Positive := Chunk_Size;
      Length     : Natural  := 0;
      First      : aliased Block (Len);
   end record;
   pragma Finalize_Storage_Only (Builder);

   --  Setup the builder.
   overriding
   procedure Initialize (Source : in out Builder);

   --  Finalize the builder releasing the storage.
   overriding
   procedure Finalize (Source : in out Builder);

end Util.Texts.Builders;

-----------------------------------------------------------------------
--  util-texts-builders -- Text builder
--  Copyright (C) 2013, 2017, 2021 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.
-----------------------------------------------------------------------
private with Ada.Finalization;

--  == Description ==
--  The <tt>Util.Texts.Builders</tt> generic package was designed to provide string builders.
--  The interface was designed to reduce memory copies as much as possible.
--
--    * The <tt>Builder</tt> type holds a list of chunks into which texts are appended.
--    * The builder type holds an initial chunk whose capacity is defined when the builder
--      instance is declared.
--    * There is only an <tt>Append</tt> procedure which allows to append text to the builder.
--      This is the only time when a copy is made.
--    * The package defines the <tt>Iterate</tt> operation that allows to get the content
--      collected by the builder.  When using the <tt>Iterate</tt> operation, no copy is
--      performed since chunks data are passed passed by reference.
--    * The type is limited to forbid copies of the builder instance.
--
--  == Example ==
--  First, instantiate the package for the element type (eg, String):
--
--    package String_Builder is new Util.Texts.Builders (Character, String);
--
--  Declare the string builder instance with its initial capacity:
--
--    Builder : String_Builder.Builder (256);
--
--  And append to it:
--
--    String_Builder.Append (Builder, "Hello");
--
--  To get the content collected in the builder instance, write a procedure that recieves
--  the chunk data as parameter:
--
--    procedure Collect (Item : in String) is ...
--
--  And use the <tt>Iterate</tt> operation:
--
--    String_Builder.Iterate (Builder, Collect'Access);
--
generic
   type Element_Type is (<>);
   type Input is array (Positive range <>) of Element_Type;
   Chunk_Size : Positive := 80;
package Util.Texts.Builders is

   pragma Preelaborate;

   type Builder (Len : Positive) is limited private;

   --  Get the length of the item builder.
   function Length (Source : in Builder) return Natural;

   --  Get the capacity of the builder.
   function Capacity (Source : in Builder) return Natural;

   --  Get the builder block size.
   function Block_Size (Source : in Builder) return Positive;

   --  Set the block size for the allocation of next chunks.
   procedure Set_Block_Size (Source : in out Builder;
                             Size   : in Positive);

   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   procedure Append (Source   : in out Builder;
                     New_Item : in Input);

   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   procedure Append (Source   : in out Builder;
                     New_Item : in Element_Type);

   --  Clear the source freeing any storage allocated for the buffer.
   procedure Clear (Source : in out Builder);

   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   procedure Iterate (Source  : in Builder;
                      Process : not null access procedure (Chunk : in Input));

   --  Get the buffer content as an array.
   function To_Array (Source : in Builder) return Input;

   --  Return the content starting from the tail and up to <tt>Length</tt> items.
   function Tail (Source : in Builder;
                  Length : in Natural) return Input;

   --  Call the <tt>Process</tt> procedure with the full buffer content, trying to avoid
   --  secondary stack copies as much as possible.
   generic
      with procedure Process (Content : in Input);
   procedure Get (Source : in Builder);

   --  Format the message and replace occurrences of argument patterns by
   --  their associated value.
   --  Returns the formatted message in the stream
   generic
      type Value is limited private;
      type Value_List is array (Positive range <>) of Value;
      with procedure Append (Input : in out Builder; Item : in Value);
   procedure Format (Into      : in out Builder;
                     Message   : in Input;
                     Arguments : in Value_List);

private

   pragma Inline (Length);
   pragma Inline (Iterate);

   type Block;
   type Block_Access is access all Block;

   type Block (Len : Positive) is limited record
      Next_Block : Block_Access;
      Last       : Natural := 0;
      Content    : Input (1 .. Len);
   end record;

   type Builder (Len : Positive) is new Ada.Finalization.Limited_Controlled with record
      Current    : Block_Access;
      Block_Size : Positive := Chunk_Size;
      Length     : Natural  := 0;
      First      : aliased Block (Len);
   end record;
   pragma Finalize_Storage_Only (Builder);

   --  Setup the builder.
   overriding
   procedure Initialize (Source : in out Builder);

   --  Finalize the builder releasing the storage.
   overriding
   procedure Finalize (Source : in out Builder);

end Util.Texts.Builders;

Declare the Format generic procedure

Declare the Format generic procedure


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

with Util.Processes;

--  == Pipes ==
--  The `Util.Streams.Pipes` package defines a pipe stream to or from a process.
--  It allows to launch an external program while getting the program standard output or
--  providing the program standard input.  The `Pipe_Stream` type represents the input or
--  output stream for the external program.  This is a portable interface that works on
--  Unix and Windows.
--
--  The process is created and launched by the `Open` operation.  The pipe allows
--  to read or write to the process through the `Read` and `Write` operation.
--  It is very close to the *popen* operation provided by the C stdio library.
--  First, create the pipe instance:
--
--    with Util.Streams.Pipes;
--    ...
--       Pipe : aliased Util.Streams.Pipes.Pipe_Stream;
--
--  The pipe instance can be associated with only one process at a time.
--  The process is launched by using the `Open` command and by specifying the command
--  to execute as well as the pipe redirection mode:
--
--  * `READ` to read the process standard output,
--  * `WRITE` to write the process standard input.
--
--  For example to run the `ls -l` command and read its output, we could run it by using:
--
--    Pipe.Open (Command => "ls -l", Mode => Util.Processes.READ);
--
--  The `Pipe_Stream` is not buffered and a buffer can be configured easily by using the
--  `Input_Buffer_Stream` type and connecting the buffer to the pipe so that it reads
--  the pipe to fill the buffer.  The initialization of the buffer is the following:
--
--    with Util.Streams.Buffered;
--    ...
--       Buffer : Util.Streams.Buffered.Input_Buffer_Stream;
--       ...
--       Buffer.Initialize (Input => Pipe'Access, Size => 1024);
--
--  And to read the process output, one can use the following:
--
--     Content : Ada.Strings.Unbounded.Unbounded_String;
--     ...
--     Buffer.Read (Into => Content);
--
--  The pipe object should be closed when reading or writing to it is finished.
--  By closing the pipe, the caller will wait for the termination of the process.
--  The process exit status can be obtained by using the `Get_Exit_Status` function.
--
--     Pipe.Close;
--     if Pipe.Get_Exit_Status /= 0 then
--        Ada.Text_IO.Put_Line ("Command exited with status "
--                              & Integer'Image (Pipe.Get_Exit_Status));
--     end if;
--
--  You will note that the `Pipe_Stream` is a limited type and thus cannot be copied.
--  When leaving the scope of the `Pipe_Stream` instance, the application will wait for
--  the process to terminate.
--
--  Before opening the pipe, it is possible to have some control on the process that
--  will be created to configure:
--
--    * The shell that will be used to launch the process,
--    * The process working directory,
--    * Redirect the process output to a file,
--    * Redirect the process error to a file,
--    * Redirect the process input from a file.
--
--  All these operations must be made before calling the `Open` procedure.
package Util.Streams.Pipes is

   use Util.Processes;

   subtype Pipe_Mode is Util.Processes.Pipe_Mode range READ .. READ_WRITE;

   --  -----------------------
   --  Pipe stream
   --  -----------------------
   --  The Pipe_Stream is an output/input stream that reads or writes
   --  to or from a process.
   type Pipe_Stream is limited new Output_Stream and Input_Stream with private;

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

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

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

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

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

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

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

   --  Close the pipe and wait for the external process to terminate.
   overriding
   procedure Close (Stream : in out Pipe_Stream);

   --  Get the process exit status.
   function Get_Exit_Status (Stream : in Pipe_Stream) return Integer;

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

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Pipe_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   overriding
   procedure Read (Stream : in out Pipe_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset);

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   procedure Stop (Stream : in out Pipe_Stream;
                   Signal : in Positive := 15);

private

   type Pipe_Stream is limited new Output_Stream and Input_Stream with record
      Proc   : Util.Processes.Process;
   end record;

end Util.Streams.Pipes;

-----------------------------------------------------------------------
--  util-streams-pipes -- Pipe stream to or from a process
--  Copyright (C) 2011, 2013, 2015, 2016, 2017, 2018, 2019, 2021, 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.Processes;

--  == Pipes ==
--  The `Util.Streams.Pipes` package defines a pipe stream to or from a process.
--  It allows to launch an external program while getting the program standard output or
--  providing the program standard input.  The `Pipe_Stream` type represents the input or
--  output stream for the external program.  This is a portable interface that works on
--  Unix and Windows.
--
--  The process is created and launched by the `Open` operation.  The pipe allows
--  to read or write to the process through the `Read` and `Write` operation.
--  It is very close to the *popen* operation provided by the C stdio library.
--  First, create the pipe instance:
--
--    with Util.Streams.Pipes;
--    ...
--       Pipe : aliased Util.Streams.Pipes.Pipe_Stream;
--
--  The pipe instance can be associated with only one process at a time.
--  The process is launched by using the `Open` command and by specifying the command
--  to execute as well as the pipe redirection mode:
--
--  * `READ` to read the process standard output,
--  * `WRITE` to write the process standard input.
--
--  For example to run the `ls -l` command and read its output, we could run it by using:
--
--    Pipe.Open (Command => "ls -l", Mode => Util.Processes.READ);
--
--  The `Pipe_Stream` is not buffered and a buffer can be configured easily by using the
--  `Input_Buffer_Stream` type and connecting the buffer to the pipe so that it reads
--  the pipe to fill the buffer.  The initialization of the buffer is the following:
--
--    with Util.Streams.Buffered;
--    ...
--       Buffer : Util.Streams.Buffered.Input_Buffer_Stream;
--       ...
--       Buffer.Initialize (Input => Pipe'Unchecked_Access, Size => 1024);
--
--  And to read the process output, one can use the following:
--
--     Content : Ada.Strings.Unbounded.Unbounded_String;
--     ...
--     Buffer.Read (Into => Content);
--
--  The pipe object should be closed when reading or writing to it is finished.
--  By closing the pipe, the caller will wait for the termination of the process.
--  The process exit status can be obtained by using the `Get_Exit_Status` function.
--
--     Pipe.Close;
--     if Pipe.Get_Exit_Status /= 0 then
--        Ada.Text_IO.Put_Line ("Command exited with status "
--                              & Integer'Image (Pipe.Get_Exit_Status));
--     end if;
--
--  You will note that the `Pipe_Stream` is a limited type and thus cannot be copied.
--  When leaving the scope of the `Pipe_Stream` instance, the application will wait for
--  the process to terminate.
--
--  Before opening the pipe, it is possible to have some control on the process that
--  will be created to configure:
--
--    * The shell that will be used to launch the process,
--    * The process working directory,
--    * Redirect the process output to a file,
--    * Redirect the process error to a file,
--    * Redirect the process input from a file.
--
--  All these operations must be made before calling the `Open` procedure.
package Util.Streams.Pipes is

   use Util.Processes;

   subtype Pipe_Mode is Util.Processes.Pipe_Mode range READ .. READ_WRITE;

   --  -----------------------
   --  Pipe stream
   --  -----------------------
   --  The Pipe_Stream is an output/input stream that reads or writes
   --  to or from a process.
   type Pipe_Stream is limited new Output_Stream and Input_Stream with private;

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

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

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

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

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

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

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

   --  Close the pipe and wait for the external process to terminate.
   overriding
   procedure Close (Stream : in out Pipe_Stream);

   --  Get the process exit status.
   function Get_Exit_Status (Stream : in Pipe_Stream) return Integer;

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

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Pipe_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   overriding
   procedure Read (Stream : in out Pipe_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset);

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   procedure Stop (Stream : in out Pipe_Stream;
                   Signal : in Positive := 15);

private

   type Pipe_Stream is limited new Output_Stream and Input_Stream with record
      Proc   : Util.Processes.Process;
   end record;

end Util.Streams.Pipes;

Fix the examples in the documentation

Fix the examples in the documentation


-----------------------------------------------------------------------
--  util-events-timers-tests -- Unit tests for timers
--  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.Test_Caller;

package body Util.Events.Timers.Tests is

   use Util.Tests;
   use type Ada.Real_Time.Time;

   package Caller is new Util.Test_Caller (Test, "Events.Timers");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Is_Scheduled",
                       Test_Empty_Timer'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Process",
                       Test_Timer_Event'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Repeat",
                       Test_Repeat_Timer'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Repeat+Process",
                       Test_Many_Timers'Access);
   end Add_Tests;

   overriding
   procedure Time_Handler (Sub   : in out Test;
                           Event : in out Timer_Ref'Class) is
   begin
      Sub.Count := Sub.Count + 1;
      if Sub.Repeat > 1 then
         Sub.Repeat := Sub.Repeat - 1;
         Event.Repeat (Ada.Real_Time.Milliseconds (1));
      end if;
   end Time_Handler;

   --  -----------------------
   --  Test empty timers.
   --  -----------------------
   procedure Test_Empty_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Deadline : Ada.Real_Time.Time;
   begin
      T.Assert (not R.Is_Scheduled, "Empty timer should not be scheduled");
      T.Assert (R.Time_Of_Event = Ada.Real_Time.Time_Last, "Time_Of_Event returned invalid value");
      R.Cancel;
      M.Process (Deadline);
      T.Assert (Deadline = Ada.Real_Time.Time_Last,
                "The Process operation returned invalid deadline");
   end Test_Empty_Timer;

   procedure Test_Timer_Event (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      delay until Deadline;
      M.Process (Deadline);
      Assert_Equals (T, 1, T.Count, "The timer handler was not called");
   end Test_Timer_Event;

   --  -----------------------
   --  Test repeating timers.
   --  -----------------------
   procedure Test_Repeat_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      T.Count := 0;
      T.Repeat := 5;
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      loop
         delay until Deadline;
         M.Process (Deadline);
         exit when Deadline >= Now + Ada.Real_Time.Seconds (1);
      end loop;
      Assert_Equals (T, 5, T.Count, "The timer handler was not repeated");
   end Test_Repeat_Timer;

   --  -----------------------
   --  Test executing several timers.
   --  -----------------------
   procedure Test_Many_Timers (T : in out Test) is
      Timer_Count : constant Positive := 30;

      type Timer_Ref_Array is array (1 .. Timer_Count) of Timer_Ref;
      type Test_Ref_Array is array (1 .. Timer_Count) of aliased Test;

      M        : Timer_List;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      R        : Timer_Ref_Array;
      D        : Test_Ref_Array;
      Dt       : Ada.Real_Time.Time_Span;
      Count    : Natural := 0;
   begin
      for I in R'Range loop
         D (I).Count := 0;
         D (I).Repeat := 4;
         if I mod 2 = 0 then
            Dt := Ada.Real_Time.Milliseconds (40);
         else
            Dt := Ada.Real_Time.Milliseconds (20);
         end if;
         M.Set_Timer (D (I)'Unchecked_Access, R (I), Start + Dt);
      end loop;
      loop
         M.Process (Deadline);
         exit when Deadline >= Start + Ada.Real_Time.Seconds (10);
         Count := Count + 1;
         delay until Deadline;
      end loop;
      Util.Tests.Assert_Equals (T, 8, Count, "Count of Process");
      for I in D'Range loop
         Util.Tests.Assert_Equals (T, 4, D (I).Count, "Invalid count for timer at "
                                     & Natural'Image (I) & " " & Natural'Image (Count));
      end loop;
   end Test_Many_Timers;

end Util.Events.Timers.Tests;

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

with Util.Test_Caller;

package body Util.Events.Timers.Tests is

   use Util.Tests;
   use type Ada.Real_Time.Time;

   package Caller is new Util.Test_Caller (Test, "Events.Timers");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Is_Scheduled",
                       Test_Empty_Timer'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Process",
                       Test_Timer_Event'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Repeat",
                       Test_Repeat_Timer'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Repeat+Process",
                       Test_Many_Timers'Access);
   end Add_Tests;

   overriding
   procedure Time_Handler (Sub   : in out Test;
                           Event : in out Timer_Ref'Class) is
   begin
      Sub.Count := Sub.Count + 1;
      if Sub.Repeat > 1 then
         Sub.Repeat := Sub.Repeat - 1;
         Event.Repeat (Ada.Real_Time.Milliseconds (1));
      end if;
   end Time_Handler;

   --  -----------------------
   --  Test empty timers.
   --  -----------------------
   procedure Test_Empty_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Deadline : Ada.Real_Time.Time;
   begin
      T.Assert (not R.Is_Scheduled, "Empty timer should not be scheduled");
      T.Assert (R.Time_Of_Event = Ada.Real_Time.Time_Last, "Time_Of_Event returned invalid value");
      R.Cancel;
      M.Process (Deadline);
      T.Assert (Deadline = Ada.Real_Time.Time_Last,
                "The Process operation returned invalid deadline");
   end Test_Empty_Timer;

   procedure Test_Timer_Event (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      delay until Deadline;
      M.Process (Deadline);
      Assert_Equals (T, 1, T.Count, "The timer handler was not called");
   end Test_Timer_Event;

   --  -----------------------
   --  Test repeating timers.
   --  -----------------------
   procedure Test_Repeat_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      T.Count := 0;
      T.Repeat := 5;
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      loop
         delay until Deadline;
         M.Process (Deadline);
         exit when Deadline >= Now + Ada.Real_Time.Seconds (1);
      end loop;
      Assert_Equals (T, 5, T.Count, "The timer handler was not repeated");
   end Test_Repeat_Timer;

   --  -----------------------
   --  Test executing several timers.
   --  -----------------------
   procedure Test_Many_Timers (T : in out Test) is
      Timer_Count : constant Positive := 30;

      type Timer_Ref_Array is array (1 .. Timer_Count) of Timer_Ref;
      type Test_Ref_Array is array (1 .. Timer_Count) of aliased Test;

      M        : Timer_List;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      R        : Timer_Ref_Array;
      D        : Test_Ref_Array;
      Dt       : Ada.Real_Time.Time_Span;
      Count    : Natural := 0;
   begin
      for I in R'Range loop
         D (I).Count := 0;
         D (I).Repeat := 4;
         if I mod 2 = 0 then
            Dt := Ada.Real_Time.Milliseconds (40);
         else
            Dt := Ada.Real_Time.Milliseconds (20);
         end if;
         M.Set_Timer (D (I)'Unchecked_Access, R (I), Start + Dt);
      end loop;
      loop
         M.Process (Deadline);
         exit when Deadline >= Start + Ada.Real_Time.Seconds (10);
         Count := Count + 1;
         delay until Deadline;
      end loop;

      --  Depending on the load we can have different values for Count.
      Util.Tests.Assert (T, Count <= 8, "Count of Process");
      Util.Tests.Assert (T, Count <= 4, "Count of Process");
      for I in D'Range loop
         Util.Tests.Assert_Equals (T, 4, D (I).Count, "Invalid count for timer at "
                                     & Natural'Image (I) & " " & Natural'Image (Count));
      end loop;
   end Test_Many_Timers;

end Util.Events.Timers.Tests;

Fix the unit tests when run under some heavy load


-----------------------------------------------------------------------
--  security-controllers-roles -- Simple role base security
--  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.Serialize.Mappers.Record_Mapper;
package body Security.Controllers.Roles is

   --  ------------------------------
   --  Returns true if the user associated with the security context Context has
   --  one of the role defined in the Handler.
   --  ------------------------------
   function Has_Permission (Handler : in Role_Controller;
                            Context : in Security.Contexts.Security_Context'Class)
                            return Boolean is
      use type Security.Permissions.Principal_Access;

      P : constant Security.Permissions.Principal_Access := Context.Get_User_Principal;
   begin
      if P /= null then
         for I in Handler.Roles'Range loop
            if P.Has_Role (Handler.Roles (I)) then
               return True;
            end if;
         end loop;
      end if;
      return False;
   end Has_Permission;

   type Config_Fields is (FIELD_NAME, FIELD_ROLE, FIELD_ROLE_PERMISSION, FIELD_ROLE_NAME);

   type Controller_Config_Access is access all Controller_Config;

   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Called while parsing the XML policy file when the <name>, <role> and <role-permission>
   --  XML entities are found.  Create the new permission when the complete permission definition
   --  has been parsed and save the permission in the security manager.
   --  ------------------------------
   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_ROLE =>
            declare
               Role : constant String := Util.Beans.Objects.To_String (Value);
            begin
               Into.Roles (Into.Count + 1) := Into.Manager.Find_Role (Role);
               Into.Count := Into.Count + 1;

            exception
               when Permissions.Invalid_Name =>
                  raise Util.Serialize.Mappers.Field_Error with "Invalid role: " & Role;
            end;

         when FIELD_ROLE_PERMISSION =>
            if Into.Count = 0 then
               raise Util.Serialize.Mappers.Field_Error with "Missing at least one role";
            end if;
            declare
               Name : constant String := Util.Beans.Objects.To_String (Into.Name);
               Perm : constant Role_Controller_Access
                 := new Role_Controller '(Count => Into.Count,
                                          Roles => Into.Roles (1 .. Into.Count));
            begin
               Into.Manager.Add_Permission (Name, Perm.all'Access);
               Into.Count := 0;
            end;

         when FIELD_ROLE_NAME =>
            declare
               Name : constant String := Util.Beans.Objects.To_String (Value);
               Role : Permissions.Role_Type;
            begin
               Into.Manager.Add_Role_Type (Name, Role);
            end;
      end case;
   end Set_Member;

   package Config_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Controller_Config,
                                               Element_Type_Access => Controller_Config_Access,
                                               Fields              => Config_Fields,
                                               Set_Member          => Set_Member);

   Mapper : aliased Config_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the role-permission description.  For example:
   --
   --  <security-role>
   --    <role-name>admin</role-name>
   --  </security-role>
   --  <role-permission>
   --     <name>create-workspace</name>
   --     <role>admin</role>
   --     <role>manager</role>
   --  </role-permission>
   --
   --  This defines a permission create-workspace that will be granted if the
   --  user has either the admin or the manager role.
   --  ------------------------------
   package body Reader_Config is
   begin
      Reader.Add_Mapping ("policy-rules", Mapper'Access);
      Reader.Add_Mapping ("module", Mapper'Access);
      Config.Manager := Manager;
      Config_Mapper.Set_Context (Reader, Config'Unchecked_Access);
   end Reader_Config;

begin
   Mapper.Add_Mapping ("role-permission", FIELD_ROLE_PERMISSION);
   Mapper.Add_Mapping ("role-permission/name", FIELD_NAME);
   Mapper.Add_Mapping ("role-permission/role", FIELD_ROLE);
   Mapper.Add_Mapping ("security-role/role-name", FIELD_ROLE_NAME);
end Security.Controllers.Roles;

-----------------------------------------------------------------------
--  security-controllers-roles -- Simple role base security
--  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.Serialize.Mappers.Record_Mapper;
package body Security.Controllers.Roles is

   --  ------------------------------
   --  Returns true if the user associated with the security context Context has
   --  one of the role defined in the Handler.
   --  ------------------------------
   function Has_Permission (Handler : in Role_Controller;
                            Context : in Security.Contexts.Security_Context'Class)
                            return Boolean is
      use type Security.Principal_Access;

      P : constant Security.Principal_Access := Context.Get_User_Principal;
   begin
      if P /= null then
         for I in Handler.Roles'Range loop
--              if P.Has_Role (Handler.Roles (I)) then
               return True;
--              end if;
         end loop;
      end if;
      return False;
   end Has_Permission;

   type Config_Fields is (FIELD_NAME, FIELD_ROLE, FIELD_ROLE_PERMISSION, FIELD_ROLE_NAME);

   type Controller_Config_Access is access all Controller_Config;

   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Called while parsing the XML policy file when the <name>, <role> and <role-permission>
   --  XML entities are found.  Create the new permission when the complete permission definition
   --  has been parsed and save the permission in the security manager.
   --  ------------------------------
   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_ROLE =>
            declare
               Role : constant String := Util.Beans.Objects.To_String (Value);
            begin
               Into.Roles (Into.Count + 1) := Into.Manager.Find_Role (Role);
               Into.Count := Into.Count + 1;

            exception
               when Permissions.Invalid_Name =>
                  raise Util.Serialize.Mappers.Field_Error with "Invalid role: " & Role;
            end;

         when FIELD_ROLE_PERMISSION =>
            if Into.Count = 0 then
               raise Util.Serialize.Mappers.Field_Error with "Missing at least one role";
            end if;
            declare
               Name : constant String := Util.Beans.Objects.To_String (Into.Name);
               Perm : constant Role_Controller_Access
                 := new Role_Controller '(Count => Into.Count,
                                          Roles => Into.Roles (1 .. Into.Count));
            begin
               Into.Manager.Add_Permission (Name, Perm.all'Access);
               Into.Count := 0;
            end;

         when FIELD_ROLE_NAME =>
            declare
               Name : constant String := Util.Beans.Objects.To_String (Value);
               Role : Permissions.Role_Type;
            begin
               Into.Manager.Add_Role_Type (Name, Role);
            end;
      end case;
   end Set_Member;

   package Config_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Controller_Config,
                                               Element_Type_Access => Controller_Config_Access,
                                               Fields              => Config_Fields,
                                               Set_Member          => Set_Member);

   Mapper : aliased Config_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the role-permission description.  For example:
   --
   --  <security-role>
   --    <role-name>admin</role-name>
   --  </security-role>
   --  <role-permission>
   --     <name>create-workspace</name>
   --     <role>admin</role>
   --     <role>manager</role>
   --  </role-permission>
   --
   --  This defines a permission create-workspace that will be granted if the
   --  user has either the admin or the manager role.
   --  ------------------------------
   package body Reader_Config is
   begin
      Reader.Add_Mapping ("policy-rules", Mapper'Access);
      Reader.Add_Mapping ("module", Mapper'Access);
      Config.Manager := Manager;
      Config_Mapper.Set_Context (Reader, Config'Unchecked_Access);
   end Reader_Config;

begin
   Mapper.Add_Mapping ("role-permission", FIELD_ROLE_PERMISSION);
   Mapper.Add_Mapping ("role-permission/name", FIELD_NAME);
   Mapper.Add_Mapping ("role-permission/role", FIELD_ROLE);
   Mapper.Add_Mapping ("security-role/role-name", FIELD_ROLE_NAME);
end Security.Controllers.Roles;

Fix compilation

Fix compilation


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

package Wiki.Documents is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   type Format_Type is (BOLD, ITALIC, CODE, SUPERSCRIPT, SUBSCRIPT, STRIKEOUT, PREFORMAT);

   type Format_Map is array (Format_Type) of Boolean;

   --  ------------------------------
   --  Document reader
   --  ------------------------------
   type Document_Reader is limited interface;
   type Document_Reader_Access is access all Document_Reader'Class;

   --  Add a section header in the document.
   procedure Add_Header (Document : in out Document_Reader;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive) is abstract;

   --  Add a line break (
).
   procedure Add_Line_Break (Document : in out Document_Reader) is abstract;

   --  Add a paragraph (
).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   procedure Add_Paragraph (Document : in out Document_Reader) is abstract;

   --  Add a blockquote (
).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Document : in out Document_Reader;
                             Level    : in Natural) is abstract;

   --  Add a list item (
).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Document : in out Document_Reader;
                            Level    : in Positive;
                            Ordered  : in Boolean) is abstract;

   --  Add an horizontal rule (
).
   procedure Add_Horizontal_Rule (Document : in out Document_Reader) is abstract;

   --  Add a link.
   procedure Add_Link (Document : in out Document_Reader;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String) is abstract;

   --  Add an image.
   procedure Add_Image (Document    : in out Document_Reader;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is abstract;

   --  Add a quote.
   procedure Add_Quote (Document : in out Document_Reader;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is abstract;

   --  Add a text block with the given format.
   procedure Add_Text (Document : in out Document_Reader;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Format_Map) is abstract;

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Document : in out Document_Reader;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is abstract;

   --  Finish the document after complete wiki text has been parsed.
   procedure Finish (Document : in out Document_Reader) is abstract;

end Wiki.Documents;

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

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   type Format_Type is (BOLD, ITALIC, CODE, SUPERSCRIPT, SUBSCRIPT, STRIKEOUT, PREFORMAT);

   type Format_Map is array (Format_Type) of Boolean;

   --  ------------------------------
   --  Document reader
   --  ------------------------------
   type Document_Reader is limited interface;
   type Document_Reader_Access is access all Document_Reader'Class;

   --  Add a section header in the document.
   procedure Add_Header (Document : in out Document_Reader;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive) is abstract;

   --  Add a line break (
).
   procedure Add_Line_Break (Document : in out Document_Reader) is abstract;

   --  Add a paragraph (
).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   procedure Add_Paragraph (Document : in out Document_Reader) is abstract;

   --  Add a blockquote (
).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Document : in out Document_Reader;
                             Level    : in Natural) is abstract;

   --  Add a list item (
).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Document : in out Document_Reader;
                            Level    : in Positive;
                            Ordered  : in Boolean) is abstract;

   --  Add an horizontal rule (
).
   procedure Add_Horizontal_Rule (Document : in out Document_Reader) is abstract;

   --  Add a link.
   procedure Add_Link (Document : in out Document_Reader;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String) is abstract;

   --  Add an image.
   procedure Add_Image (Document    : in out Document_Reader;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is abstract;

   --  Add a quote.
   procedure Add_Quote (Document : in out Document_Reader;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is abstract;

   --  Add a text block with the given format.
   procedure Add_Text (Document : in out Document_Reader;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Format_Map) is abstract;

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Document : in out Document_Reader;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is abstract;

   procedure Start_Element (Document   : in out Document_Reader;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type) is abstract;

   procedure End_Element (Document : in out Document_Reader;
                          Name     : in Unbounded_Wide_Wide_String) is abstract;

   --  Finish the document after complete wiki text has been parsed.
   procedure Finish (Document : in out Document_Reader) is abstract;

end Wiki.Documents;

Declare the Start_Element and End_Element procedure


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

private package Gen.Artifacts.Docs.Markdown is

   --  Format documentation for Google Wiki syntax.
   type Document_Formatter is new Gen.Artifacts.Docs.Document_Formatter with record
      Need_Newline : Boolean := False;
   end record;

   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String;

   --  Start a new document.
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type);

   --  Write a line in the target document formatting the line if necessary.
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type);

   --  Finish the document.
   overriding
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String);

end Gen.Artifacts.Docs.Markdown;

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

private package Gen.Artifacts.Docs.Markdown is

   --  Format documentation for Google Wiki syntax.
   type Document_Formatter is new Gen.Artifacts.Docs.Document_Formatter with record
      Need_Newline : Boolean := False;
   end record;

   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String;

   --  Start a new document.
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type);

   --  Write a line in the target document formatting the line if necessary.
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type);

   --  Finish the document.
   overriding
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String);

   --  Write a line in the document.
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in String);

end Gen.Artifacts.Docs.Markdown;

Declare the Write_Line procedure

Declare the Write_Line procedure


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

with Ada.Strings.Unbounded;

with Util.Beans.Objects;

with Gen.Model.Tables;
with Gen.Model.Operations;
package Gen.Model.Beans is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Bean Definition
   --  ------------------------------
   type Bean_Definition is new Tables.Table_Definition with null record;
   type Bean_Definition_Access is access all Bean_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Bean_Definition;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Bean_Definition);

   --  Initialize the table definition instance.
   overriding
   procedure Initialize (O : in out Bean_Definition);

   --  Create an attribute with the given name and add it to the bean.
   procedure Add_Attribute (Bean   : in out Bean_Definition;
                            Name   : in Unbounded_String;
                            Column : out Gen.Model.Tables.Column_Definition_Access);

   --  Create a bean with the given name.
   function Create_Bean (Name : in Unbounded_String) return Bean_Definition_Access;

end Gen.Model.Beans;

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

with Ada.Strings.Unbounded;

with Util.Beans.Objects;

with Gen.Model.Tables;
package Gen.Model.Beans is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Bean Definition
   --  ------------------------------
   type Bean_Definition is new Tables.Table_Definition with null record;
   type Bean_Definition_Access is access all Bean_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Bean_Definition;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Bean_Definition);

   --  Initialize the table definition instance.
   overriding
   procedure Initialize (O : in out Bean_Definition);

   --  Create an attribute with the given name and add it to the bean.
   procedure Add_Attribute (Bean   : in out Bean_Definition;
                            Name   : in Unbounded_String;
                            Column : out Gen.Model.Tables.Column_Definition_Access);

   --  Create a bean with the given name.
   function Create_Bean (Name : in Unbounded_String) return Bean_Definition_Access;

end Gen.Model.Beans;

Fix compilation warning

Fix compilation warning