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

package body Wiki.Documents is

   use Wiki.Nodes;

   --  ------------------------------
   --  Append a HTML tag start node to the document.
   --  ------------------------------
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List) is

      Node : constant Node_Type_Access := new Node_Type '(Kind       => N_TAG_START,
                                                          Len        => 0,
                                                          Tag_Start  => Tag,
                                                          Attributes => Attributes,
                                                          Children   => null,
                                                          Parent     => Into.Current);
   begin
      Append (Into, Node);
      Into.Current := Node;
   end Push_Node;

   --  ------------------------------
   --  Pop the HTML tag.
   --  ------------------------------
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag) is
      pragma Unreferenced (Tag);
   begin
      if From.Current /= null then
         From.Current := From.Current.Parent;
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Returns True if the current node is the root document node.
   --  ------------------------------
   function Is_Root_Node (Doc : in Document) return Boolean is
   begin
      return Doc.Current = null;
   end Is_Root_Node;

   --  ------------------------------
   --  Append a section header at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive) is
   begin
      Append (Into, new Node_Type '(Kind   => N_HEADER,
                                    Len    => Header'Length,
                                    Header => Header,
                                    Level  => Level));
   end Append;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access) is
   begin
      if Into.Current = null then
         Append (Into.Nodes, Node);
      else
         Append (Into.Current, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind) is
   begin
      case Kind is
         when N_LINE_BREAK =>
            Append (Into, new Node_Type '(Kind => N_LINE_BREAK, Len => 0));

         when N_HORIZONTAL_RULE =>
            Append (Into, new Node_Type '(Kind => N_HORIZONTAL_RULE, Len => 0));

         when N_PARAGRAPH =>
            Append (Into, new Node_Type '(Kind => N_PARAGRAPH, Len => 0));

         when N_TOC_DISPLAY =>
            Append (Into, new Node_Type '(Kind => N_TOC_DISPLAY, Len => 0));
            Into.Using_TOC := True;

      end  case;
   end Append;

   --  ------------------------------
   --  Append the text with the given format at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map) is
   begin
      Append (Into, new Node_Type '(Kind => N_TEXT, Len => Text'Length,
                                    Text => Text, Format => Format));
   end Append;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_LINK, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_IMAGE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_QUOTE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Quote;

   --  ------------------------------
   --  Add a list item (<li>).  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 (Into     : in out Document;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Ordered then
         Append (Into, new Node_Type '(Kind => N_NUM_LIST, Len => 0,
                                       Level => Level, others => <>));
      else
         Append (Into, new Node_Type '(Kind => N_LIST, Len => 0,
                                       Level => Level, others => <>));
      end if;
   end Add_List_Item;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Into     : in out Document;
                             Level    : in Natural) is
   begin
      Append (Into, new Node_Type '(Kind => N_BLOCKQUOTE, Len => 0,
                                    Level => Level, others => <>));
   end Add_Blockquote;

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
      pragma Unreferenced (Format);
   begin
      Append (Into, new Node_Type '(Kind => N_PREFORMAT, Len => Text'Length,
                                    Preformatted => Text));
   end Add_Preformatted;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type)) is
   begin
      Iterate (Doc.Nodes, Process);
   end Iterate;

   --  ------------------------------
   --  Returns True if the document is empty.
   --  ------------------------------
   function Is_Empty (Doc : in Document) return Boolean is
   begin
      return Wiki.Nodes.Is_Empty (Doc.Nodes);
   end Is_Empty;

   --  ------------------------------
   --  Returns True if the document displays the table of contents by itself.
   --  ------------------------------
   function Is_Using_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Using_TOC;
   end Is_Using_TOC;

   --  ------------------------------
   --  Returns True if the table of contents is visible and must be rendered.
   --  ------------------------------
   function Is_Visible_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Visible_TOC;
   end Is_Visible_TOC;

   --  ------------------------------
   --  Hide the table of contents.
   --  ------------------------------
   procedure Hide_TOC (Doc : in out Document) is
   begin
      Doc.Visible_TOC := False;
   end Hide_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Node_List_Ref) is
   begin
      if Wiki.Nodes.Is_Empty (Doc.TOC) then
         Append (Doc.TOC, new Node_Type '(Kind => N_TOC, Len => 0, others => <>));
      end if;
      TOC := Doc.TOC;
   end Get_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Node_List_Ref is
   begin
      return Doc.TOC;
   end Get_TOC;

end Wiki.Documents;

-----------------------------------------------------------------------
--  wiki-nodes -- Wiki Document Internal representation
--  Copyright (C) 2016, 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.
-----------------------------------------------------------------------

package body Wiki.Documents is

   use Wiki.Nodes;

   --  ------------------------------
   --  Append a HTML tag start node to the document.
   --  ------------------------------
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List) is

      Node : constant Node_Type_Access := new Node_Type '(Kind       => N_TAG_START,
                                                          Len        => 0,
                                                          Tag_Start  => Tag,
                                                          Attributes => Attributes,
                                                          Children   => null,
                                                          Parent     => Into.Current);
   begin
      Append (Into, Node);
      Into.Current := Node;
   end Push_Node;

   --  ------------------------------
   --  Pop the HTML tag.
   --  ------------------------------
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag) is
      pragma Unreferenced (Tag);
   begin
      if From.Current /= null then
         From.Current := From.Current.Parent;
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Returns True if the current node is the root document node.
   --  ------------------------------
   function Is_Root_Node (Doc : in Document) return Boolean is
   begin
      return Doc.Current = null;
   end Is_Root_Node;

   --  ------------------------------
   --  Append a section header at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive) is
   begin
      Append (Into, new Node_Type '(Kind   => N_HEADER,
                                    Len    => Header'Length,
                                    Header => Header,
                                    Level  => Level));
   end Append;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access) is
   begin
      if Into.Current = null then
         Append (Into.Nodes, Node);
      else
         Append (Into.Current, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind) is
   begin
      case Kind is
         when N_LINE_BREAK =>
            Append (Into, new Node_Type '(Kind => N_LINE_BREAK, Len => 0));

         when N_HORIZONTAL_RULE =>
            Append (Into, new Node_Type '(Kind => N_HORIZONTAL_RULE, Len => 0));

         when N_PARAGRAPH =>
            Append (Into, new Node_Type '(Kind => N_PARAGRAPH, Len => 0));

         when N_NEWLINE =>
            Append (Into, new Node_Type '(Kind => N_NEWLINE, Len => 0));

         when N_TOC_DISPLAY =>
            Append (Into, new Node_Type '(Kind => N_TOC_DISPLAY, Len => 0));
            Into.Using_TOC := True;

      end  case;
   end Append;

   --  ------------------------------
   --  Append the text with the given format at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map) is
   begin
      Append (Into, new Node_Type '(Kind => N_TEXT, Len => Text'Length,
                                    Text => Text, Format => Format));
   end Append;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_LINK, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_IMAGE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_QUOTE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Quote;

   --  ------------------------------
   --  Add a list item (<li>).  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 (Into     : in out Document;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Ordered then
         Append (Into, new Node_Type '(Kind => N_NUM_LIST, Len => 0,
                                       Level => Level, others => <>));
      else
         Append (Into, new Node_Type '(Kind => N_LIST, Len => 0,
                                       Level => Level, others => <>));
      end if;
   end Add_List_Item;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Into     : in out Document;
                             Level    : in Natural) is
   begin
      Append (Into, new Node_Type '(Kind => N_BLOCKQUOTE, Len => 0,
                                    Level => Level, others => <>));
   end Add_Blockquote;

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
      pragma Unreferenced (Format);
   begin
      Append (Into, new Node_Type '(Kind => N_PREFORMAT, Len => Text'Length,
                                    Preformatted => Text));
   end Add_Preformatted;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type)) is
   begin
      Iterate (Doc.Nodes, Process);
   end Iterate;

   --  ------------------------------
   --  Returns True if the document is empty.
   --  ------------------------------
   function Is_Empty (Doc : in Document) return Boolean is
   begin
      return Wiki.Nodes.Is_Empty (Doc.Nodes);
   end Is_Empty;

   --  ------------------------------
   --  Returns True if the document displays the table of contents by itself.
   --  ------------------------------
   function Is_Using_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Using_TOC;
   end Is_Using_TOC;

   --  ------------------------------
   --  Returns True if the table of contents is visible and must be rendered.
   --  ------------------------------
   function Is_Visible_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Visible_TOC;
   end Is_Visible_TOC;

   --  ------------------------------
   --  Hide the table of contents.
   --  ------------------------------
   procedure Hide_TOC (Doc : in out Document) is
   begin
      Doc.Visible_TOC := False;
   end Hide_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Node_List_Ref) is
   begin
      if Wiki.Nodes.Is_Empty (Doc.TOC) then
         Append (Doc.TOC, new Node_Type '(Kind => N_TOC, Len => 0, others => <>));
      end if;
      TOC := Doc.TOC;
   end Get_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Node_List_Ref is
   begin
      return Doc.TOC;
   end Get_TOC;

end Wiki.Documents;

Create the N_NEWLINE node in the document


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

package body Wiki.Documents is

   use Wiki.Nodes;

   --  ------------------------------
   --  Append a HTML tag start node to the document.
   --  ------------------------------
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List) is

      Node : constant Node_Type_Access := new Node_Type '(Kind       => N_TAG_START,
                                                          Len        => 0,
                                                          Tag_Start  => Tag,
                                                          Attributes => Attributes,
                                                          Children   => null,
                                                          Parent     => Into.Current);
   begin
      Append (Into, Node);
      Into.Current := Node;
   end Push_Node;

   --  ------------------------------
   --  Pop the HTML tag.
   --  ------------------------------
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag) is
      pragma Unreferenced (Tag);
   begin
      if From.Current /= null then
         From.Current := From.Current.Parent;
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Returns True if the current node is the root document node.
   --  ------------------------------
   function Is_Root_Node (Doc : in Document) return Boolean is
   begin
      return Doc.Current = null;
   end Is_Root_Node;

   --  ------------------------------
   --  Append a section header at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive) is
   begin
      Append (Into, new Node_Type '(Kind   => N_HEADER,
                                    Len    => Header'Length,
                                    Header => Header,
                                    Level  => Level));
   end Append;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access) is
   begin
      if Into.Current = null then
         Append (Into.Nodes, Node);
      else
         Append (Into.Current, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind) is
   begin
      case Kind is
         when N_LINE_BREAK =>
            Append (Into, new Node_Type '(Kind => N_LINE_BREAK, Len => 0));

         when N_HORIZONTAL_RULE =>
            Append (Into, new Node_Type '(Kind => N_HORIZONTAL_RULE, Len => 0));

         when N_PARAGRAPH =>
            Append (Into, new Node_Type '(Kind => N_PARAGRAPH, Len => 0));

         when N_TOC_DISPLAY =>
            Append (Into, new Node_Type '(Kind => N_TOC_DISPLAY, Len => 0));
            Into.Using_TOC := True;

      end  case;
   end Append;

   --  ------------------------------
   --  Append the text with the given format at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map) is
   begin
      Append (Into, new Node_Type '(Kind => N_TEXT, Len => Text'Length,
                                    Text => Text, Format => Format));
   end Append;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_LINK, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_IMAGE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_QUOTE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Quote;

   --  ------------------------------
   --  Add a list item (<li>).  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 (Into     : in out Document;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Ordered then
         Append (Into, new Node_Type '(Kind => N_NUM_LIST, Len => 0,
                                       Level => Level, others => <>));
      else
         Append (Into, new Node_Type '(Kind => N_LIST, Len => 0,
                                       Level => Level, others => <>));
      end if;
   end Add_List_Item;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Into     : in out Document;
                             Level    : in Natural) is
   begin
      Append (Into, new Node_Type '(Kind => N_BLOCKQUOTE, Len => 0,
                                    Level => Level, others => <>));
   end Add_Blockquote;

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
      pragma Unreferenced (Format);
   begin
      Append (Into, new Node_Type '(Kind => N_PREFORMAT, Len => Text'Length,
                                    Preformatted => Text));
   end Add_Preformatted;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type)) is
   begin
      Iterate (Doc.Nodes, Process);
   end Iterate;

   --  ------------------------------
   --  Returns True if the document is empty.
   --  ------------------------------
   function Is_Empty (Doc : in Document) return Boolean is
   begin
      return Wiki.Nodes.Is_Empty (Doc.Nodes);
   end Is_Empty;

   --  ------------------------------
   --  Returns True if the document displays the table of contents by itself.
   --  ------------------------------
   function Is_Using_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Using_TOC;
   end Is_Using_TOC;

   --  ------------------------------
   --  Returns True if the table of contents is visible and must be rendered.
   --  ------------------------------
   function Is_Visible_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Visible_TOC;
   end Is_Visible_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Node_List_Ref) is
   begin
      if Wiki.Nodes.Is_Empty (Doc.TOC) then
         Append (Doc.TOC, new Node_Type '(Kind => N_TOC, Len => 0, others => <>));
      end if;
      TOC := Doc.TOC;
   end Get_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Node_List_Ref is
   begin
      return Doc.TOC;
   end Get_TOC;

end Wiki.Documents;

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

package body Wiki.Documents is

   use Wiki.Nodes;

   --  ------------------------------
   --  Append a HTML tag start node to the document.
   --  ------------------------------
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List) is

      Node : constant Node_Type_Access := new Node_Type '(Kind       => N_TAG_START,
                                                          Len        => 0,
                                                          Tag_Start  => Tag,
                                                          Attributes => Attributes,
                                                          Children   => null,
                                                          Parent     => Into.Current);
   begin
      Append (Into, Node);
      Into.Current := Node;
   end Push_Node;

   --  ------------------------------
   --  Pop the HTML tag.
   --  ------------------------------
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag) is
      pragma Unreferenced (Tag);
   begin
      if From.Current /= null then
         From.Current := From.Current.Parent;
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Returns True if the current node is the root document node.
   --  ------------------------------
   function Is_Root_Node (Doc : in Document) return Boolean is
   begin
      return Doc.Current = null;
   end Is_Root_Node;

   --  ------------------------------
   --  Append a section header at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive) is
   begin
      Append (Into, new Node_Type '(Kind   => N_HEADER,
                                    Len    => Header'Length,
                                    Header => Header,
                                    Level  => Level));
   end Append;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access) is
   begin
      if Into.Current = null then
         Append (Into.Nodes, Node);
      else
         Append (Into.Current, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind) is
   begin
      case Kind is
         when N_LINE_BREAK =>
            Append (Into, new Node_Type '(Kind => N_LINE_BREAK, Len => 0));

         when N_HORIZONTAL_RULE =>
            Append (Into, new Node_Type '(Kind => N_HORIZONTAL_RULE, Len => 0));

         when N_PARAGRAPH =>
            Append (Into, new Node_Type '(Kind => N_PARAGRAPH, Len => 0));

         when N_TOC_DISPLAY =>
            Append (Into, new Node_Type '(Kind => N_TOC_DISPLAY, Len => 0));
            Into.Using_TOC := True;

      end  case;
   end Append;

   --  ------------------------------
   --  Append the text with the given format at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map) is
   begin
      Append (Into, new Node_Type '(Kind => N_TEXT, Len => Text'Length,
                                    Text => Text, Format => Format));
   end Append;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_LINK, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_IMAGE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_QUOTE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Quote;

   --  ------------------------------
   --  Add a list item (<li>).  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 (Into     : in out Document;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Ordered then
         Append (Into, new Node_Type '(Kind => N_NUM_LIST, Len => 0,
                                       Level => Level, others => <>));
      else
         Append (Into, new Node_Type '(Kind => N_LIST, Len => 0,
                                       Level => Level, others => <>));
      end if;
   end Add_List_Item;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Into     : in out Document;
                             Level    : in Natural) is
   begin
      Append (Into, new Node_Type '(Kind => N_BLOCKQUOTE, Len => 0,
                                    Level => Level, others => <>));
   end Add_Blockquote;

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
      pragma Unreferenced (Format);
   begin
      Append (Into, new Node_Type '(Kind => N_PREFORMAT, Len => Text'Length,
                                    Preformatted => Text));
   end Add_Preformatted;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type)) is
   begin
      Iterate (Doc.Nodes, Process);
   end Iterate;

   --  ------------------------------
   --  Returns True if the document is empty.
   --  ------------------------------
   function Is_Empty (Doc : in Document) return Boolean is
   begin
      return Wiki.Nodes.Is_Empty (Doc.Nodes);
   end Is_Empty;

   --  ------------------------------
   --  Returns True if the document displays the table of contents by itself.
   --  ------------------------------
   function Is_Using_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Using_TOC;
   end Is_Using_TOC;

   --  ------------------------------
   --  Returns True if the table of contents is visible and must be rendered.
   --  ------------------------------
   function Is_Visible_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Visible_TOC;
   end Is_Visible_TOC;

   --  ------------------------------
   --  Hide the table of contents.
   --  ------------------------------
   procedure Hide_TOC (Doc : in out Document) is
   begin
      Doc.Visible_TOC := False;
   end Hide_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Node_List_Ref) is
   begin
      if Wiki.Nodes.Is_Empty (Doc.TOC) then
         Append (Doc.TOC, new Node_Type '(Kind => N_TOC, Len => 0, others => <>));
      end if;
      TOC := Doc.TOC;
   end Get_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Node_List_Ref is
   begin
      return Doc.TOC;
   end Get_TOC;

end Wiki.Documents;

Implement Hide_TOC procedure to mark the table of content as hidden on the document


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

with Ada.Command_Line;
procedure Print_User is

   use ADO;
   use Ada;
   use Samples.User.Model;

   Factory : ADO.Sessions.Factory.Session_Factory;
begin
   Util.Log.Loggers.Initialize ("samples.properties");

   --  Initialize the database drivers.
   ADO.Drivers.Initialize ("samples.properties");

   if Ada.Command_Line.Argument_Count < 1 then
      Ada.Text_IO.Put_Line ("Usage: print_user user-name ...");
      Ada.Text_IO.Put_Line ("Example: print_user joe");
      Ada.Command_Line.Set_Exit_Status (2);
      return;
   end if;

   --  Create and configure the connection pool
   Factory.Create (ADO.Drivers.Get_Config ("ado.database"));

   declare
      Session : ADO.Sessions.Session := Factory.Get_Session;
      User    : User_Ref;
      Found   : Boolean;
   begin
      for I in 1 .. Ada.Command_Line.Argument_Count loop
         declare
            User_Name : constant String := Ada.Command_Line.Argument (I);
            Query     : ADO.SQL.Query;
         begin
            Ada.Text_IO.Put_Line ("Searching '" & User_Name & "'...");
            Query.Bind_Param (1, User_Name);
            Query.Set_Filter ("name = ?");
            User.Find (Session => Session, Query => Query, Found => Found);
            if Found then
               Ada.Text_IO.Put_Line ("  Id     :  " & Identifier'Image (User.Get_Id));
               Ada.Text_IO.Put_Line ("  User   :  " & User.Get_Name);
               Ada.Text_IO.Put_Line ("  Email  :  " & User.Get_Email);
            else
               Ada.Text_IO.Put_Line ("  User '" & User_Name & "' does not exist");
            end if;
         end;
      end loop;
   end;
end Print_User;

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

with Ada.Command_Line;
procedure Print_User is

   use ADO;
   use Ada;
   use Samples.User.Model;

   Factory : ADO.Sessions.Factory.Session_Factory;
begin
   Util.Log.Loggers.Initialize ("samples.properties");

   --  Initialize the database drivers.
   ADO.Drivers.Initialize ("samples.properties");

   if Ada.Command_Line.Argument_Count < 1 then
      Ada.Text_IO.Put_Line ("Usage: print_user user-name ...");
      Ada.Text_IO.Put_Line ("Example: print_user joe");
      Ada.Command_Line.Set_Exit_Status (2);
      return;
   end if;

   --  Create and configure the connection pool
   Factory.Create (ADO.Drivers.Get_Config ("ado.database"));

   declare
      Session : ADO.Sessions.Session := Factory.Get_Session;
      User    : User_Ref;
      Found   : Boolean;
   begin
      for I in 1 .. Ada.Command_Line.Argument_Count loop
         declare
            User_Name : constant String := Ada.Command_Line.Argument (I);
            Query     : ADO.SQL.Query;
         begin
            Ada.Text_IO.Put_Line ("Searching '" & User_Name & "'...");
            Query.Bind_Param (1, User_Name);
            Query.Set_Filter ("name = ?");
            User.Find (Session => Session, Query => Query, Found => Found);
            if Found then
               Ada.Text_IO.Put_Line ("  Id     :  " & Identifier'Image (User.Get_Id));
               Ada.Text_IO.Put_Line ("  User   :  " & User.Get_Name);
               Ada.Text_IO.Put_Line ("  Email  :  " & User.Get_Email);
            else
               Ada.Text_IO.Put_Line ("  User '" & User_Name & "' does not exist");
            end if;
         end;
      end loop;
   end;
end Print_User;

Update driver registration and initialization


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

package body Util.Mail is

   --  ------------------------------
   --  Parse the email address and separate the name from the address.
   --  ------------------------------
   function Parse_Address (E_Mail : in String) return Email_Address is
      use Ada.Strings.Unbounded;
      use Ada.Strings.Fixed;
      use Ada.Strings;

      Result    : Email_Address;
      First_Pos : constant Natural := Index (E_Mail, "<");
      Last_Pos  : constant Natural := Index (E_Mail, ">");
      At_Pos    : constant Natural := Index (E_Mail, "@");
   begin
      if First_Pos > 0 and Last_Pos > 0 then
         Result.Name := To_Unbounded_String (Trim (E_Mail (E_Mail'First .. First_Pos - 1),
                                             Both));
         Result.Address := To_Unbounded_String (Trim (E_Mail (First_Pos + 1 .. Last_Pos - 1),
                                                Both));
         if Length (Result.Name) = 0 and At_Pos < Last_Pos then
            Result.Name := To_Unbounded_String (Trim (E_Mail (First_Pos + 1 .. At_Pos - 1), Both));
         end if;
      else
         Result.Address := To_Unbounded_String (Trim (E_Mail, Both));
         Result.Name := To_Unbounded_String (Trim (E_Mail (E_Mail'First .. At_Pos - 1), Both));
      end if;
      return Result;
   end Parse_Address;

end Util.Mail;

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

package body Util.Mail is

   use Ada.Strings.Unbounded;
   use Ada.Strings.Fixed;
   use Ada.Strings;

   --  ------------------------------
   --  Parse the email address and separate the name from the address.
   --  ------------------------------
   function Parse_Address (E_Mail : in String) return Email_Address is
      Result    : Email_Address;
      First_Pos : constant Natural := Index (E_Mail, "<");
      Last_Pos  : constant Natural := Index (E_Mail, ">");
      At_Pos    : constant Natural := Index (E_Mail, "@");
   begin
      if First_Pos > 0 and Last_Pos > 0 then
         Result.Name := To_Unbounded_String (Trim (E_Mail (E_Mail'First .. First_Pos - 1),
                                             Both));
         Result.Address := To_Unbounded_String (Trim (E_Mail (First_Pos + 1 .. Last_Pos - 1),
                                                Both));
         if Length (Result.Name) = 0 and At_Pos < Last_Pos then
            Result.Name := To_Unbounded_String (Trim (E_Mail (First_Pos + 1 .. At_Pos - 1), Both));
         end if;
      else
         Result.Address := To_Unbounded_String (Trim (E_Mail, Both));
         Result.Name := To_Unbounded_String (Trim (E_Mail (E_Mail'First .. At_Pos - 1), Both));
      end if;
      return Result;
   end Parse_Address;

   --  ------------------------------
   --  Extract a first name from the email address.
   --  ------------------------------
   function Get_First_Name (From : in Email_Address) return String is
      Name : constant String := To_String (From.Name);
      Pos  : Natural := Index (Name, " ");
   begin
      if Pos > 0 then
         return Name (Name'First .. Pos - 1);
      end if;
      Pos := Index (Name, ".");
      if Pos > 0 then
         return Name (Name'First .. Pos - 1);
      else
         return "";
      end if;
   end Get_First_Name;

end Util.Mail;

Implement the Get_First_Name function to extract a possible first name from the email address


-----------------------------------------------------------------------
--  util-http-clients-web -- HTTP Clients with AWS implementation
--  Copyright (C) 2011, 2012, 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 AWS.Headers.Set;
with AWS.Client;
with AWS.Messages;
with Util.Log.Loggers;
package body Util.Http.Clients.Web is

   Log   : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Http.Clients.Web");

   Manager : aliased AWS_Http_Manager;

   --  ------------------------------
   --  Register the Http manager.
   --  ------------------------------
   procedure Register is
   begin
      Default_Http_Manager := Manager'Access;
   end Register;

   function To_Status (Code : in AWS.Messages.Status_Code) return Natural;

   function To_Status (Code : in AWS.Messages.Status_Code) return Natural is
      use AWS.Messages;
   begin
      case Code is
         when S100 =>
            return 100;
         when S101 =>
            return 101;
         when S102 =>
            return 102;
         when S200 =>
            return 200;
         when S201 =>
            return 201;
         when S203 =>
            return 203;
         when S204 =>
            return 204;
         when S205 =>
            return 205;
         when S206 =>
            return 206;
         when S207 =>
            return 207;
         when S300 =>
            return 300;
         when S301 =>
            return 301;
         when S302 =>
            return 302;
         when S303 =>
            return 303;
         when S304 =>
            return 304;
         when S305 =>
            return 305;
         when S307 =>
            return 307;
         when S400 =>
            return 400;
         when S401 =>
            return 401;
         when S402 =>
            return 402;
         when S403 =>
            return 403;
         when S404 =>
            return 404;
         when S405 =>
            return 405;
         when S406 =>
            return 406;
         when S407 =>
            return 407;
         when S408 =>
            return 408;
         when S409 =>
            return 409;
         when S410 =>
            return 410;
         when S411 =>
            return 411;
         when S412 =>
            return 412;
         when S413 =>
            return 413;
         when S414 =>
            return 414;
         when S415 =>
            return 415;
         when S416 =>
            return 416;
         when S417 =>
            return 417;
         when S422 =>
            return 422;
         when S423 =>
            return 423;
         when S424 =>
            return 424;
         when S500 =>
            return 500;
         when S501 =>
            return 501;
         when S502 =>
            return 502;
         when S503 =>
            return 503;
         when S504 =>
            return 504;
         when S505 =>
            return 505;
         when S507 =>
            return 507;
         when others =>
            return 500;
      end case;
   end To_Status;

   procedure Create (Manager  : in AWS_Http_Manager;
                     Http     : in out Client'Class) is
      pragma Unreferenced (Manager);
   begin
      Http.Delegate := new AWS_Http_Request;
   end Create;

   overriding
   procedure Do_Get (Manager  : in AWS_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);

      Req     : constant AWS_Http_Request_Access
        := AWS_Http_Request'Class (Http.Delegate.all)'Access;
      Rep     : constant AWS_Http_Response_Access := new AWS_Http_Response;
   begin
      Log.Info ("Get {0}", URI);

      Reply.Delegate := Rep.all'Access;
      Rep.Data       := AWS.Client.Get (URL => URI, Headers => Req.Headers);
   end Do_Get;

   overriding
   procedure Do_Post (Manager  : in AWS_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is
      pragma Unreferenced (Manager);

      Req     : constant AWS_Http_Request_Access
        := AWS_Http_Request'Class (Http.Delegate.all)'Access;
      Rep     : constant AWS_Http_Response_Access := new AWS_Http_Response;
   begin
      Log.Info ("Post {0}", URI);

      Reply.Delegate := Rep.all'Access;
      Rep.Data       := AWS.Client.Post (URL => URI, Data => Data, Headers => Req.Headers);
   end Do_Post;

   overriding
   procedure Do_Put (Manager  : in AWS_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Data     : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);

      Req     : constant AWS_Http_Request_Access
        := AWS_Http_Request'Class (Http.Delegate.all)'Access;
      Rep     : constant AWS_Http_Response_Access := new AWS_Http_Response;
   begin
      Log.Info ("Put {0}", URI);

      Reply.Delegate := Rep.all'Access;
      Rep.Data       := AWS.Client.Put (URL => URI, Data => Data, Headers => Req.Headers);
   end Do_Put;

   --  ------------------------------
   --  Returns a boolean indicating whether the named request header has already
   --  been set.
   --  ------------------------------
   function Contains_Header (Http : in AWS_Http_Request;
                             Name : in String) return Boolean is
   begin
      raise Program_Error with "Contains_Header is not implemented";
      return False;
   end Contains_Header;

   --  Returns the value of the specified request header as a String. If the request
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   overriding
   function Get_Header (Request : in AWS_Http_Request;
                        Name    : in String) return String is
   begin
      return "";
   end Get_Header;

   --  ------------------------------
   --  Sets a request header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   --  ------------------------------
   overriding
   procedure Set_Header (Http  : in out AWS_Http_Request;
                         Name  : in String;
                         Value : in String) is
   begin
      AWS.Headers.Set.Add (Http.Headers, Name, Value);
   end Set_Header;

   --  ------------------------------
   --  Adds a request header with the given name and value.
   --  This method allows request headers to have multiple values.
   --  ------------------------------
   overriding
   procedure Add_Header (Http  : in out AWS_Http_Request;
                         Name  : in String;
                         Value : in String) is
   begin
      AWS.Headers.Set.Add (Http.Headers, Name, Value);
   end Add_Header;

   --  Iterate over the request headers and executes the Process procedure.
   overriding
   procedure Iterate_Headers (Request : in AWS_Http_Request;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is
   begin
      null;
   end Iterate_Headers;

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   function Contains_Header (Reply : in AWS_Http_Response;
                             Name  : in String) return Boolean is
   begin
      return AWS.Response.Header (Reply.Data, Name) /= "";
   end Contains_Header;

   --  ------------------------------
   --  Returns the value of the specified response header as a String. If the response
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   --  ------------------------------
   function Get_Header (Reply  : in AWS_Http_Response;
                        Name   : in String) return String is
   begin
      return AWS.Response.Header (Reply.Data, Name);
   end Get_Header;

   --  Sets a message header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   overriding
   procedure Set_Header (Reply    : in out AWS_Http_Response;
                         Name     : in String;
                         Value    : in String) is
   begin
      null;
   end Set_Header;

   --  Adds a request header with the given name and value.
   --  This method allows request headers to have multiple values.
   overriding
   procedure Add_Header (Reply   : in out AWS_Http_Response;
                         Name    : in String;
                         Value   : in String) is
   begin
      null;
   end Add_Header;

   --  Iterate over the response headers and executes the Process procedure.
   overriding
   procedure Iterate_Headers (Reply   : in AWS_Http_Response;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is
   begin
      null;
   end Iterate_Headers;

   --  ------------------------------
   --  Get the response body as a string.
   --  ------------------------------
   function Get_Body (Reply : in AWS_Http_Response) return String is
   begin
      return AWS.Response.Message_Body (Reply.Data);
   end Get_Body;

   --  Get the response status code.
   overriding
   function Get_Status (Reply : in AWS_Http_Response) return Natural is
   begin
      return To_Status (AWS.Response.Status_Code (Reply.Data));
   end Get_Status;

end Util.Http.Clients.Web;

-----------------------------------------------------------------------
--  util-http-clients-web -- HTTP Clients with AWS implementation
--  Copyright (C) 2011, 2012, 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 AWS.Headers.Set;
with AWS.Client;
with AWS.Messages;
with Util.Log.Loggers;
package body Util.Http.Clients.Web is

   Log   : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Http.Clients.Web");

   Manager : aliased AWS_Http_Manager;

   --  ------------------------------
   --  Register the Http manager.
   --  ------------------------------
   procedure Register is
   begin
      Default_Http_Manager := Manager'Access;
   end Register;

   function To_Status (Code : in AWS.Messages.Status_Code) return Natural;

   function To_Status (Code : in AWS.Messages.Status_Code) return Natural is
      use AWS.Messages;
   begin
      case Code is
         when S100 =>
            return 100;
         when S101 =>
            return 101;
         when S102 =>
            return 102;
         when S200 =>
            return 200;
         when S201 =>
            return 201;
         when S203 =>
            return 203;
         when S204 =>
            return 204;
         when S205 =>
            return 205;
         when S206 =>
            return 206;
         when S207 =>
            return 207;
         when S300 =>
            return 300;
         when S301 =>
            return 301;
         when S302 =>
            return 302;
         when S303 =>
            return 303;
         when S304 =>
            return 304;
         when S305 =>
            return 305;
         when S307 =>
            return 307;
         when S400 =>
            return 400;
         when S401 =>
            return 401;
         when S402 =>
            return 402;
         when S403 =>
            return 403;
         when S404 =>
            return 404;
         when S405 =>
            return 405;
         when S406 =>
            return 406;
         when S407 =>
            return 407;
         when S408 =>
            return 408;
         when S409 =>
            return 409;
         when S410 =>
            return 410;
         when S411 =>
            return 411;
         when S412 =>
            return 412;
         when S413 =>
            return 413;
         when S414 =>
            return 414;
         when S415 =>
            return 415;
         when S416 =>
            return 416;
         when S417 =>
            return 417;
         when S422 =>
            return 422;
         when S423 =>
            return 423;
         when S424 =>
            return 424;
         when S500 =>
            return 500;
         when S501 =>
            return 501;
         when S502 =>
            return 502;
         when S503 =>
            return 503;
         when S504 =>
            return 504;
         when S505 =>
            return 505;
         when S507 =>
            return 507;
         when others =>
            return 500;
      end case;
   end To_Status;

   procedure Create (Manager  : in AWS_Http_Manager;
                     Http     : in out Client'Class) is
      pragma Unreferenced (Manager);
   begin
      Http.Delegate := new AWS_Http_Request;
   end Create;

   overriding
   procedure Do_Get (Manager  : in AWS_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);

      Req     : constant AWS_Http_Request_Access
        := AWS_Http_Request'Class (Http.Delegate.all)'Access;
      Rep     : constant AWS_Http_Response_Access := new AWS_Http_Response;
   begin
      Log.Info ("Get {0}", URI);

      Reply.Delegate := Rep.all'Access;
      Rep.Data       := AWS.Client.Get (URL => URI, Headers => Req.Headers);
   end Do_Get;

   overriding
   procedure Do_Post (Manager  : in AWS_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is
      pragma Unreferenced (Manager);

      Req     : constant AWS_Http_Request_Access
        := AWS_Http_Request'Class (Http.Delegate.all)'Access;
      Rep     : constant AWS_Http_Response_Access := new AWS_Http_Response;
   begin
      Log.Info ("Post {0}", URI);

      Reply.Delegate := Rep.all'Access;
      Rep.Data       := AWS.Client.Post (URL => URI, Data => Data, Headers => Req.Headers);
   end Do_Post;

   overriding
   procedure Do_Put (Manager  : in AWS_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Data     : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);

      Req     : constant AWS_Http_Request_Access
        := AWS_Http_Request'Class (Http.Delegate.all)'Access;
      Rep     : constant AWS_Http_Response_Access := new AWS_Http_Response;
   begin
      Log.Info ("Put {0}", URI);

      Reply.Delegate := Rep.all'Access;
      Rep.Data       := AWS.Client.Put (URL => URI, Data => Data, Headers => Req.Headers);
   end Do_Put;

   --  Set the timeout for the connection.
   overriding
   procedure Set_Timeout (Manager : in AWS_Http_Manager;
                          Http    : in Client'Class;
                          Timeout : in Duration) is
   begin
      null;
   end Set_Timeout;

   --  ------------------------------
   --  Returns a boolean indicating whether the named request header has already
   --  been set.
   --  ------------------------------
   function Contains_Header (Http : in AWS_Http_Request;
                             Name : in String) return Boolean is
   begin
      raise Program_Error with "Contains_Header is not implemented";
      return False;
   end Contains_Header;

   --  Returns the value of the specified request header as a String. If the request
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   overriding
   function Get_Header (Request : in AWS_Http_Request;
                        Name    : in String) return String is
   begin
      return "";
   end Get_Header;

   --  ------------------------------
   --  Sets a request header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   --  ------------------------------
   overriding
   procedure Set_Header (Http  : in out AWS_Http_Request;
                         Name  : in String;
                         Value : in String) is
   begin
      AWS.Headers.Set.Add (Http.Headers, Name, Value);
   end Set_Header;

   --  ------------------------------
   --  Adds a request header with the given name and value.
   --  This method allows request headers to have multiple values.
   --  ------------------------------
   overriding
   procedure Add_Header (Http  : in out AWS_Http_Request;
                         Name  : in String;
                         Value : in String) is
   begin
      AWS.Headers.Set.Add (Http.Headers, Name, Value);
   end Add_Header;

   --  Iterate over the request headers and executes the Process procedure.
   overriding
   procedure Iterate_Headers (Request : in AWS_Http_Request;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is
   begin
      null;
   end Iterate_Headers;

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   function Contains_Header (Reply : in AWS_Http_Response;
                             Name  : in String) return Boolean is
   begin
      return AWS.Response.Header (Reply.Data, Name) /= "";
   end Contains_Header;

   --  ------------------------------
   --  Returns the value of the specified response header as a String. If the response
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   --  ------------------------------
   function Get_Header (Reply  : in AWS_Http_Response;
                        Name   : in String) return String is
   begin
      return AWS.Response.Header (Reply.Data, Name);
   end Get_Header;

   --  Sets a message header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   overriding
   procedure Set_Header (Reply    : in out AWS_Http_Response;
                         Name     : in String;
                         Value    : in String) is
   begin
      null;
   end Set_Header;

   --  Adds a request header with the given name and value.
   --  This method allows request headers to have multiple values.
   overriding
   procedure Add_Header (Reply   : in out AWS_Http_Response;
                         Name    : in String;
                         Value   : in String) is
   begin
      null;
   end Add_Header;

   --  Iterate over the response headers and executes the Process procedure.
   overriding
   procedure Iterate_Headers (Reply   : in AWS_Http_Response;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is
   begin
      null;
   end Iterate_Headers;

   --  ------------------------------
   --  Get the response body as a string.
   --  ------------------------------
   function Get_Body (Reply : in AWS_Http_Response) return String is
   begin
      return AWS.Response.Message_Body (Reply.Data);
   end Get_Body;

   --  Get the response status code.
   overriding
   function Get_Status (Reply : in AWS_Http_Response) return Natural is
   begin
      return To_Status (AWS.Response.Status_Code (Reply.Data));
   end Get_Status;

end Util.Http.Clients.Web;

Implement the Set_Timeout procedure

Implement the Set_Timeout procedure


-----------------------------------------------------------------------
--  druss-config -- Configuration management for Druss
--  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 Druss.Gateways;
package Druss.Config is

   --  Initialize the configuration.
   procedure Initialize (Path : in String);

   --  Get the configuration parameter.
   function Get (Name : in String) return String;

   --  Initalize the list of gateways from the configuration file.
   procedure Get_Gateways (List   : in out Druss.Gateways.Gateway_Vector);

end Druss.Config;

-----------------------------------------------------------------------
--  druss-config -- Configuration management for Druss
--  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 Druss.Gateways;
package Druss.Config is

   --  Initialize the configuration.
   procedure Initialize (Path : in String);

   --  Get the configuration parameter.
   function Get (Name : in String) return String;

   --  Initalize the list of gateways from the configuration file.
   procedure Get_Gateways (List   : in out Druss.Gateways.Gateway_Vector);

   --  Save the list of gateways.
   procedure Save_Gateways (List  : in Druss.Gateways.Gateway_Vector);

end Druss.Config;

Declare the Save_Gateways procedure

Declare the Save_Gateways procedure


-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 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 ADO.Queries.Loaders;
package body ADO.Queries is

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   --  ------------------------------
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := False;
   end Set_Query;

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   --  ------------------------------
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := True;
   end Set_Count_Query;

   procedure Set_Query (Into  : in out Context;
                        Name  : in String) is
   begin
      Into.Query_Def := ADO.Queries.Loaders.Find_Query (Name);
   end Set_Query;

   --  ------------------------------
   --  Set the query to execute as SQL statement.
   --  ------------------------------
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String) is
   begin
      ADO.SQL.Clear (Into.SQL);
      ADO.SQL.Append (Into.SQL, SQL);
   end Set_SQL;

   --  ------------------------------
   --  Set the limit for the SQL query.
   --  ------------------------------
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural) is
   begin
      Into.First := First;
      Into.Last  := Last;
   end Set_Limit;

   --  ------------------------------
   --  Get the first row index.
   --  ------------------------------
   function Get_First_Row_Index (From : in Context) return Natural is
   begin
      return From.First;
   end Get_First_Row_Index;

   --  ------------------------------
   --  Get the last row index.
   --  ------------------------------
   function Get_Last_Row_Index (From : in Context) return Natural is
   begin
      return From.Last;
   end Get_Last_Row_Index;

   --  ------------------------------
   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the <b>sql-count</b> query.
   --  ------------------------------
   function Get_Max_Row_Count (From : in Context) return Natural is
   begin
      return From.Max_Row_Count;
   end Get_Max_Row_Count;

   --  ------------------------------
   --  Get the SQL query that correspond to the query context.
   --  ------------------------------
   function Get_SQL (From   : in Context;
                     Manager : in Query_Manager_Access) return String is
   begin
      if From.Query_Def = null then
         return ADO.SQL.To_String (From.SQL);
      else
         return Get_SQL (From.Query_Def, Manager, From.Is_Count);
      end if;
   end Get_SQL;

   --  ------------------------------
   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   --  ------------------------------
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access is
      Query : Query_Definition_Access := File.File.Queries;
   begin
      while Query /= null loop
         if Query.Name.all = Name then
            return Query;
         end if;
         Query := Query.Next;
      end loop;
      return null;
   end Find_Query;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager_Access;
                     Use_Count : in Boolean) return String is
      Query : Query_Info_Ref.Ref;
   begin
      ADO.Queries.Loaders.Read_Query (Manager.all, From);
      Query := Manager.Queries (From.Query).Get;
      if Query.Is_Null then
         return "";
      end if;
      if Use_Count then
         if Length (Query.Value.Count_Query (Manager.Driver).SQL) > 0 then
            return To_String (Query.Value.Count_Query (Manager.Driver).SQL);
         else
            return To_String (Query.Value.Count_Query (ADO.Drivers.Driver_Index'First).SQL);
         end if;
      elsif Length (Query.Value.Main_Query (Manager.Driver).SQL) > 0 then
         return To_String (Query.Value.Main_Query (Manager.Driver).SQL);
      else
         return To_String (Query.Value.Main_Query (ADO.Drivers.Driver_Index'First).SQL);
      end if;
   end Get_SQL;

end ADO.Queries;

-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 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 ADO.Queries.Loaders;
package body ADO.Queries is

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   --  ------------------------------
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := False;
   end Set_Query;

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   --  ------------------------------
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := True;
   end Set_Count_Query;

   procedure Set_Query (Into  : in out Context;
                        Name  : in String) is
   begin
      Into.Query_Def := ADO.Queries.Loaders.Find_Query (Name);
   end Set_Query;

   --  ------------------------------
   --  Set the query to execute as SQL statement.
   --  ------------------------------
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String) is
   begin
      ADO.SQL.Clear (Into.SQL);
      ADO.SQL.Append (Into.SQL, SQL);
   end Set_SQL;

   --  ------------------------------
   --  Set the limit for the SQL query.
   --  ------------------------------
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural) is
   begin
      Into.First := First;
      Into.Last  := Last;
   end Set_Limit;

   --  ------------------------------
   --  Get the first row index.
   --  ------------------------------
   function Get_First_Row_Index (From : in Context) return Natural is
   begin
      return From.First;
   end Get_First_Row_Index;

   --  ------------------------------
   --  Get the last row index.
   --  ------------------------------
   function Get_Last_Row_Index (From : in Context) return Natural is
   begin
      return From.Last;
   end Get_Last_Row_Index;

   --  ------------------------------
   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the <b>sql-count</b> query.
   --  ------------------------------
   function Get_Max_Row_Count (From : in Context) return Natural is
   begin
      return From.Max_Row_Count;
   end Get_Max_Row_Count;

   --  ------------------------------
   --  Get the SQL query that correspond to the query context.
   --  ------------------------------
   function Get_SQL (From   : in Context;
                     Manager : in Query_Manager'Class) return String is
   begin
      if From.Query_Def = null then
         return ADO.SQL.To_String (From.SQL);
      else
         return Get_SQL (From.Query_Def, Manager, From.Is_Count);
      end if;
   end Get_SQL;

   --  ------------------------------
   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   --  ------------------------------
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access is
      Query : Query_Definition_Access := File.File.Queries;
   begin
      while Query /= null loop
         if Query.Name.all = Name then
            return Query;
         end if;
         Query := Query.Next;
      end loop;
      return null;
   end Find_Query;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String is
      Query : Query_Info_Ref.Ref;
   begin
      ADO.Queries.Loaders.Read_Query (Manager, From);
      Query := Manager.Queries (From.Query).Get;
      if Query.Is_Null then
         return "";
      end if;
      if Use_Count then
         if Length (Query.Value.Count_Query (Manager.Driver).SQL) > 0 then
            return To_String (Query.Value.Count_Query (Manager.Driver).SQL);
         else
            return To_String (Query.Value.Count_Query (ADO.Drivers.Driver_Index'First).SQL);
         end if;
      elsif Length (Query.Value.Main_Query (Manager.Driver).SQL) > 0 then
         return To_String (Query.Value.Main_Query (Manager.Driver).SQL);
      else
         return To_String (Query.Value.Main_Query (ADO.Drivers.Driver_Index'First).SQL);
      end if;
   end Get_SQL;

   overriding
   procedure Finalize (Manager : in out Query_Manager) is
   begin
      null;
   end Finalize;

end ADO.Queries;

Replace Query_Manager_Access by Query_Manager as parameter Implement stub for Finalize procedure


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

   NO_IDENTIFIER : constant ADO.Identifier := ADO.NO_IDENTIFIER;

   subtype File_Identifier is ADO.Identifier;
   subtype Directory_Identifier is ADO.Identifier;
   subtype File_Size is Long_Long_Integer;
   type File_Mode is mod 2**16;
   type Uid_Type is mod 2**16;
   type Gid_Type is mod 2**16;

   type File_Type is private;
   type File_Type_Array is array (Positive range <>) of File_Type;
   type File_Type_Array_Access is access all File_Type_Array;

   type Directory_Type is private;
   type Directory_Type_Array is array (Positive range <>) of Directory_Type;
   type Directory_Type_Array_Access is access all Directory_Type_Array;

   NO_DIRECTORY : constant Directory_Type;
   NO_FILE      : constant File_Type;

   type Status_Type is mod 2**16;

   --  The file was modified.
   FILE_MODIFIED : constant Status_Type := 16#0001#;

   --  There was some error while processing this file.
   FILE_ERROR    : constant Status_Type := 16#8000#;

   --  The SHA1 signature for the file is known and valid.
   FILE_HAS_SHA1 : constant Status_Type := 16#0002#;

   --  Allocate a File_Type entry with the given name for the directory.
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type;

   --  Allocate a Directory_Type entry with the given name for the directory.
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return Directory_Type;

   type File (Len : Positive) is record
      Id     : File_Identifier := NO_IDENTIFIER;
      Size   : File_Size       := 0;
      Dir    : Directory_Type  := NO_DIRECTORY;
      Mode   : File_Mode       := 8#644#;
      User   : Uid_Type        := 0;
      Group  : Gid_Type        := 0;
      Status : Status_Type     := 0;
      Date   : Ada.Calendar.Time;
      SHA1   : Util.Encoders.SHA1.Hash_Array;
      Name   : aliased String (1 .. Len);
   end record;

   --  Return true if the file was modified and need a backup.
   function Is_Modified (Element : in File_Type) return Boolean;

   --  Set the file as modified.
   procedure Set_Modified (Element : in File_Type);

   --  Set the SHA1 signature that was computed for this file.
   --  If the computed signature is different from the current signature,
   --  the FILE_MODIFIED flag is set on the file.  The FILE_HAS_SHA1 flag
   --  is set on the file.
   procedure Set_Signature (Element   : in File_Type;
                            Signature : in Util.Encoders.SHA1.Hash_Array);

   --  Set the file size.  If the new size is different, the FILE_MODIFIED
   --  flag is set on the file.
   procedure Set_Size (Element : in File_Type;
                       Size    : in File_Size);

   --  Return the path for the file.
   function Get_Path (Element : in File_Type) return String;

   --  Return the path for the directory.
   function Get_Path (Element : in Directory_Type) return String;

   --  Return the SHA1 signature computed for the file.
   function Get_SHA1 (Element : in File_Type) return String;

   type File_Container is limited interface;

   --  Add the file with the given name in the container.
   procedure Add_File (Into    : in out File_Container;
                       Path    : in String;
                       Element : in File) is abstract;

   --  Add the directory with the given name in the container.
   procedure Add_Directory (Into : in out File_Container;
                            Path : in String;
                            Name : in String) is abstract;

   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   function Find (From : in File_Container;
                  Name : in String) return File_Type is abstract;

   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   function Find (From : in File_Container;
                  Name : in String) return Directory_Type is abstract;

private

   type Directory (Len : Positive) is record
      Id       : Directory_Identifier := NO_IDENTIFIER;
      Parent   : Directory_Type;
      Mode     : File_Mode := 8#755#;
      User     : Uid_Type  := 0;
      Group    : Gid_Type  := 0;
      Files    : File_Type_Array_Access;
      Children : Directory_Type_Array_Access;
      Path     : Ada.Strings.Unbounded.Unbounded_String;
      Name     : aliased String (1 .. Len);
   end record;

   type File_Type is access all File;

   type Directory_Type is access all Directory;

   NO_DIRECTORY : constant Directory_Type := null;
   NO_FILE      : constant File_Type := null;

end Babel.Files;

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

   NO_IDENTIFIER : constant ADO.Identifier := ADO.NO_IDENTIFIER;

   subtype File_Identifier is ADO.Identifier;
   subtype Directory_Identifier is ADO.Identifier;
   subtype File_Size is Long_Long_Integer;
   type File_Mode is mod 2**16;
   type Uid_Type is mod 2**16;
   type Gid_Type is mod 2**16;

   type File_Type is private;
   type File_Type_Array is array (Positive range <>) of File_Type;
   type File_Type_Array_Access is access all File_Type_Array;

   type Directory_Type is private;
   type Directory_Type_Array is array (Positive range <>) of Directory_Type;
   type Directory_Type_Array_Access is access all Directory_Type_Array;

   NO_DIRECTORY : constant Directory_Type;
   NO_FILE      : constant File_Type;

   type Status_Type is mod 2**16;

   --  The file was modified.
   FILE_MODIFIED : constant Status_Type := 16#0001#;

   --  There was some error while processing this file.
   FILE_ERROR    : constant Status_Type := 16#8000#;

   --  The SHA1 signature for the file is known and valid.
   FILE_HAS_SHA1 : constant Status_Type := 16#0002#;

   --  Allocate a File_Type entry with the given name for the directory.
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type;

   --  Allocate a Directory_Type entry with the given name for the directory.
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return Directory_Type;

   type File (Len : Positive) is record
      Id     : File_Identifier := NO_IDENTIFIER;
      Size   : File_Size       := 0;
      Dir    : Directory_Type  := NO_DIRECTORY;
      Mode   : File_Mode       := 8#644#;
      User   : Uid_Type        := 0;
      Group  : Gid_Type        := 0;
      Status : Status_Type     := 0;
      Date   : Ada.Calendar.Time;
      SHA1   : Util.Encoders.SHA1.Hash_Array;
      Name   : aliased String (1 .. Len);
   end record;

   --  Return true if the file was modified and need a backup.
   function Is_Modified (Element : in File_Type) return Boolean;

   --  Set the file as modified.
   procedure Set_Modified (Element : in File_Type);

   --  Set the SHA1 signature that was computed for this file.
   --  If the computed signature is different from the current signature,
   --  the FILE_MODIFIED flag is set on the file.  The FILE_HAS_SHA1 flag
   --  is set on the file.
   procedure Set_Signature (Element   : in File_Type;
                            Signature : in Util.Encoders.SHA1.Hash_Array);

   --  Set the file size.  If the new size is different, the FILE_MODIFIED
   --  flag is set on the file.
   procedure Set_Size (Element : in File_Type;
                       Size    : in File_Size);

   --  Return the path for the file.
   function Get_Path (Element : in File_Type) return String;

   --  Return the path for the directory.
   function Get_Path (Element : in Directory_Type) return String;

   --  Return the SHA1 signature computed for the file.
   function Get_SHA1 (Element : in File_Type) return String;

   type File_Container is limited interface;

   --  Add the file with the given name in the container.
   procedure Add_File (Into    : in out File_Container;
                       Path    : in String;
                       Element : in File) is abstract;

   --  Add the directory with the given name in the container.
   procedure Add_Directory (Into : in out File_Container;
                            Path : in String;
                            Name : in String) is abstract;

   --  Create a new file instance with the given name in the container.
   function Create (Into : in File_Container;
                    Name : in String) return File_Type is abstract;

   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   function Find (From : in File_Container;
                  Name : in String) return File_Type is abstract;

   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   function Find (From : in File_Container;
                  Name : in String) return Directory_Type is abstract;

private

   type Directory (Len : Positive) is record
      Id       : Directory_Identifier := NO_IDENTIFIER;
      Parent   : Directory_Type;
      Mode     : File_Mode := 8#755#;
      User     : Uid_Type  := 0;
      Group    : Gid_Type  := 0;
      Files    : File_Type_Array_Access;
      Children : Directory_Type_Array_Access;
      Path     : Ada.Strings.Unbounded.Unbounded_String;
      Name     : aliased String (1 .. Len);
   end record;

   type File_Type is access all File;

   type Directory_Type is access all Directory;

   NO_DIRECTORY : constant Directory_Type := null;
   NO_FILE      : constant File_Type := null;

end Babel.Files;

Add a Create function in the File_Container to create a file instance