-----------------------------------------------------------------------
--  util-commands-drivers -- Support to make command line tools
--  Copyright (C) 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log.Loggers;
with Ada.Text_IO; use Ada.Text_IO;
package body Util.Commands.Drivers is

   --  The logger
   Logs : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create (Driver_Name);

   --  ------------------------------
   --  Write the command usage.
   --  ------------------------------
   procedure Usage (Command : in Command_Type) is
   begin
      null;
   end Usage;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   --  ------------------------------
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Command.Driver.Log (Level, Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
     procedure Print (Position : in Command_Maps.Cursor);

      procedure Print (Position : in Command_Maps.Cursor) is
         Name : constant String := Command_Maps.Key (Position);
      begin
         Put_Line ("   " & Name);
      end Print;

   begin
      Logs.Debug ("Execute command {0}", Name);

      if Args.Get_Count = 0 then
         --  Usage;
         New_Line;
         Put ("Type '");
         Put (Args.Get_Command_Name);
         Put_Line (" help {command}' for help on a specific command.");
         New_Line;
         Put_Line ("Available subcommands:");

         Command.Driver.List.Iterate (Process => Print'Access);
      else
         declare
            Cmd_Name   : constant String := Args.Get_Argument (1);
            Target_Cmd : constant Command_Access := Command.Driver.Find_Command (Cmd_Name);
         begin
            if Target_Cmd = null then
               Logs.Error ("Unknown command {0}", Cmd_Name);
            else
               Target_Cmd.Help (Context);
            end if;
         end;
      end if;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in Help_Command_Type;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

   --  ------------------------------
   --  Set the driver description printed in the usage.
   --  ------------------------------
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String) is
   begin
      Driver.Desc := Ada.Strings.Unbounded.To_Unbounded_String (Description);
   end Set_Description;

   --  ------------------------------
   --  Set the driver usage printed in the usage.
   --  ------------------------------
   procedure Set_Usage (Driver  : in out Driver_Type;
                        Usage   : in String) is
   begin
      Driver.Usage := Ada.Strings.Unbounded.To_Unbounded_String (Usage);
   end Set_Usage;

   --  ------------------------------
    --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access) is
   begin
      Command.Driver := Driver'Unchecked_Access;
      Driver.List.Include (Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Handler : in Command_Handler) is
   begin
      Driver.List.Include (Name, new Handler_Command_Type '(Driver  => Driver'Unchecked_Access,
                                                            Handler => Handler));
   end Add_Command;

   --  ------------------------------
   --  Find the command having the given name.
   --  Returns null if the command was not found.
   --  ------------------------------
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access is
      Pos : constant Command_Maps.Cursor := Driver.List.Find (Name);
   begin
      if Command_Maps.Has_Element (Pos) then
         return Command_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Command;

   --  ------------------------------
   --  Execute the command registered under the given name.
   --  ------------------------------
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type) is
      Command : constant Command_Access := Driver.Find_Command (Name);
   begin
      if Command /= null then
         Command.Execute (Name, Args, Context);
      else
         Logs.Error ("Unkown command {0}", Name);
      end if;
   end Execute;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  ------------------------------
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Logs.Print (Level, "{0}: {1}", Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Handler (Name, Args, Context);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in Handler_Command_Type;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

end Util.Commands.Drivers;

-----------------------------------------------------------------------
--  util-commands-drivers -- Support to make command line tools
--  Copyright (C) 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log.Loggers;
with Ada.Text_IO; use Ada.Text_IO;
package body Util.Commands.Drivers is

   use Ada.Strings.Unbounded;

   --  The logger
   Logs : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create (Driver_Name);

   --  ------------------------------
   --  Write the command usage.
   --  ------------------------------
   procedure Usage (Command : in Command_Type) is
   begin
      null;
   end Usage;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   --  ------------------------------
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Command.Driver.Log (Level, Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
     procedure Print (Position : in Command_Maps.Cursor);

      procedure Print (Position : in Command_Maps.Cursor) is
         Name : constant String := Command_Maps.Key (Position);
      begin
         Put_Line ("   " & Name);
      end Print;

   begin
      Logs.Debug ("Execute command {0}", Name);

      if Args.Get_Count = 0 then
         Usage (Command.Driver.all, Args);
         New_Line;
         Put ("Type '");
         Put (Args.Get_Command_Name);
         Put_Line (" help {command}' for help on a specific command.");
         New_Line;
         Put_Line ("Available subcommands:");

         Command.Driver.List.Iterate (Process => Print'Access);
      else
         declare
            Cmd_Name   : constant String := Args.Get_Argument (1);
            Target_Cmd : constant Command_Access := Command.Driver.Find_Command (Cmd_Name);
         begin
            if Target_Cmd = null then
               Logs.Error ("Unknown command {0}", Cmd_Name);
            else
               Target_Cmd.Help (Context);
            end if;
         end;
      end if;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in Help_Command_Type;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

   --  ------------------------------
   --  Report the command usage.
   --  ------------------------------
   procedure Usage (Driver : in Driver_Type;
                    Args   : in Argument_List'Class) is
   begin
      Put_Line (To_String (Driver.Desc));
      New_Line;
      Put ("Usage: ");
      Put (Args.Get_Command_Name);
      Put (" ");
      Put_Line (To_String (Driver.Usage));
   end Usage;

   --  ------------------------------
   --  Set the driver description printed in the usage.
   --  ------------------------------
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String) is
   begin
      Driver.Desc := Ada.Strings.Unbounded.To_Unbounded_String (Description);
   end Set_Description;

   --  ------------------------------
   --  Set the driver usage printed in the usage.
   --  ------------------------------
   procedure Set_Usage (Driver  : in out Driver_Type;
                        Usage   : in String) is
   begin
      Driver.Usage := Ada.Strings.Unbounded.To_Unbounded_String (Usage);
   end Set_Usage;

   --  ------------------------------
    --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access) is
   begin
      Command.Driver := Driver'Unchecked_Access;
      Driver.List.Include (Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Handler : in Command_Handler) is
   begin
      Driver.List.Include (Name, new Handler_Command_Type '(Driver  => Driver'Unchecked_Access,
                                                            Handler => Handler));
   end Add_Command;

   --  ------------------------------
   --  Find the command having the given name.
   --  Returns null if the command was not found.
   --  ------------------------------
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access is
      Pos : constant Command_Maps.Cursor := Driver.List.Find (Name);
   begin
      if Command_Maps.Has_Element (Pos) then
         return Command_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Command;

   --  ------------------------------
   --  Execute the command registered under the given name.
   --  ------------------------------
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type) is
      Command : constant Command_Access := Driver.Find_Command (Name);
   begin
      if Command /= null then
         Command.Execute (Name, Args, Context);
      else
         Logs.Error ("Unkown command {0}", Name);
      end if;
   end Execute;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  ------------------------------
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Logs.Print (Level, "{0}: {1}", Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Handler (Name, Args, Context);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in Handler_Command_Type;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

end Util.Commands.Drivers;

Implement the Usage procedure

Implement the Usage procedure


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

with System;
with ADO.Drivers.Connections.Sqlite;
package ADO.Statements.Sqlite is

   type Handle is null record;

   --  ------------------------------
   --  Delete statement
   --  ------------------------------
   type Sqlite_Delete_Statement is new Delete_Statement with private;
   type Sqlite_Delete_Statement_Access is access all Sqlite_Delete_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Delete_Statement;
                      Result : out Natural);

   --  Create the delete statement
   function Create_Statement (Database : in ADO.Drivers.Connections.Sqlite.Sqlite_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access;

   --  ------------------------------
   --  Update statement
   --  ------------------------------
   type Sqlite_Update_Statement is new Update_Statement with private;
   type Sqlite_Update_Statement_Access is access all Sqlite_Update_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Sqlite_Update_Statement);

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Update_Statement;
                      Result : out Integer);

   --  Create an update statement
   function Create_Statement (Database : in ADO.Drivers.Connections.Sqlite.Sqlite_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access;

   --  ------------------------------
   --  Insert statement
   --  ------------------------------
   type Sqlite_Insert_Statement is new Insert_Statement with private;
   type Sqlite_Insert_Statement_Access is access all Sqlite_Insert_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Insert_Statement;
                      Result : out Integer);

   --  Create an insert statement.
   function Create_Statement (Database : in ADO.Drivers.Connections.Sqlite.Sqlite_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access;

   --  ------------------------------
   --  Query statement for SQLite
   --  ------------------------------
   type Sqlite_Query_Statement is new Query_Statement with private;
   type Sqlite_Query_Statement_Access is access all Sqlite_Query_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Query : in out Sqlite_Query_Statement);

   --  Get the number of rows returned by the query
   overriding
   function Get_Row_Count (Query : in Sqlite_Query_Statement) return Natural;

   --  Returns True if there is more data (row) to fetch
   overriding
   function Has_Elements (Query : in Sqlite_Query_Statement) return Boolean;

   --  Fetch the next row
   overriding
   procedure Next (Query : in out Sqlite_Query_Statement);

   --  Returns true if the column Column is null.
   overriding
   function Is_Null (Query  : in Sqlite_Query_Statement;
                     Column : in Natural) return Boolean;

   --  Get the column value at position Column and
   --  return it as an Int64.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Int64 (Query  : Sqlite_Query_Statement;
                       Column : Natural) return Int64;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Unbounded_String (Query  : Sqlite_Query_Statement;
                                  Column : Natural) return Unbounded_String;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_String (Query  : Sqlite_Query_Statement;
                        Column : Natural) return String;

   --  Get the column value at position Column and
   --  return it as a Blob reference.
   overriding
   function Get_Blob (Query  : in Sqlite_Query_Statement;
                      Column : in Natural) return ADO.Blob_Ref;

   --  Get the column value at position Column and
   --  return it as an Time.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   function Get_Time (Query  : Sqlite_Query_Statement;
                      Column : Natural) return Ada.Calendar.Time;

   --  Get the column type
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Type (Query  : Sqlite_Query_Statement;
                             Column : Natural)
                             return ADO.Schemas.Column_Type;

   --  Get the column name.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Name (Query  : in Sqlite_Query_Statement;
                             Column : in Natural)
                             return String;

   --  Get the number of columns in the result.
   overriding
   function Get_Column_Count (Query  : in Sqlite_Query_Statement)
                              return Natural;

   --  Deletes the query statement.
   overriding
   procedure Finalize (Query : in out Sqlite_Query_Statement);

   --  Create the query statement.
   function Create_Statement (Database : in ADO.Drivers.Connections.Sqlite.Sqlite_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access;

   --  Create the query statement.
   function Create_Statement (Database : in ADO.Drivers.Connections.Sqlite.Sqlite_Access;
                              Query    : in String)
                              return Query_Statement_Access;

private
   type State is (HAS_ROW, HAS_MORE, DONE, ERROR);

   type Sqlite_Query_Statement is new Query_Statement with record
      This_Query : aliased ADO.SQL.Query;
      Connection : ADO.Drivers.Connections.Sqlite.Sqlite_Access;
      Stmt       : ADO.Drivers.Connections.Sqlite.Sqlite_Access := System.Null_Address;
      Counter    : Natural := 1;
      Status     : State := DONE;
      Max_Column : Natural;
   end record;

   type Sqlite_Delete_Statement is new Delete_Statement with record
      Connection   : ADO.Drivers.Connections.Sqlite.Sqlite_Access;
      Table        : ADO.Schemas.Class_Mapping_Access;
      Delete_Query : aliased ADO.SQL.Query;
   end record;

   type Sqlite_Update_Statement is new Update_Statement with record
      Connection : ADO.Drivers.Connections.Sqlite.Sqlite_Access;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

   type Sqlite_Insert_Statement is new Insert_Statement with record
      Connection : ADO.Drivers.Connections.Sqlite.Sqlite_Access;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

end ADO.Statements.Sqlite;

-----------------------------------------------------------------------
--  ado-statements-sqlite -- SQLite database statements
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015, 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 Sqlite3_H;
with ADO.Drivers.Connections.Sqlite;
package ADO.Statements.Sqlite is

   type Handle is null record;

   --  ------------------------------
   --  Delete statement
   --  ------------------------------
   type Sqlite_Delete_Statement is new Delete_Statement with private;
   type Sqlite_Delete_Statement_Access is access all Sqlite_Delete_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Delete_Statement;
                      Result : out Natural);

   --  Create the delete statement
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access;

   --  ------------------------------
   --  Update statement
   --  ------------------------------
   type Sqlite_Update_Statement is new Update_Statement with private;
   type Sqlite_Update_Statement_Access is access all Sqlite_Update_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Sqlite_Update_Statement);

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Update_Statement;
                      Result : out Integer);

   --  Create an update statement
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access;

   --  ------------------------------
   --  Insert statement
   --  ------------------------------
   type Sqlite_Insert_Statement is new Insert_Statement with private;
   type Sqlite_Insert_Statement_Access is access all Sqlite_Insert_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Insert_Statement;
                      Result : out Integer);

   --  Create an insert statement.
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access;

   --  ------------------------------
   --  Query statement for SQLite
   --  ------------------------------
   type Sqlite_Query_Statement is new Query_Statement with private;
   type Sqlite_Query_Statement_Access is access all Sqlite_Query_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Query : in out Sqlite_Query_Statement);

   --  Get the number of rows returned by the query
   overriding
   function Get_Row_Count (Query : in Sqlite_Query_Statement) return Natural;

   --  Returns True if there is more data (row) to fetch
   overriding
   function Has_Elements (Query : in Sqlite_Query_Statement) return Boolean;

   --  Fetch the next row
   overriding
   procedure Next (Query : in out Sqlite_Query_Statement);

   --  Returns true if the column Column is null.
   overriding
   function Is_Null (Query  : in Sqlite_Query_Statement;
                     Column : in Natural) return Boolean;

   --  Get the column value at position Column and
   --  return it as an Int64.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Int64 (Query  : Sqlite_Query_Statement;
                       Column : Natural) return Int64;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Unbounded_String (Query  : Sqlite_Query_Statement;
                                  Column : Natural) return Unbounded_String;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_String (Query  : Sqlite_Query_Statement;
                        Column : Natural) return String;

   --  Get the column value at position Column and
   --  return it as a Blob reference.
   overriding
   function Get_Blob (Query  : in Sqlite_Query_Statement;
                      Column : in Natural) return ADO.Blob_Ref;

   --  Get the column value at position Column and
   --  return it as an Time.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   function Get_Time (Query  : Sqlite_Query_Statement;
                      Column : Natural) return Ada.Calendar.Time;

   --  Get the column type
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Type (Query  : Sqlite_Query_Statement;
                             Column : Natural)
                             return ADO.Schemas.Column_Type;

   --  Get the column name.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Name (Query  : in Sqlite_Query_Statement;
                             Column : in Natural)
                             return String;

   --  Get the number of columns in the result.
   overriding
   function Get_Column_Count (Query  : in Sqlite_Query_Statement)
                              return Natural;

   --  Deletes the query statement.
   overriding
   procedure Finalize (Query : in out Sqlite_Query_Statement);

   --  Create the query statement.
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access;

   --  Create the query statement.
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Query    : in String)
                              return Query_Statement_Access;

