------------------------------------------------------------------------------
--                             G N A T C O L L                              --
--                                                                          --
--                     Copyright (C) 2005-2020, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling;      use Ada.Characters.Handling;
with Ada.Strings.Fixed;            use Ada.Strings;
with Ada.Unchecked_Conversion;
with GNATCOLL.SQL.Sqlite.Gnade;    use GNATCOLL.SQL.Sqlite.Gnade;
with GNATCOLL.SQL.Exec;
with GNATCOLL.SQL.Exec_Private;    use GNATCOLL.SQL.Exec_Private;
with GNATCOLL.Traces;              use GNATCOLL.Traces;
with GNATCOLL.Utils;               use GNATCOLL.Utils;
with GNAT.Calendar;
with Interfaces.C.Strings;         use Interfaces.C.Strings;
with System;                       use System;

pragma Warnings (Off);
--  Ada.Strings.Unbounded.Aux is an internal GNAT unit
with Ada.Strings.Unbounded.Aux;
pragma Warnings (On);

package body GNATCOLL.SQL.Sqlite.Builder is
   Me : constant Trace_Handle := Create ("SQL.SQLITE");
   Me_Log : constant Trace_Handle := Create ("SQL.SQLITE.LOG");

   procedure Logger
     (Data       : System.Address;
      Error_Code : Result_Codes;
      Message    : Interfaces.C.Strings.chars_ptr);
   pragma Convention (C, Logger);
   --  Logs error messages from sqlite (see sqlite3_log)

   type Sqlite_Connection_Record is
     new GNATCOLL.SQL.Exec.Database_Connection_Record with
      record
         DB           : GNATCOLL.SQL.Sqlite.Gnade.Database;
         Connected_On : Ada.Calendar.Time := GNAT.Calendar.No_Time;
      end record;
   overriding procedure Force_Connect
     (Connection : access Sqlite_Connection_Record);
   overriding procedure Force_Disconnect
     (Connection : access Sqlite_Connection_Record);
   overriding function Supports_Timezone
     (Self  : Sqlite_Connection_Record) return Boolean is (False);
   overriding function Boolean_Image
     (Self : Sqlite_Connection_Record; Value : Boolean) return String;
   overriding function Money_Image
     (Self : Sqlite_Connection_Record; Value : T_Money) return String;
   overriding function Parameter_String
     (Self       : Sqlite_Connection_Record;
      Index      : Positive;
      Type_Descr : String) return String with Inline;
   overriding procedure Close
     (Connection : access Sqlite_Connection_Record);
   overriding function Field_Type_Autoincrement
     (Self : Sqlite_Connection_Record) return String;
   overriding function Field_Type_Money
     (Self : Sqlite_Connection_Record) return String;
   overriding function Can_Alter_Table_Constraints
     (Self : access Sqlite_Connection_Record) return Boolean;
   overriding function Has_Pragmas
     (Self : access Sqlite_Connection_Record) return Boolean;
   overriding function Check_Connection
     (Self : access Sqlite_Connection_Record) return Boolean;
   overriding function Connect_And_Execute
     (Connection  : access Sqlite_Connection_Record;
      Is_Select   : Boolean;
      Direct      : Boolean;
      Query       : String         := "";
      Stmt        : DBMS_Stmt      := No_DBMS_Stmt;
      Params      : SQL_Parameters := No_Parameters)
      return Abstract_Cursor_Access;
   overriding function Connected_On
     (Connection : access Sqlite_Connection_Record) return Ada.Calendar.Time;
   overriding function Connect_And_Prepare
     (Connection : access Sqlite_Connection_Record;
      Query      : String;
      Name       : String;
      Direct     : Boolean) return DBMS_Stmt;
   overriding function Execute
     (Connection  : access Sqlite_Connection_Record;
      Prepared    : DBMS_Stmt;
      Is_Select   : Boolean;
      Direct      : Boolean;
      Params      : SQL_Parameters := No_Parameters)
      return Abstract_Cursor_Access;
   overriding procedure Reset
     (Connection : access Sqlite_Connection_Record;
      Prepared   : DBMS_Stmt);
   overriding procedure Finalize
     (Connection : access Sqlite_Connection_Record;
      Prepared   : DBMS_Stmt);
   overriding function Error
     (Connection : access Sqlite_Connection_Record) return String;
   overriding procedure Foreach_Table
     (Connection : access Sqlite_Connection_Record;
      Callback   : access procedure
        (Name, Description : String; Kind : Relation_Kind));
   overriding procedure Foreach_Field
     (Connection : access Sqlite_Connection_Record;
      Table_Name : String;
      Callback   : access procedure
        (Name           : String;
         Typ            : String;
         Index          : Natural;
         Description    : String;
         Default_Value  : String;
         Is_Primary_Key : Boolean;
         Not_Null       : Boolean));
   overriding procedure Foreach_Foreign_Key
     (Connection : access Sqlite_Connection_Record;
      Table_Name : String;
      Callback   : access procedure
        (Index             : Positive;
         Local_Attribute   : Integer;
         Foreign_Table     : String;
         Foreign_Attribute : Integer));

   type Sqlite_Cursor is new DBMS_Forward_Cursor with record
      DB             : access Sqlite_Connection_Record'Class;
      Stmt           : Statement;

      Free_Stmt      : Boolean := False;
      --  Whether the statement needs to be finalized; This will be false for
      --  a statement prepared explicitly by the user on the server. In this
      --  case, the statement will be reset instead.

      Processed_Rows : Natural := 0;
      Last_Status    : Result_Codes;  --  Last status of Step
   end record;
   type Sqlite_Cursor_Access is access all Sqlite_Cursor'Class;

   overriding function Current (Self : Sqlite_Cursor) return Positive;
   overriding function Error_Msg  (Self : Sqlite_Cursor) return String;
   overriding function Status     (Self : Sqlite_Cursor) return String;
   overriding function Is_Success (Self : Sqlite_Cursor) return Boolean;
   overriding procedure Finalize  (Self : in out Sqlite_Cursor);
   overriding function Processed_Rows (Self : Sqlite_Cursor) return Natural;
   overriding function Value
     (Self  : Sqlite_Cursor;
      Field : GNATCOLL.SQL.Exec.Field_Index) return String;
   overriding function C_Value
     (Self  : Sqlite_Cursor;
      Field : GNATCOLL.SQL.Exec.Field_Index) return chars_ptr;
   overriding function Is_Null
     (Self  : Sqlite_Cursor;
      Field : GNATCOLL.SQL.Exec.Field_Index) return Boolean;
   overriding function Last_Id
     (Self       : Sqlite_Cursor;
      Connection : access Database_Connection_Record'Class;
      Field      : SQL_Field_Integer) return Integer;
   overriding function Field_Count
     (Self : Sqlite_Cursor) return GNATCOLL.SQL.Exec.Field_Index;
   overriding function Field_Name
     (Self : Sqlite_Cursor;
      Field : GNATCOLL.SQL.Exec.Field_Index) return String;
   overriding function Has_Row (Self : Sqlite_Cursor) return Boolean;
   overriding procedure Next   (Self : in out Sqlite_Cursor);
   overriding function Boolean_Value
     (Self : Sqlite_Cursor; Field : Field_Index) return Boolean;
   overriding function Money_Value
     (Self  : Sqlite_Cursor; Field : Field_Index) return T_Money;

   function Is_Whitespace (C : Character) return Boolean;
   --  Whether C is a white space character

   procedure Skip_Whitespace (S : String; Pos : in out Integer);
   procedure Skip_To_Whitespace (S : String; Pos : in out Integer);
   --  Skip to or until the next whitespace character. Pos is left on the
   --  first whitespace character or on the first character after the spaces

   function Unchecked_Convert is new Ada.Unchecked_Conversion
     (Statement, DBMS_Stmt);
   function Unchecked_Convert is new Ada.Unchecked_Conversion
     (DBMS_Stmt, Statement);

   overriding function Is_Prepared_On_Server_Supported
     (Connection : access Sqlite_Connection_Record) return Boolean;
   --  We allow transactions prepared on the server, but there are several
   --  restrictions with sqlite:
   --     - M410-030: when we execute a statement prepared on the server, this
   --       seems to prevent the deletion of the database on Windows.
   --       This might however be because we were missing a proper close to
   --       sqlite3_close.
   --     - executing the same statements multiple times nested will fail.
   --       For instance, do a:
   --            for r in query1(params):
   --                for r in query1(params2):
   --                     pass
   --       means the outer loop will only return a single result.

   ----------------------
   -- Check_Connection --
   ----------------------

   overriding function Check_Connection
     (Self : access Sqlite_Connection_Record) return Boolean
   is
      pragma Unreferenced (Self);
   begin
      return True;
   end Check_Connection;

   -------------------------------------
   -- Is_Prepared_On_Server_Supported --
   -------------------------------------

   overriding function Is_Prepared_On_Server_Supported
     (Connection : access Sqlite_Connection_Record) return Boolean
   is
      pragma Unreferenced (Connection);
   begin
      return True;
   end Is_Prepared_On_Server_Supported;

   ---------------
   -- Error_Msg --
   ---------------

   overriding function Error_Msg (Self : Sqlite_Cursor) return String is
   begin
      return Error_Msg (DB_Handle (Self.Stmt));
   end Error_Msg;

   ------------
   -- Status --
   ------------

   overriding function Status (Self : Sqlite_Cursor) return String is
   begin
      if Self.Last_Status = Sqlite_Done
        or else Self.Last_Status = Sqlite_Row
      then
         return "";
      else
         return Result_Codes'Image (Self.Last_Status);
      end if;
   exception
      when others =>
         return "ERROR";
   end Status;

   ----------------
   -- Is_Success --
   ----------------

   overriding function Is_Success
     (Self : Sqlite_Cursor) return Boolean is
   begin
      return Self.Last_Status = Sqlite_OK
        or else Self.Last_Status = Sqlite_Row
        or else Self.Last_Status = Sqlite_Done;
   end Is_Success;

   -----------
   -- Error --
   -----------

   function Error
     (Connection : access Sqlite_Connection_Record) return String is
   begin
      if Connection.DB = No_Database then
         return "No connection to database";
      else
         return Error_Msg (Connection.DB);
      end if;
   end Error;

   --------------
   -- Finalize --
   --------------

   overriding procedure Finalize (Self : in out Sqlite_Cursor) is
      Status : Result_Codes;
   begin
      if Self.Stmt /= No_Statement
        and then
          (Self.DB = null
           or else not Was_Closed (Self.DB))
      then
         if Self.Free_Stmt then
            Finalize (Self.Stmt);
         else
            --  Clear bindings is useless, since we never need to free memory
            --  (even strings are passed by access)

            --  Clear_Bindings (Self.Stmt);

            Status := Reset (Self.Stmt);
            if Status /= Sqlite_OK then
               Trace (Me, "Error when resetting cursor to free LOCKS: "
                      & Status'Img);
            end if;
         end if;
         Self.Stmt := No_Statement;
         Self.DB := null;
      end if;
   end Finalize;

   -----------
   -- Reset --
   -----------

   overriding procedure Reset
     (Connection : access Sqlite_Connection_Record;
      Prepared   : DBMS_Stmt)
   is
      Status : Result_Codes;
      pragma Unreferenced (Connection, Status);
   begin
      Status := Reset (Unchecked_Convert (Prepared));
   end Reset;

   --------------
   -- Finalize --
   --------------

   overriding procedure Finalize
     (Connection : access Sqlite_Connection_Record;
      Prepared   : DBMS_Stmt)
   is
      pragma Unreferenced (Connection);
   begin
      Finalize (Unchecked_Convert (Prepared));
   end Finalize;

   -----------
   -- Close --
   -----------

   overriding procedure Close
     (Connection : access Sqlite_Connection_Record) is
   begin
      Trace (Me, "Closing connection to sqlite");
      Mark_As_Closed (Connection, Closed => True);
      Close (Connection.DB, Finalize_Prepared_Statements => True);
      Connection.DB := No_Database;
   end Close;

   -------------------
   -- Force_Connect --
   -------------------

   overriding procedure Force_Connect
     (Connection : access Sqlite_Connection_Record)
   is
      Status : Result_Codes;
   begin
      --  With sqlite, we do not need to try and reconnect, since there is no
      --  network involved. We either have a connection, or not

      if Connection.DB = No_Database then
         Print_Warning
           (Connection,
            "Connecting to sqlite database "
            & Sqlite_Description_Access
              (Get_Description (Connection)).Dbname.all);

         declare
            Descr : constant Sqlite_Description_Access :=
               Sqlite_Description_Access (Get_Description (Connection));
            Name : constant String := Descr.Dbname.all;
            Flags : Open_Flags :=
               Open_Readwrite or Open_Create or Open_Nomutex;

         begin
            if Descr.Is_URI then
               Flags := Flags or Open_URI;
            end if;

            --  We let sqlite create the database (even an empty one) as
            --  needed. Applications that need to know whether the schema
            --  has been created should either check earlier whether the
            --  file exists, or can use "pragma user_version" to check the
            --  version of the schema.
            Open
              (DB       => Connection.DB,
               Filename => Name,
               Flags    => Flags,
               Status   => Status);
            Connection.Connected_On := Ada.Calendar.Clock;

            --  Controls SQLITE_FCNTL_CHUNK_SIZE setting in sqlite. This helps
            --  avoid fragmentation by growing/shrinking the database file in
            --  SQLITE_FCNTL_CHUNK_SIZE increments.

--              File_Control
--                (Connection.DB, "" & ASCII.NUL,
--                 SQLITE_FCNTL_CHUNK_SIZE, 1024 * 1024);

         end;

         if Status /= Sqlite_OK then
            Print_Error
              (Connection,
               "Could not connect to database: " & Error_Msg (Connection.DB));
            Connection.Close;   --  avoid memory leaks
         else
            Mark_As_Closed (Connection, Closed => False);
            Set_Busy_Timeout (Connection.DB, Max_Ms_On_Busy);
            Busy_Handler (Connection.DB, On_Busy);

            --  Make sure that with appropriate versions of sqlite (>= 3.6.19)
            --  we do enforce foreign keys constraints

            Execute (Connection, "PRAGMA foreign_keys=ON");
         end if;
      end if;
   end Force_Connect;

   ----------------------
   -- Force_Disconnect --
   ----------------------

   overriding procedure Force_Disconnect
     (Connection : access Sqlite_Connection_Record)
   is
      pragma Unreferenced (Connection);
   begin
      --  No network connection involved

      null;
   end Force_Disconnect;

   -------------------------
   -- Connect_And_Prepare --
   -------------------------

   overriding function Connect_And_Prepare
     (Connection : access Sqlite_Connection_Record;
      Query      : String;
      Name       : String;
      Direct     : Boolean) return DBMS_Stmt
   is
      pragma Unreferenced (Direct);
      Stmt   : Statement;
      Status : Result_Codes;
   begin
      --  We cannot prepare direct_cursor, since we are using sqlite3_get_table
      --  and that doesn't provide support for prepared statements
      --  ??? We should not be using sqlite3_get_table, apparently it is being
      --  phased out

      if Query = "" then
         return No_DBMS_Stmt;
      end if;

      Force_Connect (Connection);

      if Connection.DB = No_Database then
         return No_DBMS_Stmt;
      end if;

      Prepare (Connection.DB, Query, Stmt, Status);

      if Active (Me) and then Name /= "" then
         --  The full query was already displayed in Compute_Statement
         Trace (Me, "PREPARE " & Name);
      end if;

      if Status /= Sqlite_OK then
         Trace (Me, "Connect_And_Prepare failed to prepare statement for "
                & Query & ASCII.LF & Error_Msg (Connection.DB));
         Finalize (Stmt);
         return No_DBMS_Stmt;
      end if;

      return Unchecked_Convert (Stmt);
   end Connect_And_Prepare;

   ------------------
   -- Connected_On --
   ------------------

   overriding function Connected_On
     (Connection : access Sqlite_Connection_Record) return Ada.Calendar.Time is
   begin
      return Connection.Connected_On;
   end Connected_On;

   -------------
   -- Execute --
   -------------

   overriding function Execute
     (Connection  : access Sqlite_Connection_Record;
      Prepared    : DBMS_Stmt;
      Is_Select   : Boolean;
      Direct      : Boolean;
      Params      : SQL_Parameters := No_Parameters)
      return Abstract_Cursor_Access
   is
      Res    : Sqlite_Cursor_Access;
      Stmt   : Statement;
      Last_Status : Result_Codes;
      Tmp_Data : array (Params'Range) of GNAT.Strings.String_Access;
      Money_Int : Integer;
      Str_Ptr : Unbounded.Aux.Big_String_Access;
      Str_Adr : System.Address;
      for Str_Adr'Address use Str_Ptr'Address;
      Str_Len     : Natural;
      Need_Free : array (Params'Range) of Boolean := (others => False);
   begin
      --  Since we have a prepared statement, the connection already exists, no
      --  need to recreate.
      --  We always need to create a forward cursor, which will possibly be
      --  used to initialize the direct cursor.

      Stmt := Unchecked_Convert (Prepared);

      for P in Params'Range loop
         if Params (P) = Null_Parameter then
            Bind_Null (Stmt, P);
         elsif Params (P).Get in SQL_Parameter_Text'Class then
            declare
               P2 : constant access SQL_Parameter_Text :=
                 SQL_Parameter_Text (Params (P).Get.Element.all)'Access;
            begin
               if P2.Str_Ptr = null then
                  Aux.Get_String (P2.Str_Val, Str_Ptr, Str_Len);
               else
                  Str_Adr := P2.Str_Ptr.all'Address;
                  Str_Len := P2.Str_Ptr'Length;
               end if;

               if P2.Make_Copy then
                  Bind_Text (Stmt, P, Str_Adr, Str_Len, Transient);
               else
                  Bind_Text (Stmt, P, Str_Adr, Str_Len);
               end if;
            end;

         elsif Params (P).Get in SQL_Parameter_Integer'Class then
            declare
               P2 : constant access SQL_Parameter_Integer :=
                 SQL_Parameter_Integer (Params (P).Get.Element.all)'Access;
            begin
               Bind_Int (Stmt, P, Interfaces.C.int (P2.Val));
            end;

         elsif Params (P).Get in SQL_Parameter_Bigint'Class then
            declare
               P2 : constant access SQL_Parameter_Bigint :=
                 SQL_Parameter_Bigint (Params (P).Get.Element.all)'Access;
            begin
               Bind_Int64 (Stmt, P, Interfaces.C.long (P2.Val));
            end;

         elsif Params (P).Get in SQL_Parameter_Float'Class then
            declare
               P2 : constant access SQL_Parameter_Float :=
                 SQL_Parameter_Float (Params (P).Get.Element.all)'Access;
            begin
               Bind_Double (Stmt, P, Interfaces.C.double (P2.Val));
            end;

         elsif Params (P).Get in SQL_Parameter_Boolean'Class then
            declare
               P2 : constant access SQL_Parameter_Boolean :=
                 SQL_Parameter_Boolean (Params (P).Get.Element.all)'Access;
            begin
               Bind_Int
                 (Stmt, P, Interfaces.C.int (Boolean'Pos (P2.Val)));
            end;

         elsif Params (P).Get in SQL_Parameter_Money'Class then
            declare
               P2 : constant access SQL_Parameter_Money :=
                 SQL_Parameter_Money (Params (P).Get.Element.all)'Access;
            begin
               --  In SQLite, Money type will be mapped as integer
               Money_Int := Integer (P2.Val / K_Delta);
               Bind_Int (Stmt, P, Interfaces.C.int (Money_Int));
            end;

         else
            Tmp_Data (P) := new String'
              (Params (P).Image (Connection.all));
            Need_Free (P) := True;
            Bind_Text (Stmt, P, Tmp_Data (P).all'Address, Tmp_Data (P)'Length);
         end if;
      end loop;

      Step (Stmt, Last_Status);

      --  Free the memory we just allocated. We should ideally clear the
      --  bindings at this stage, but:
      --     using Bind_Null is forbidden because the statement is executing
      --     Clear_Bindings will be called automatically when the statement
      --       is Finalized anyway.

      for P in Need_Free'Range loop
         if Need_Free (P) then
            Free (Tmp_Data (P));
         end if;
      end loop;

      case Last_Status is
         when Sqlite_OK | Sqlite_Row | Sqlite_Done =>
            Res := new Sqlite_Cursor;
            Res.Stmt := Stmt;
            Res.DB := Connection;
            Res.Free_Stmt := False;
            Res.Last_Status := Last_Status;

            if Is_Select then
               Res.Processed_Rows := 0;
            else
               Res.Processed_Rows := Changes (Connection.DB);
            end if;

         when Sqlite_Corrupt =>
            Report_Database_Corrupted (Connection);
            return null;

         when others =>
            Print_Warning
              (Connection,
               "Error while executing query, status="
               & Last_Status'Img);
            return null;
      end case;

      if Direct then
         Res.Free_Stmt := True;
         Res.DB := null;
      end if;

      return Abstract_Cursor_Access (Res);
   end Execute;

   -------------------------
   -- Connect_And_Execute --
   -------------------------

   overriding function Connect_And_Execute
     (Connection  : access Sqlite_Connection_Record;
      Is_Select   : Boolean;
      Direct      : Boolean;
      Query       : String         := "";
      Stmt        : DBMS_Stmt      := No_DBMS_Stmt;
      Params      : SQL_Parameters := No_Parameters)
      return Abstract_Cursor_Access
   is
      Res    : Abstract_Cursor_Access := null;
      P_Stmt : DBMS_Stmt := Stmt;
   begin
      if Stmt = No_DBMS_Stmt then
         P_Stmt := Connect_And_Prepare (Connection, Query, "", Direct);
      else
         P_Stmt := Stmt;
      end if;

      if P_Stmt /= No_DBMS_Stmt then
         Res := Execute
           (Connection => Connection,
            Prepared   => P_Stmt,
            Is_Select  => Is_Select,
            Direct     => Direct,
            Params     => Params);

         --  If the statement was prepared locally (Stmt = No_DBMS_Stmt) then
         --  finalize it now if needed.

         if Res /= null then
            if Res.all in Sqlite_Cursor'Class then
               Sqlite_Cursor_Access (Res).Free_Stmt := Stmt = No_DBMS_Stmt;
            end if;

         elsif Stmt = No_DBMS_Stmt then
            --  P_Stmt is no longer accessible, and yet if we don't finalize it
            --  we are in effect keeping a transaction (or read transaction)
            --  open.
            Finalize (Connection, P_Stmt);
         end if;
      end if;

      return Res;
   end Connect_And_Execute;

   --------------------
   -- Processed_Rows --
   --------------------

   overriding function Processed_Rows (Self : Sqlite_Cursor) return Natural is
   begin
      return Self.Processed_Rows;
   end Processed_Rows;

   -----------
   -- Value --
   -----------

   overriding function Value
     (Self  : Sqlite_Cursor;
      Field : GNATCOLL.SQL.Exec.Field_Index) return String is
   begin
      return Column_Text (Self.Stmt, Natural (Field));
   end Value;

   -------------
   -- C_Value --
   -------------

   overriding function C_Value
     (Self  : Sqlite_Cursor;
      Field : GNATCOLL.SQL.Exec.Field_Index) return chars_ptr is
   begin
      return Column_C_Text (Self.Stmt, Natural (Field));
   end C_Value;

   -------------
   -- Is_Null --
   -------------

   overriding function Is_Null
     (Self  : Sqlite_Cursor;
      Field : GNATCOLL.SQL.Exec.Field_Index) return Boolean is
   begin
      return Column_Type (Self.Stmt, Natural (Field)) = Sqlite_Null;
   end Is_Null;

   -------------
   -- Last_Id --
   -------------

   overriding function Last_Id
     (Self       : Sqlite_Cursor;
      Connection : access Database_Connection_Record'Class;
      Field      : SQL_Field_Integer) return Integer
   is
      pragma Unreferenced (Self, Field);
--        Res2     : Forward_Cursor;
   begin
      --  According to sqlite3 documentation, the last_rowid is also the
      --  primary key when the latter is a single integer primary key (which is
      --  the case here).
      --  ??? We assume here that Field is the primary key, but we cannot
      --  check that.

      return Integer (Last_Insert_Rowid
        (Sqlite_Connection_Record (Connection.all).DB));

      --  If we wanted to support multi-key primary keys, for instance, we
      --  would use:
--        Res2.Fetch
--          (Connection,
--           "SELECT " & Field.To_String (Connection.all, Long => True)
--           & " FROM " & Field.Table.all
--           & " WHERE ROWID="
--           & Long_Integer'Image (Self.Last_Rowid));
--        if Has_Row (Res2) then
--           return Integer_Value (Res2, 0);
--        end if;
--        return -1;
   end Last_Id;

   -----------------
   -- Field_Count --
   -----------------

   overriding function Field_Count
     (Self : Sqlite_Cursor) return GNATCOLL.SQL.Exec.Field_Index is
   begin
      return Field_Index (Column_Count (Self.Stmt));
   end Field_Count;

   ----------------
   -- Field_Name --
   ----------------

   overriding function Field_Name
     (Self  : Sqlite_Cursor;
      Field : GNATCOLL.SQL.Exec.Field_Index) return String is
   begin
      return Column_Name (Self.Stmt, Natural (Field));
   end Field_Name;

   -------------------
   -- Foreach_Table --
   -------------------

   overriding procedure Foreach_Table
     (Connection : access Sqlite_Connection_Record;
      Callback   : access procedure
        (Name, Description : String; Kind : Relation_Kind))
   is
      R     : Forward_Cursor;
      Kind  : Relation_Kind;
   begin
      R.Fetch
        (Connection,
         "SELECT name, type FROM sqlite_master"
         & " WHERE type in ('table', 'view') and name not like 'sqlite_%'"
         & " ORDER BY name");

      while Has_Row (R) loop
         if Value (R, 1) = "table" then
            Kind := Kind_Table;
         else
            Kind := Kind_View;
         end if;

         Callback (Name => Value (R, 0), Description => "", Kind => Kind);
         Next (R);
      end loop;
   end Foreach_Table;

   -------------------
   -- Is_Whitespace --
   -------------------

   function Is_Whitespace (C : Character) return Boolean is
   begin
      return C = ' '
        or else C = ASCII.HT
        or else C = ASCII.LF
        or else C = ASCII.CR;
   end Is_Whitespace;

   procedure Skip_Whitespace (S : String; Pos : in out Integer) is
   begin
      while Pos <= S'Last and then Is_Whitespace (S (Pos)) loop
         Pos := Pos + 1;
      end loop;
   end Skip_Whitespace;

   procedure Skip_To_Whitespace (S : String; Pos : in out Integer) is
   begin
      while Pos <= S'Last and then not Is_Whitespace (S (Pos)) loop
         Pos := Pos + 1;
      end loop;
   end Skip_To_Whitespace;

   -------------------
   -- Foreach_Field --
   -------------------

   overriding procedure Foreach_Field
     (Connection : access Sqlite_Connection_Record;
      Table_Name : String;
      Callback   : access procedure
        (Name           : String;
         Typ            : String;
         Index          : Natural;
         Description    : String;
         Default_Value  : String;
         Is_Primary_Key : Boolean;
         Not_Null       : Boolean))
   is
      R           : Forward_Cursor;
      Index       : Natural := 1;
      Paren_Count : Natural;
      Is_PK       : Boolean;
      Is_Not_Null : Boolean;

      function No_Square_Brackets (Item : String) return String is
        (if Item'Length > 1
           and then Item (Item'First) = '['
           and then Item (Item'Last) = ']'
         then Item (Item'First + 1 .. Item'Last - 1)
         else Item);

   begin
      R.Fetch
        (Connection,
         "SELECT sql FROM sqlite_master WHERE name='" & Table_Name & "'");

      while Has_Row (R) loop
         --  Crude parsing of the sql

         declare
            Sql : constant String := Value (R, 0);
            Pos, Pos2, Pos3, Pos4, Pos5 : Integer := Sql'First;
         begin
            while Pos <= Sql'Last and then Sql (Pos) /= '(' loop
               Pos := Pos + 1;
            end loop;

            Pos := Pos + 1;
            while Pos <= Sql'Last loop
               Skip_Whitespace (Sql, Pos);
               Pos2 := Pos;  --  First char of name

               Skip_To_Whitespace (Sql, Pos);
               Pos3 := Pos - 1;  -- Last char of name

               Skip_Whitespace (Sql, Pos);
               Pos4 := Pos; --  First char of type

               Paren_Count := 0;

               while Pos <= Sql'Last
                 and then not Is_Whitespace (Sql (Pos))
                 and then (Paren_Count > 0 or else Sql (Pos) not in ',' | ')')
               loop
                  if Sql (Pos) = '(' then
                     Paren_Count := Paren_Count + 1;
                  elsif Sql (Pos) = ')' then
                     Paren_Count := Paren_Count - 1;
                  end if;

                  Pos := Pos + 1;
               end loop;

               Pos5 := Pos;

               while Pos <= Sql'Last
                 and then (Paren_Count > 0 or else Sql (Pos) not in ',' | ')')
               loop
                  if Sql (Pos) = '(' then
                     Paren_Count := Paren_Count + 1;
                  elsif Sql (Pos) = ')' then
                     Paren_Count := Paren_Count - 1;
                  end if;
                  Pos := Pos + 1;
               end loop;

               pragma Assert
                 (Pos2 in Sql'Range and then Pos in Sql'Range,
                  Pos2'Img & Pos'Img & ": " & Sql & "; '"  & Table_Name & ''');

               Is_PK := Fixed.Index
                 (To_Lower (Sql (Pos2 .. Pos)), "primary key") >= 1;

               Is_Not_Null := Fixed.Index
                 (To_Lower (Sql (Pos2 .. Pos)), "not null") >= 1;

               --  Ignore constraints declarations

               if To_Lower (Sql (Pos2 .. Pos3)) /= "constraint"
                 and then To_Lower (Sql (Pos4 .. Pos5 - 1)) /= "key"
               then
                  Callback
                    (Name           => No_Square_Brackets (Sql (Pos2 .. Pos3)),
                     Typ            => Sql (Pos4 .. Pos5 - 1),
                     Index          => Index,
                     Description    => "",
                     Default_Value  => "",  --  ??? Should be specified
                     Not_Null       => Is_Not_Null,
                     Is_Primary_Key => Is_PK);
               end if;

               Pos := Pos + 1;
            end loop;
         end;

         Index := Index + 1;
         Next (R);
      end loop;
   end Foreach_Field;

   -------------------------
   -- Foreach_Foreign_Key --
   -------------------------

   procedure Foreach_Foreign_Key
     (Connection : access Sqlite_Connection_Record;
      Table_Name : String;
      Callback   : access procedure
        (Index             : Positive;
         Local_Attribute   : Integer;
         Foreign_Table     : String;
         Foreign_Attribute : Integer))
   is
      pragma Unreferenced (Connection, Table_Name, Callback);
   begin
      --  Unsupported for now (sqlite does not support them anyway)
      --  We could potentially parse the sql for "create table"
      null;
   end Foreach_Foreign_Key;

   -------------
   -- Has_Row --
   -------------

   overriding function Has_Row (Self : Sqlite_Cursor) return Boolean is
   begin
      return Self.Last_Status = Sqlite_Row;
   end Has_Row;

   ----------
   -- Next --
   ----------

   overriding procedure Next (Self : in out Sqlite_Cursor) is
   begin
      if Self.Has_Row then
         Step (Self.Stmt, Self.Last_Status);
         Self.Processed_Rows := Self.Processed_Rows + 1;
      end if;
   end Next;

   -------------
   -- Current --
   -------------

   overriding function Current (Self : Sqlite_Cursor) return Positive is
   begin
      return Self.Processed_Rows + 1;
   end Current;

   ----------------------
   -- Build_Connection --
   ----------------------

   function Build_Connection
     (Descr : access Sqlite_Description'Class) return Database_Connection
   is
   begin
      return new Sqlite_Connection_Record
        (Descr,
         Always_Use_Transactions => Sqlite_Always_Use_Transactions);
   end Build_Connection;

   -------------------
   -- Boolean_Image --
   -------------------

   overriding function Boolean_Image
     (Self : Sqlite_Connection_Record; Value : Boolean) return String
   is
      pragma Unreferenced (Self);
   begin
      if Value then
         return "1";
      else
         return "0";
      end if;
   end Boolean_Image;

   -------------------
   -- Boolean_Value --
   -------------------

   overriding function Boolean_Value
     (Self : Sqlite_Cursor; Field : Field_Index) return Boolean
   is
   begin
      return Value (Sqlite_Cursor'Class (Self), Field) /= "0";
   end Boolean_Value;

   -----------------
   -- Money_Value --
   -----------------

   overriding function Money_Value
      (Self  : Sqlite_Cursor;
       Field : Field_Index) return T_Money is
   begin
      return T_Money'Value
         (Value (Sqlite_Cursor'Class (Self), Field)) * K_Delta;
   end Money_Value;

   ------------------------------
   -- Field_Type_Autoincrement --
   ------------------------------

   overriding function Field_Type_Autoincrement
     (Self : Sqlite_Connection_Record) return String
   is
      pragma Unreferenced (Self);
   begin
      return "INTEGER PRIMARY KEY AUTOINCREMENT";
   end Field_Type_Autoincrement;

   ----------------------
   -- Field_Type_Money --
   ----------------------

   overriding function Field_Type_Money
     (Self : Sqlite_Connection_Record) return String
   is
      pragma Unreferenced (Self);
   begin
      --  Note : As SQLite does not support fixed point real, Money type is
      --  represented as an integer that models cents.
      return "Integer";
   end Field_Type_Money;

   -----------------
   -- Money_Image --
   -----------------

   overriding function Money_Image
     (Self : Sqlite_Connection_Record; Value : T_Money) return String
   is
      pragma Unreferenced (Self);
      Long_Value : constant Long_Integer := Long_Integer (Value / K_Delta);
      Img : constant String := Long_Integer'Image (Long_Value);
   begin
      if Img (Img'First) = ' ' then
         return Img (Img'First + 1 .. Img'Last);
      else
         return Img;
      end if;
   end Money_Image;

   ----------------------
   -- Parameter_String --
   ----------------------

   overriding function Parameter_String
     (Self       : Sqlite_Connection_Record;
      Index      : Positive;
      Type_Descr : String) return String
   is
      pragma Unreferenced (Self, Type_Descr);
   begin
      return '?' & Image (Index, 0);
   end Parameter_String;

   ---------------------------------
   -- Can_Alter_Table_Constraints --
   ---------------------------------

   overriding function Can_Alter_Table_Constraints
     (Self : access Sqlite_Connection_Record) return Boolean
   is
      pragma Unreferenced (Self);
   begin
      return False;
   end Can_Alter_Table_Constraints;

   -----------------
   -- Has_Pragmas --
   -----------------

   overriding function Has_Pragmas
     (Self : access Sqlite_Connection_Record) return Boolean
   is
      pragma Unreferenced (Self);
   begin
      return True;
   end Has_Pragmas;

   ------------
   -- Logger --
   ------------

   procedure Logger
     (Data       : System.Address;
      Error_Code : Result_Codes;
      Message    : Interfaces.C.Strings.chars_ptr)
   is
      pragma Unreferenced (Data);
   begin
      if Active (Me_Log) then
         Trace (Me_Log, Error_Code'Img & " " & Value (Message));
      end if;
   end Logger;

   -----------
   -- Setup --
   -----------

   procedure Setup is
   begin
      Set_Config_Memstatus (Collect_Stats => False);
      Set_Config_Log (Logger'Access);
   end Setup;

   ------------
   -- Backup --
   ------------

   function Backup
     (DB1 : access Database_Connection_Record'Class;
      DB2 : String;
      From_DB1_To_DB2 : Boolean := True) return Boolean
   is
      To     : Database_Connection;
      Result : Boolean := True;
   begin
      To := GNATCOLL.SQL.Sqlite.Setup (DB2).Build_Connection;
      To.Force_Connect;
      DB1.Force_Connect;

      if From_DB1_To_DB2 then
         Result := Backup (DB1, To);
      else
         Result := Backup (To, DB1);
      end if;

      Close (To);
      return Result;
   end Backup;

   ------------
   -- Backup --
   ------------

   function Backup
     (From : access Database_Connection_Record'Class;
      To   : access Database_Connection_Record'Class) return Boolean
   is
      Status  : Result_Codes;
      Bkp     : Sqlite3_Backup;
      Result  : Boolean := True;
   begin
      Bkp := Backup_Init
        (Pdest        => Sqlite_Connection_Record (To.all).DB,
         Pdest_Name   => "main",
         Psource      => Sqlite_Connection_Record (From.all).DB,
         Psource_Name => "main");

      if System.Address (Bkp) = System.Null_Address then
         Trace (Me_Log, "failed to create the backup object");
         return False;
      end if;

      Status := Backup_Step (Bkp, -1);
      if Status /= Sqlite_Done then
         Trace (Me_Log, Status'Img & " Error in Backup_Step "
                & Error (From));
         Result := False;
      end if;

      if Backup_Finish (Bkp) /= Sqlite_OK then
         Trace (Me_Log, "Error in Backup_Finish");
         Result := False;
      end if;

      return Result;
   end Backup;

end GNATCOLL.SQL.Sqlite.Builder;