private
   type State is (HAS_ROW, HAS_MORE, DONE, ERROR);

   type Sqlite_Query_Statement is new Query_Statement with record
      This_Query : aliased ADO.SQL.Query;
      Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      Stmt       : access Sqlite3_H.sqlite3_stmt;
      Counter    : Natural := 1;
      Status     : State := DONE;
      Max_Column : Natural;
   end record;

   type Sqlite_Delete_Statement is new Delete_Statement with record
      Connection   : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      Table        : ADO.Schemas.Class_Mapping_Access;
      Delete_Query : aliased ADO.SQL.Query;
   end record;

   type Sqlite_Update_Statement is new Update_Statement with record
      Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

   type Sqlite_Insert_Statement is new Insert_Statement with record
      Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

end ADO.Statements.Sqlite;

Replace Sqlite_Access and System.Address with the access Sqlite3 type


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

with Util.Tests;
with AWA.Tests;

package AWA.Wikis.Modules.Tests is

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

   type Test is new AWA.Tests.Test with record
      Manager : AWA.Wikis.Modules.Wiki_Module_Access;
   end record;

   --  Test creation of a wiki space.
   procedure Test_Create_Wiki_Space (T : in out Test);

   --  Test creation of a wiki page.
   procedure Test_Create_Wiki_Page (T : in out Test);

   --  Test creation of a wiki page content.
   procedure Test_Create_Wiki_Content (T : in out Test);

end AWA.Wikis.Modules.Tests;

-----------------------------------------------------------------------
--  awa-wikis-modules-tests -- Unit tests for wikis service
--  Copyright (C) 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 Util.Tests;
with AWA.Tests;
with ADO;

package AWA.Wikis.Modules.Tests is

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

   type Test is new AWA.Tests.Test with record
      Manager    : AWA.Wikis.Modules.Wiki_Module_Access;
      Wiki_Id    : ADO.Identifier := ADO.NO_IDENTIFIER;
      Public_Id  : ADO.Identifier := ADO.NO_IDENTIFIER;
      Private_Id : ADO.Identifier := ADO.NO_IDENTIFIER;
   end record;

   --  Test creation of a wiki space.
   procedure Test_Create_Wiki_Space (T : in out Test);

   --  Test creation of a wiki page.
   procedure Test_Create_Wiki_Page (T : in out Test);

   --  Test creation of a wiki page content.
   procedure Test_Create_Wiki_Content (T : in out Test);

   procedure Test_Wiki_Page (T : in out Test);

end AWA.Wikis.Modules.Tests;

Declare the Test_Wiki_Page procedure to simulate HTTP requests on wiki page


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

with ASF.Requests;
with ASF.Contexts.Writer;
package body ASF.Components.Widgets.Likes is

   FB_LAYOUT_ATTR      : aliased constant String := "data-layout";
   FB_SHOW_FACES_ATTR  : aliased constant String := "data-show-faces";
   FB_WIDTH_ATTR       : aliased constant String := "data-width";
   FB_ACTION_ATTR      : aliased constant String := "data-action";
   FB_FONT_ATTR        : aliased constant String := "data-font";
   FB_COlORSCHEME_ATTR : aliased constant String := "data-colorscheme";
   FB_REF_ATTR         : aliased constant String := "data-ref";
   FB_KIDS_ATTR        : aliased constant String := "data-kid_directed_site";

   TW_VIA_ATTR         : aliased constant String := "data-via";
   TW_COUNT_ATTR       : aliased constant String := "data-count";
   TW_SIZE_ATTR        : aliased constant String := "data-size";

   FACEBOOK_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;
   FACEBOOK_SCRIPT_ATTRIBUTE : constant String := "asf.widgets.facebook.script";

   GOOGLE_ATTRIBUTE_NAMES    : Util.Strings.String_Set.Set;
   GOOGLE_SCRIPT_ATTRIBUTE   : constant String := "asf.widgets.google.script";

   TWEETER_ATTRIBUTE_NAMES    : Util.Strings.String_Set.Set;
   TWEETER_SCRIPT_ATTRIBUTE   : constant String := "asf.widgets.tweeter.script";

   type Like_Generator_Binding is record
      Name      : Util.Strings.Name_Access;
      Generator : Like_Generator_Access;
   end record;

   type Like_Generator_Array is array (1 .. MAX_LIKE_GENERATOR) of Like_Generator_Binding;

   FB_NAME      : aliased constant String := "facebook";
   FB_GENERATOR : aliased Facebook_Like_Generator;

   G_NAME       : aliased constant String := "google+";
   G_GENERATOR  : aliased Google_Like_Generator;

   TWEETER_NAME       : aliased constant String := "tweeter";
   TWEETER_GENERATOR  : aliased Tweeter_Like_Generator;

   Generators : Like_Generator_Array := (1 => (FB_NAME'Access, FB_GENERATOR'Access),
                                         2 => (G_NAME'Access, G_GENERATOR'Access),
                                         3 => (TWEETER_NAME'Access, TWEETER_GENERATOR'Access),
                                         others => (null, null));

   --  ------------------------------
   --  Render the facebook like button according to the component attributes.
   --  ------------------------------
   overriding
   procedure Render_Like (Generator : in Facebook_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (FACEBOOK_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (FACEBOOK_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Script ("(function(d, s, id) { var js, fjs = d.getElementsByTagName(s)[0];"
                              & "if (d.getElementById(id)) return;"
                              & "js = d.createElement(s); js.id = id;"
                              & "js.src = ""//connect.facebook.net/");
         Writer.Queue_Script (Util.Locales.To_String (Context.Get_Locale));
         Writer.Queue_Script ("/all.js#xfbml=1&;appId=116337738505130");
         Writer.Queue_Script (Generator.App_Id);
         Writer.Queue_Script (""";fjs.parentNode.insertBefore(js, fjs);"
                              & "}(document, 'script', 'facebook-jssdk'));");
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("id", "fb-root");
         Writer.End_Element ("div");
      end if;
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "fb-like");
      Writer.Write_Attribute ("data-href", Href);
      Writer.Write_Attribute ("data-send", "true");
      UI.Render_Attributes (Context, FACEBOOK_ATTRIBUTE_NAMES, Writer);
      Writer.End_Element ("div");
   end Render_Like;

   --  ------------------------------
   --  Google like generator
   --  ------------------------------
   overriding
   procedure Render_Like (Generator : in Google_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (Generator);

      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (GOOGLE_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (GOOGLE_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Include_Script ("https://apis.google.com/js/plusone.js");
      end if;
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "g-plusone");
      Writer.Write_Attribute ("data-href", Href);
      Writer.Write_Attribute ("data-send", "true");
      UI.Render_Attributes (Context, GOOGLE_ATTRIBUTE_NAMES, Writer);
      Writer.End_Element ("div");
   end Render_Like;

   overriding
   procedure Render_Like (Generator : in Tweeter_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (Generator);

      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
      Lang    : constant String := Util.Locales.Get_ISO3_Language (Context.Get_Locale);
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (TWEETER_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (TWEETER_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Script ("!function(d,s,id){var js,fjs=d.getElementsByTagName(s)[0],"
                              & "p=/^http:/.test(d.location)?'http':'https';"
                              & "if(!d.getElementById(id)){js=d.createElement(s);js.id=id;"
                              & "js.src=p+'://platform.twitter.com/widgets.js';"
                              & "fjs.parentNode.insertBefore(js,fjs);}}"
                              & "(document, 'script', 'twitter-wjs');");
      end if;
      Writer.Start_Element ("a");
      Writer.Write_Attribute ("href", "https://twitter.com/share");
      Writer.Write_Attribute ("class", "twitter-share-button");
      Writer.Write_Attribute ("data-url", Href);
      Writer.Write_Attribute ("data-lang", Lang);
      UI.Render_Attributes (Context, TWEETER_ATTRIBUTE_NAMES, Writer);
      Writer.Write_Text ("Tweet");
      Writer.End_Element ("a");
   end Render_Like;

   --  ------------------------------
   --  Get the link to submit in the like action.
   --  ------------------------------
   function Get_Link (UI      : in UILike;
                      Context : in ASF.Contexts.Faces.Faces_Context'Class) return String is
      Href : constant String := UI.Get_Attribute ("href", Context, "");
   begin
      if Href'Length > 0 then
         return Href;
      else
         return Context.Get_Request.Get_Request_URI;
      end if;
   end Get_Link;

   --  ------------------------------
   --  Render an image with the source link created from an email address to the Gravatars service.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UILike;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is

   begin
      if UI.Is_Rendered (Context) then
         declare
            Kind : constant String := UI.Get_Attribute ("type", Context, "");
            Href : constant String := UILike'Class (UI).Get_Link (Context);

            procedure Render (Name : in String; Done : out Boolean);

            procedure Render (Name : in String;
                              Done : out Boolean) is
               use type Util.Strings.Name_Access;
            begin
               Done := False;
               for I in Generators'Range loop
                  exit when Generators (I).Name = null;
                  if Generators (I).Name.all = Name then
                     Generators (I).Generator.Render_Like (UI, Href, Context);
                     return;
                  end if;
               end loop;
               UI.Log_Error ("Like type {0} is not recognized", Name);
            end Render;

         begin
            if Kind'Length = 0 then
               UI.Log_Error ("The like type is empty.");
            else
               Util.Strings.Tokenizers.Iterate_Tokens (Content => Kind, Pattern => ",",
                                                       Process => Render'Access);
            end if;
         end;
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Register the like generator under the given name.
   --  ------------------------------
   procedure Register_Like (Name      : in Util.Strings.Name_Access;
                            Generator : in Like_Generator_Access) is
      use type Util.Strings.Name_Access;
   begin
      for I in Generators'Range loop
         if Generators (I).Name = null then
            Generators (I).Name := Name;
            Generators (I).Generator := Generator;
            return;
         end if;
      end loop;
   end Register_Like;

begin
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_LAYOUT_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_SHOW_FACES_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_WIDTH_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_ACTION_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_FONT_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_COlORSCHEME_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_REF_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_KIDS_ATTR'Access);

   TWEETER_ATTRIBUTE_NAMES.Insert (TW_SIZE_ATTR'Access);
   TWEETER_ATTRIBUTE_NAMES.Insert (TW_COUNT_ATTR'Access);
   TWEETER_ATTRIBUTE_NAMES.Insert (TW_VIA_ATTR'Access);
end ASF.Components.Widgets.Likes;

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

with ASF.Requests;
with ASF.Contexts.Writer;
package body ASF.Components.Widgets.Likes is

   FB_LAYOUT_ATTR      : aliased constant String := "data-layout";
   FB_SHOW_FACES_ATTR  : aliased constant String := "data-show-faces";
   FB_WIDTH_ATTR       : aliased constant String := "data-width";
   FB_ACTION_ATTR      : aliased constant String := "data-action";
   FB_FONT_ATTR        : aliased constant String := "data-font";
   FB_COlORSCHEME_ATTR : aliased constant String := "data-colorscheme";
   FB_REF_ATTR         : aliased constant String := "data-ref";
   FB_KIDS_ATTR        : aliased constant String := "data-kid_directed_site";
   FB_SEND_ATTR        : aliased constant String := "data-send";

   TW_VIA_ATTR         : aliased constant String := "data-via";
   TW_COUNT_ATTR       : aliased constant String := "data-count";
   TW_SIZE_ATTR        : aliased constant String := "data-size";

   G_ANNOTATION_ATTR   : aliased constant String := "data-annotation";
   G_WIDTH_ATTR        : aliased constant String := "data-width";

   FACEBOOK_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;
   FACEBOOK_SCRIPT_ATTRIBUTE : constant String := "asf.widgets.facebook.script";

   GOOGLE_ATTRIBUTE_NAMES    : Util.Strings.String_Set.Set;
   GOOGLE_SCRIPT_ATTRIBUTE   : constant String := "asf.widgets.google.script";

   TWEETER_ATTRIBUTE_NAMES    : Util.Strings.String_Set.Set;
   TWEETER_SCRIPT_ATTRIBUTE   : constant String := "asf.widgets.tweeter.script";

   type Like_Generator_Binding is record
      Name      : Util.Strings.Name_Access;
      Generator : Like_Generator_Access;
   end record;

   type Like_Generator_Array is array (1 .. MAX_LIKE_GENERATOR) of Like_Generator_Binding;

   FB_NAME      : aliased constant String := "facebook";
   FB_GENERATOR : aliased Facebook_Like_Generator;

   G_NAME       : aliased constant String := "google+";
   G_GENERATOR  : aliased Google_Like_Generator;

   TWEETER_NAME       : aliased constant String := "tweeter";
   TWEETER_GENERATOR  : aliased Tweeter_Like_Generator;

   Generators : Like_Generator_Array := (1 => (FB_NAME'Access, FB_GENERATOR'Access),
                                         2 => (G_NAME'Access, G_GENERATOR'Access),
                                         3 => (TWEETER_NAME'Access, TWEETER_GENERATOR'Access),
                                         others => (null, null));

   --  ------------------------------
   --  Render the facebook like button according to the component attributes.
   --  ------------------------------
   overriding
   procedure Render_Like (Generator : in Facebook_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (FACEBOOK_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (FACEBOOK_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Script ("(function(d, s, id) { var js, fjs = d.getElementsByTagName(s)[0];"
                              & "if (d.getElementById(id)) return;"
                              & "js = d.createElement(s); js.id = id;"
                              & "js.src = ""//connect.facebook.net/");
         Writer.Queue_Script (Util.Locales.To_String (Context.Get_Locale));
         Writer.Queue_Script ("/all.js#xfbml=1&;appId=116337738505130");
         Writer.Queue_Script (Generator.App_Id);
         Writer.Queue_Script (""";fjs.parentNode.insertBefore(js, fjs);"
                              & "}(document, 'script', 'facebook-jssdk'));");
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("id", "fb-root");
         Writer.End_Element ("div");
      end if;
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "fb-like");
      Writer.Write_Attribute ("data-href", Href);
      UI.Render_Attributes (Context, FACEBOOK_ATTRIBUTE_NAMES, Writer);
      Writer.End_Element ("div");
   end Render_Like;

   --  ------------------------------
   --  Google like generator
   --  ------------------------------
   overriding
   procedure Render_Like (Generator : in Google_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (Generator);

      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (GOOGLE_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (GOOGLE_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Include_Script ("https://apis.google.com/js/plusone.js");
      end if;
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "g-plusone");
      Writer.Write_Attribute ("data-href", Href);
      UI.Render_Attributes (Context, GOOGLE_ATTRIBUTE_NAMES, Writer);
      Writer.End_Element ("div");
   end Render_Like;

   --  ------------------------------
   --  Tweeter like generator
   --  ------------------------------
   overriding
   procedure Render_Like (Generator : in Tweeter_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (Generator);

      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
      Lang    : constant String := Util.Locales.Get_ISO3_Language (Context.Get_Locale);
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (TWEETER_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (TWEETER_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Script ("!function(d,s,id){var js,fjs=d.getElementsByTagName(s)[0],"
                              & "p=/^http:/.test(d.location)?'http':'https';"
                              & "if(!d.getElementById(id)){js=d.createElement(s);js.id=id;"
                              & "js.src=p+'://platform.twitter.com/widgets.js';"
                              & "fjs.parentNode.insertBefore(js,fjs);}}"
                              & "(document, 'script', 'twitter-wjs');");
      end if;
      Writer.Start_Element ("a");
      Writer.Write_Attribute ("href", "https://twitter.com/share");
      Writer.Write_Attribute ("class", "twitter-share-button");
      Writer.Write_Attribute ("data-url", Href);
      Writer.Write_Attribute ("data-lang", Lang);
      UI.Render_Attributes (Context, TWEETER_ATTRIBUTE_NAMES, Writer);
      Writer.Write_Text ("Tweet");
      Writer.End_Element ("a");
   end Render_Like;

   --  ------------------------------
   --  Get the link to submit in the like action.
   --  ------------------------------
   function Get_Link (UI      : in UILike;
                      Context : in ASF.Contexts.Faces.Faces_Context'Class) return String is
      Href : constant String := UI.Get_Attribute ("href", Context, "");
   begin
      if Href'Length > 0 then
         return Href;
      else
         return Context.Get_Request.Get_Request_URI;
      end if;
   end Get_Link;

   --  ------------------------------
   --  Render an image with the source link created from an email address to the Gravatars service.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UILike;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is

   begin
      if UI.Is_Rendered (Context) then
         declare
            Kind : constant String := UI.Get_Attribute ("type", Context, "");
            Href : constant String := UILike'Class (UI).Get_Link (Context);

            procedure Render (Name : in String; Done : out Boolean);

            procedure Render (Name : in String;
                              Done : out Boolean) is
               use type Util.Strings.Name_Access;
            begin
               Done := False;
               for I in Generators'Range loop
                  exit when Generators (I).Name = null;
                  if Generators (I).Name.all = Name then
                     Generators (I).Generator.Render_Like (UI, Href, Context);
                     return;
                  end if;
               end loop;
               UI.Log_Error ("Like type {0} is not recognized", Name);
            end Render;

         begin
            if Kind'Length = 0 then
               UI.Log_Error ("The like type is empty.");
            else
               Util.Strings.Tokenizers.Iterate_Tokens (Content => Kind, Pattern => ",",
                                                       Process => Render'Access);
            end if;
         end;
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Register the like generator under the given name.
   --  ------------------------------
   procedure Register_Like (Name      : in Util.Strings.Name_Access;
                            Generator : in Like_Generator_Access) is
      use type Util.Strings.Name_Access;
   begin
      for I in Generators'Range loop
         if Generators (I).Name = null then
            Generators (I).Name := Name;
            Generators (I).Generator := Generator;
            return;
         end if;
      end loop;
   end Register_Like;

begin
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_LAYOUT_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_SHOW_FACES_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_WIDTH_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_ACTION_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_FONT_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_COlORSCHEME_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_REF_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_KIDS_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_SEND_ATTR'Access);

   TWEETER_ATTRIBUTE_NAMES.Insert (TW_SIZE_ATTR'Access);
   TWEETER_ATTRIBUTE_NAMES.Insert (TW_COUNT_ATTR'Access);
   TWEETER_ATTRIBUTE_NAMES.Insert (TW_VIA_ATTR'Access);

   GOOGLE_ATTRIBUTE_NAMES.Insert (G_ANNOTATION_ATTR'Access);
   GOOGLE_ATTRIBUTE_NAMES.Insert (G_WIDTH_ATTR'Access);
end ASF.Components.Widgets.Likes;

Add control attributes for Google+ and Facebook buttons


-----------------------------------------------------------------------
--  factory -- Session Factory
--  Copyright (C) 2009, 2010, 2011, 2012, 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 ADO.Sequences.Hilo;
with ADO.Schemas.Entities;
with ADO.Queries.Loaders;

package body ADO.Sessions.Factory is

   --  ------------------------------
   --  Get a read-only session from the factory.
   --  ------------------------------
   function Get_Session (Factory : in Session_Factory) return Session is
      R  : Session;
      S  : constant Session_Record_Access := new Session_Record;
   begin
      R.Impl := S;
      S.Entities := Factory.Entities;
      S.Values   := Factory.Cache_Values;
      S.Queries  := Factory.Queries'Unrestricted_Access;
      Factory.Source.Create_Connection (S.Database);
      return R;
   end Get_Session;

   --  ------------------------------
   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the Session_Error exception.
   --  ------------------------------
   function Get_Session (Proxy : in Session_Record_Access) return Session is
      R : Session;
   begin
      if Proxy = null then
         raise Session_Error;
      end if;
      R.Impl := Proxy;
      Util.Concurrent.Counters.Increment (R.Impl.Counter);
      return R;
   end Get_Session;

   --  ------------------------------
   --  Get a read-write session from the factory.
   --  ------------------------------
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session is
      R  : Master_Session;
      S  : constant Session_Record_Access   := new Session_Record;
   begin
      R.Impl := S;
      R.Sequences := Factory.Sequences;
      S.Entities := Factory.Entities;
      S.Values   := Factory.Cache_Values;
      S.Queries  := Factory.Queries'Unrestricted_Access;
      Factory.Source.Create_Connection (S.Database);
      return R;
   end Get_Master_Session;

   --  ------------------------------
   --  Initialize the sequence factory associated with the session factory.
   --  ------------------------------
   procedure Initialize_Sequences (Factory : in out Session_Factory) is
      use ADO.Sequences;
   begin
      Factory.Sequences := Factory.Seq_Factory'Unchecked_Access;
      Set_Default_Generator (Factory.Seq_Factory,
                             ADO.Sequences.Hilo.Create_HiLo_Generator'Access,
                             Factory'Unchecked_Access);
   end Initialize_Sequences;

   --  ------------------------------
   --  Create the session factory to connect to the database represented
   --  by the data source.
   --  ------------------------------
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Sessions.Sources.Data_Source) is
   begin
      Factory.Source := Source;
      Factory.Entities := new ADO.Schemas.Entities.Entity_Cache;
      Factory.Cache_Values := Factory.Cache'Unchecked_Access;
      Factory.Cache.Add_Cache (ENTITY_CACHE_NAME, Factory.Entities.all'Access);
      ADO.Queries.Loaders.Initialize (Factory.Queries, Factory.Source);
      Initialize_Sequences (Factory);

      if Factory.Source.Get_Database /= "" and not Drivers.Is_On (Configs.NO_ENTITY_LOAD) then
         declare
            S : Session := Factory.Get_Session;
         begin
            ADO.Schemas.Entities.Initialize (Factory.Entities.all, S);
         end;
      end if;
   end Create;

   --  ------------------------------
   --  Create the session factory to connect to the database identified
   --  by the URI.
   --  ------------------------------
   procedure Create (Factory : out Session_Factory;
                     URI     : in String) is
   begin
      Factory.Source.Set_Connection (URI);
      Factory.Entities := new ADO.Schemas.Entities.Entity_Cache;
      Factory.Cache_Values := Factory.Cache'Unchecked_Access;
      Factory.Cache.Add_Cache (ENTITY_CACHE_NAME, Factory.Entities.all'Access);
      ADO.Queries.Loaders.Initialize (Factory.Queries, Factory.Source);
      Initialize_Sequences (Factory);

      if Factory.Source.Get_Database /= "" and not Drivers.Is_On (Configs.NO_ENTITY_LOAD) then
         declare
            S : Session := Factory.Get_Session;
         begin
            ADO.Schemas.Entities.Initialize (Factory.Entities.all, S);
         end;
      end if;
   end Create;

end ADO.Sessions.Factory;

-----------------------------------------------------------------------
--  ado-sessions-factory -- Session Factory
--  Copyright (C) 2009, 2010, 2011, 2012, 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 ADO.Sequences.Hilo;
with ADO.Schemas.Entities;
with ADO.Queries.Loaders;

package body ADO.Sessions.Factory is

   --  ------------------------------
   --  Get a read-only session from the factory.
   --  ------------------------------
   function Get_Session (Factory : in Session_Factory) return Session is
      R  : Session;
      S  : constant Session_Record_Access := new Session_Record;
   begin
      R.Impl := S;
      S.Entities := Factory.Entities;
      S.Values   := Factory.Cache_Values;
      S.Queries  := Factory.Queries'Unrestricted_Access;
      Factory.Source.Create_Connection (S.Database);
      return R;
   end Get_Session;

   --  ------------------------------
   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the Session_Error exception.
   --  ------------------------------
   function Get_Session (Proxy : in Session_Record_Access) return Session is
      R : Session;
   begin
      if Proxy = null then
         raise Session_Error;
      end if;
      R.Impl := Proxy;
      Util.Concurrent.Counters.Increment (R.Impl.Counter);
      return R;
   end Get_Session;

   --  ------------------------------
   --  Get a read-write session from the factory.
   --  ------------------------------
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session is
      R  : Master_Session;
      S  : constant Session_Record_Access   := new Session_Record;
   begin
      R.Impl := S;
      R.Sequences := Factory.Sequences;
      R.Audit := Factory.Audit;
      S.Entities := Factory.Entities;
      S.Values   := Factory.Cache_Values;
      S.Queries  := Factory.Queries'Unrestricted_Access;
      Factory.Source.Create_Connection (S.Database);
      return R;
   end Get_Master_Session;

   --  ------------------------------
   --  Initialize the sequence factory associated with the session factory.
   --  ------------------------------
   procedure Initialize_Sequences (Factory : in out Session_Factory) is
      use ADO.Sequences;
   begin
      Factory.Sequences := Factory.Seq_Factory'Unchecked_Access;
      Set_Default_Generator (Factory.Seq_Factory,
                             ADO.Sequences.Hilo.Create_HiLo_Generator'Access,
                             Factory'Unchecked_Access);
   end Initialize_Sequences;

   --  ------------------------------
   --  Create the session factory to connect to the database represented
   --  by the data source.
   --  ------------------------------
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Sessions.Sources.Data_Source) is
   begin
      Factory.Source := Source;
      Factory.Entities := new ADO.Schemas.Entities.Entity_Cache;
      Factory.Cache_Values := Factory.Cache'Unchecked_Access;
      Factory.Cache.Add_Cache (ENTITY_CACHE_NAME, Factory.Entities.all'Access);
      ADO.Queries.Loaders.Initialize (Factory.Queries, Factory.Source);
      Initialize_Sequences (Factory);

      if Factory.Source.Get_Database /= "" and not Drivers.Is_On (Configs.NO_ENTITY_LOAD) then
         declare
            S : Session := Factory.Get_Session;
         begin
            ADO.Schemas.Entities.Initialize (Factory.Entities.all, S);
         end;
      end if;
   end Create;

   --  ------------------------------
   --  Create the session factory to connect to the database identified
   --  by the URI.
   --  ------------------------------
   procedure Create (Factory : out Session_Factory;
                     URI     : in String) is
   begin
      Factory.Source.Set_Connection (URI);
      Factory.Entities := new ADO.Schemas.Entities.Entity_Cache;
      Factory.Cache_Values := Factory.Cache'Unchecked_Access;
      Factory.Cache.Add_Cache (ENTITY_CACHE_NAME, Factory.Entities.all'Access);
      ADO.Queries.Loaders.Initialize (Factory.Queries, Factory.Source);
      Initialize_Sequences (Factory);

      if Factory.Source.Get_Database /= "" and not Drivers.Is_On (Configs.NO_ENTITY_LOAD) then
         declare
            S : Session := Factory.Get_Session;
         begin
            ADO.Schemas.Entities.Initialize (Factory.Entities.all, S);
         end;
      end if;
   end Create;

   --  ------------------------------
   --  Set the audit manager to be used for the object auditing support.
   --  ------------------------------
   procedure Set_Audit_Manager (Factory : in out Session_Factory;
                                Manager : in ADO.Audits.Audit_Manager_Access) is
   begin
      Factory.Audit := Manager;
   end Set_Audit_Manager;

end ADO.Sessions.Factory;

Implement the Set_Audit_Manager procedure


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

with Ada.Strings.Unbounded;
with Ada.Finalization;

with Util.Properties;

with AWS.SMTP;
with AWS.SMTP.Authentication.Plain;

--  The AWA.Mail.Clients.AWS_SMTP package provides an implementation of the
--  mail client interfaces on top of AWS SMTP client API.
package AWA.Mail.Clients.AWS_SMTP is

   NAME : constant String := "smtp";

   --  ------------------------------
   --  Mail Message
   --  ------------------------------
   --  The Mail_Message represents an abstract mail message that can be initialized
   --  before being sent.
   type AWS_Mail_Message is new Ada.Finalization.Limited_Controlled and Mail_Message with private;
   type AWS_Mail_Message_Access is access all AWS_Mail_Message'Class;

   --  Set the <tt>From</tt> part of the message.
   overriding
   procedure Set_From (Message : in out AWS_Mail_Message;
                       Name    : in String;
                       Address : in String);

   --  Add a recipient for the message.
   overriding
   procedure Add_Recipient (Message : in out AWS_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String);

   --  Set the subject of the message.
   overriding
   procedure Set_Subject (Message : in out AWS_Mail_Message;
                          Subject : in String);

   --  Set the body of the message.
   overriding
   procedure Set_Body (Message : in out AWS_Mail_Message;
                       Content : in String);

   --  Send the email message.
   overriding
   procedure Send (Message : in out AWS_Mail_Message);

   --  Deletes the mail message.
   overriding
   procedure Finalize (Message : in out AWS_Mail_Message);

   --  ------------------------------
   --  Mail Manager
   --  ------------------------------
   --  The Mail_Manager is the entry point to create a new mail message
   --  and be able to send it.
   type AWS_Mail_Manager is new Mail_Manager with private;
   type AWS_Mail_Manager_Access is access all AWS_Mail_Manager'Class;

   --  Create a SMTP based mail manager and configure it according to the properties.
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access;

   --  Create a new mail message.
   overriding
   function Create_Message (Manager : in AWS_Mail_Manager) return Mail_Message_Access;

private

   type Recipients_Access is access all AWS.SMTP.Recipients;

   type AWS_Mail_Message is new Ada.Finalization.Limited_Controlled and Mail_Message with record
      Manager : AWS_Mail_Manager_Access;
      From    : AWS.SMTP.E_Mail_Data;
      Subject : Ada.Strings.Unbounded.Unbounded_String;
      Content : Ada.Strings.Unbounded.Unbounded_String;
      To      : Recipients_Access := null;
   end record;

   type AWS_Mail_Manager is new Mail_Manager with record
      Self    : AWS_Mail_Manager_Access;
      Server  : AWS.SMTP.Receiver;
      Creds   : aliased AWS.SMTP.Authentication.Plain.Credential;
      Enable  : Boolean := True;
      Secure  : Boolean := False;
      Auth    : Boolean := False;
   end record;

end AWA.Mail.Clients.AWS_SMTP;

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

with Ada.Strings.Unbounded;
with Ada.Finalization;

with Util.Properties;

with AWS.SMTP;
with AWS.SMTP.Authentication.Plain;

--  The AWA.Mail.Clients.AWS_SMTP package provides an implementation of the
--  mail client interfaces on top of AWS SMTP client API.
package AWA.Mail.Clients.AWS_SMTP is

   NAME : constant String := "smtp";

   --  ------------------------------
   --  Mail Message
   --  ------------------------------
   --  The Mail_Message represents an abstract mail message that can be initialized
   --  before being sent.
   type AWS_Mail_Message is new Ada.Finalization.Limited_Controlled and Mail_Message with private;
   type AWS_Mail_Message_Access is access all AWS_Mail_Message'Class;

   --  Set the <tt>From</tt> part of the message.
   overriding
   procedure Set_From (Message : in out AWS_Mail_Message;
                       Name    : in String;
                       Address : in String);

   --  Add a recipient for the message.
   overriding
   procedure Add_Recipient (Message : in out AWS_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String);

   --  Set the subject of the message.
   overriding
   procedure Set_Subject (Message : in out AWS_Mail_Message;
                          Subject : in String);

   --  Set the body of the message.
   overriding
   procedure Set_Body (Message : in out AWS_Mail_Message;
                       Content : in String);

   --  Send the email message.
   overriding
   procedure Send (Message : in out AWS_Mail_Message);

   --  Deletes the mail message.
   overriding
   procedure Finalize (Message : in out AWS_Mail_Message);

   --  ------------------------------
   --  Mail Manager
   --  ------------------------------
   --  The Mail_Manager is the entry point to create a new mail message
   --  and be able to send it.
   type AWS_Mail_Manager is new Mail_Manager with private;
   type AWS_Mail_Manager_Access is access all AWS_Mail_Manager'Class;

   --  Create a SMTP based mail manager and configure it according to the properties.
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access;

   --  Create a new mail message.
   overriding
   function Create_Message (Manager : in AWS_Mail_Manager) return Mail_Message_Access;

private

   type Recipients_Access is access all AWS.SMTP.Recipients;

   type AWS_Mail_Message is new Ada.Finalization.Limited_Controlled and Mail_Message with record
      Manager : AWS_Mail_Manager_Access;
      From    : AWS.SMTP.E_Mail_Data;
      Subject : Ada.Strings.Unbounded.Unbounded_String;
      Content : Ada.Strings.Unbounded.Unbounded_String;
      To      : Recipients_Access := null;
   end record;

   type AWS_Mail_Manager is new Mail_Manager with record
      Self    : AWS_Mail_Manager_Access;
      Server  : AWS.SMTP.Receiver;
      Creds   : aliased AWS.SMTP.Authentication.Plain.Credential;
      Port    : Positive := 25;
      Enable  : Boolean := True;
      Secure  : Boolean := False;
      Auth    : Boolean := False;
   end record;

   procedure Initialize (Client : in out AWS_Mail_Manager'Class;
                         Props  : in Util.Properties.Manager'Class);

end AWA.Mail.Clients.AWS_SMTP;

Declare the Initialize procedure

Declare the Initialize procedure


-----------------------------------------------------------------------
--  asf-rest -- REST Support
--  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.
-----------------------------------------------------------------------
with Util.Strings;
with ASF.Requests;
with ASF.Responses;
with Security.Permissions;

--  == REST ==
--  The <tt>ASF.Rest</tt> package provides support to implement easily some RESTful API.
package ASF.Rest is

   type Request is abstract new ASF.Requests.Request with null record;

   type Response is abstract new ASF.Responses.Response with null record;

   --  The HTTP rest method.
   type Method_Type is (GET, HEAD, POST, PUT, DELETE, OPTIONS);

   type Descriptor is abstract tagged limited private;
   type Descriptor_Access is access all Descriptor'Class;

   --  Get the permission index associated with the REST operation.
   function Get_Permission (Handler : in Descriptor)
                            return Security.Permissions.Permission_Index;

   --  Dispatch the request to the API handler.
   procedure Dispatch (Handler : in Descriptor;
                       Req     : in out ASF.Rest.Request'Class;
                       Reply   : in out ASF.Rest.Response'Class) is abstract;

private

   type Descriptor is abstract tagged limited record
      Next       : Descriptor_Access;
      Method     : Method_Type;
      Pattern    : Util.Strings.Name_Access;
      Permission : Security.Permissions.Permission_Index := 0;
   end record;

   --  Register the API descriptor in a list.
   procedure Register (List : in out Descriptor_Access;
                       Item : in Descriptor_Access);

end ASF.Rest;

-----------------------------------------------------------------------
--  asf-rest -- REST Support
--  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.
-----------------------------------------------------------------------
with Util.Strings;
with Util.Serialize.IO;
with ASF.Requests;
with ASF.Responses;
with ASF.Servlets;
with EL.Contexts;
with Security.Permissions;

--  == REST ==
--  The <tt>ASF.Rest</tt> package provides support to implement easily some RESTful API.
package ASF.Rest is

   subtype Request is ASF.Requests.Request;

   subtype Response is ASF.Responses.Response;

   subtype Output_Stream is Util.Serialize.IO.Output_Stream;

   --  The HTTP rest method.
   type Method_Type is (GET, HEAD, POST, PUT, DELETE, TRACE, CONNECT, OPTIONS);

   type Descriptor is abstract tagged limited private;
   type Descriptor_Access is access all Descriptor'Class;

   --  Get the permission index associated with the REST operation.
   function Get_Permission (Handler : in Descriptor)
                            return Security.Permissions.Permission_Index;

   --  Dispatch the request to the API handler.
   procedure Dispatch (Handler : in Descriptor;
                       Req     : in out ASF.Rest.Request'Class;
                       Reply   : in out ASF.Rest.Response'Class;
                       Stream  : in out Output_Stream'Class) is abstract;

private

   type Descriptor is abstract tagged limited record
      Next       : Descriptor_Access;
      Method     : Method_Type;
      Pattern    : Util.Strings.Name_Access;
      Permission : Security.Permissions.Permission_Index := 0;
   end record;

   --  Register the API descriptor in a list.
   procedure Register (List : in out Descriptor_Access;
                       Item : in Descriptor_Access);

   --  Register the list of API descriptors for a given servlet and a root path.
   procedure Register (Registry  : in out ASF.Servlets.Servlet_Registry;
                       Name      : in String;
                       URI       : in String;
                       ELContext : in EL.Contexts.ELContext'Class;
                       List      : in Descriptor_Access);

end ASF.Rest;

Add the TRACE and CONNECT http methods Define the Output_Stream type Add a Stream in out parameter to the Dispatch procedure Declare the private Register procedure used by the ASF.Rest.Definition generic to register the list of APIs


-- Functions_Example

-- A example of using the Ada 2012 interface to Lua for functions / closures etc

-- Copyright (c) 2015, James Humphry

-- Permission is hereby granted, free of charge, to any person obtaining
-- a copy of this software and associated documentation files (the
-- "Software"), to deal in the Software without restriction, including
-- without limitation the rights to use, copy, modify, merge, publish,
-- distribute, sublicense, and/or sell copies of the Software, and to
-- permit persons to whom the Software is furnished to do so, subject to
-- the following conditions:
--
-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
-- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
-- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
-- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Long_Float_Text_IO; use Ada.Long_Float_Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Characters.Latin_1;

with Lua; use Lua;
with Lua.Util; use Lua.Util;

with Example_AdaFunctions;

procedure Functions_Example is
   L : State;
   Success : Thread_Status;

   LF : Character renames Ada.Characters.Latin_1.LF;
   Coroutine_Source : String := "" &
     "co = coroutine.create( function  (x) " & LF &
     " for i = 1, x do " & LF &
     "  coroutine.yield(i) " & LF &
     " end " & LF &
     " return -1 " & LF &
     " end " & LF &
     ")";

begin

   Put_Line("A simple example of using Lua and Ada functions together");

   Put("Lua version: ");
   Put(Item => L.Version, Aft => 0, Exp => 0);
   New_Line; New_Line;

   Put_Line("Loading chunk: function f (x) return 2*x end");
   Success := L.LoadString("function f (x) return 2*x end");
   Put_Line("Load" & (if Success /= OK then " not" else "") & " successful.");
   L.Call(0, 0);
   Put_Line("Compiled chunk.");
   Put("Result of calling f (3): ");
   L.GetGlobal("f"); L.PushNumber(3.0); L.Call(1, 1);
   Put(L.ToNumber(-1), Aft => 0, Exp => 0); New_Line;
   L.Pop(1);
   New_Line;

   L.Pop(L.GetTop);
   Put_Line("Registering an AdaFunction foobar in Lua");
   L.Register("foobar", AdaFunction'(Example_AdaFunctions.Foobar'Access));
   Success := L.LoadString("baz = foobar(5.0)");
   Put_Line("Loading code snippet 'baz = foobar(5.0)'" &
            (if Success /= OK then " not" else "") & " successful.");
   Put_Line("Calling 'baz = foobar(5.0)' from Lua");
   L.Call(0, 0);
   Put("baz = ");
   L.GetGlobal("baz");
   Put(L.ToNumber(-1), Aft => 0, Exp => 0); New_Line;
   New_Line;

   L.Pop(L.GetTop);
   Put_Line("Registering an AdaFunction multret in Lua");
   L.Register("multret", AdaFunction'(Example_AdaFunctions.Multret'Access));
   Put_Line("Calling 'multret(5)' from Lua");
   L.GetGlobal("multret");
   L.PushInteger(5);
   L.Call(1, MultRet_Sentinel);
   Put_Line("Stack now contains:");
   Print_Stack(L);
   New_Line;

   L.Pop(L.GetTop);
   Put_Line("Registering an AdaFunction closure (with upvalue 2.0) in Lua");
   L.PushNumber(2.0);
   L.PushAdaClosure(AdaFunction'(Example_AdaFunctions.Closure'Access), 1);
   L.SetGlobal("closure");
   Put_Line("Calling 'closure(3.5)' from Lua");
   L.GetGlobal("closure");
   L.PushNumber(3.5);
   L.Call(1, MultRet_Sentinel);
   Put_Line("Stack now contains:");
   Print_Stack(L);
   New_Line;

   L.Pop(L.GetTop);
   Put_Line("Adding standard libraries...");
   L.OpenLibs;
   Put_Line("Loading coroutine: " & Coroutine_Source); New_Line;
   Success := L.LoadString(Coroutine_Source);
   Put_Line("Load" & (if Success /= OK then " not" else "") & " successful.");
   L.Call(0, 0);
   L.GetGlobal("co");
   pragma Assert (L.TypeInfo(-1) = TTHREAD);
   Put_Line("Compiled chunk. Resuming coroutine with parameter 3");
   declare
      Coroutine : Thread := L.ToThread(-1);
      Coroutine_Status : Thread_Status;
   begin
      Coroutine.PushInteger(3);
      Coroutine_Status := Coroutine.resume(L, 1);
      Put_Line("Coroutine status : " & Thread_Status'Image(Coroutine_Status));
      Print_Stack(Coroutine);
      while Coroutine_Status = YIELD loop
         Coroutine_Status := Coroutine.resume(L, 1);
         Put_Line("Coroutine status : " & Thread_Status'Image(Coroutine_Status));
         Print_Stack(Coroutine);
      end loop;
   end;
   New_Line;

end Functions_Example;

-- Functions_Example

-- A example of using the Ada 2012 interface to Lua for functions / closures etc

-- Copyright (c) 2015, James Humphry

-- Permission is hereby granted, free of charge, to any person obtaining
-- a copy of this software and associated documentation files (the
-- "Software"), to deal in the Software without restriction, including
-- without limitation the rights to use, copy, modify, merge, publish,
-- distribute, sublicense, and/or sell copies of the Software, and to
-- permit persons to whom the Software is furnished to do so, subject to
-- the following conditions:
--
-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
-- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
-- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
-- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Long_Float_Text_IO; use Ada.Long_Float_Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Characters.Latin_1;

with Lua; use Lua;
with Lua.Util; use Lua.Util;

with Example_AdaFunctions;

procedure Functions_Example is
   L : State;
   Success : Thread_Status;

   LF : Character renames Ada.Characters.Latin_1.LF;
   Coroutine_Source : String := "" &
     "function co (x) " & LF &
     " for i = 1, x do " & LF &
     "  coroutine.yield(i) " & LF &
     " end " & LF &
     " return -1 " & LF &
     " end " & LF &
     "";

begin

   Put_Line("A simple example of using Lua and Ada functions together");

   Put("Lua version: ");
   Put(Item => L.Version, Aft => 0, Exp => 0);
   New_Line; New_Line;

   Put_Line("Loading chunk: function f (x) return 2*x end");
   Success := L.LoadString("function f (x) return 2*x end");
   Put_Line("Load" & (if Success /= OK then " not" else "") & " successful.");
   L.Call(0, 0);
   Put_Line("Compiled chunk.");
   Put("Result of calling f (3): ");
   L.GetGlobal("f"); L.PushNumber(3.0); L.Call(1, 1);
   Put(L.ToNumber(-1), Aft => 0, Exp => 0); New_Line;
   L.Pop(1);
   New_Line;

   L.Pop(L.GetTop);
   Put_Line("Registering an AdaFunction foobar in Lua");
   L.Register("foobar", AdaFunction'(Example_AdaFunctions.Foobar'Access));
   Success := L.LoadString("baz = foobar(5.0)");
   Put_Line("Loading code snippet 'baz = foobar(5.0)'" &
            (if Success /= OK then " not" else "") & " successful.");
   Put_Line("Calling 'baz = foobar(5.0)' from Lua");
   L.Call(0, 0);
   Put("baz = ");
   L.GetGlobal("baz");
   Put(L.ToNumber(-1), Aft => 0, Exp => 0); New_Line;
   New_Line;

   L.Pop(L.GetTop);
   Put_Line("Registering an AdaFunction multret in Lua");
   L.Register("multret", AdaFunction'(Example_AdaFunctions.Multret'Access));
   Put_Line("Calling 'multret(5)' from Lua");
   L.GetGlobal("multret");
   L.PushInteger(5);
   L.Call(1, MultRet_Sentinel);
   Put_Line("Stack now contains:");
   Print_Stack(L);
   New_Line;

   L.Pop(L.GetTop);
   Put_Line("Registering an AdaFunction closure (with upvalue 2.0) in Lua");
   L.PushNumber(2.0);
   L.PushAdaClosure(AdaFunction'(Example_AdaFunctions.Closure'Access), 1);
   L.SetGlobal("closure");
   Put_Line("Calling 'closure(3.5)' from Lua");
   L.GetGlobal("closure");
   L.PushNumber(3.5);
   L.Call(1, MultRet_Sentinel);
   Put_Line("Stack now contains:");
   Print_Stack(L);
   New_Line;

   L.Pop(L.GetTop);
   Put_Line("Now to look at using coroutines");
   Put_Line("Adding standard libraries...");
   L.OpenLibs;
   Put_Line("Loading coroutine source: ");
   Put_Line(Coroutine_Source);
   Success := L.LoadString(Coroutine_Source);
   Put_Line("Load" & (if Success /= OK then " not" else "") & " successful.");
   L.Call(0, 0);
   Put_Line("Compiled coroutine code.");
   declare
      Coroutine : Thread := L.NewThread;
      Coroutine_Status : Thread_Status;
   begin
      Put_Line("New thread created");
      Put_Line("Resuming coroutine with parameter 3 in this thread:");
      Coroutine.GetGlobal("co");
      Coroutine.PushInteger(3);
      Coroutine_Status := Coroutine.resume(L, 1);
      Put("Coroutine status : " & Thread_Status'Image(Coroutine_Status));
      Put(" Result: "); Put(Coroutine.ToNumber(-1)); New_Line;
      while Coroutine_Status = YIELD loop
         Coroutine_Status := Coroutine.resume(L, 1);
         Put("Coroutine status : " & Thread_Status'Image(Coroutine_Status));
         Put(" Result: "); Put(Coroutine.ToNumber(-1)); New_Line;
      end loop;
   end;
   New_Line;

end Functions_Example;

Improve example of using a Lua coroutine from Ada

Create the new thread in Ada rather than in the Lua source.