src/db-sqlite.adb

   1 ------------------------------------------------------------------------------
   2 --                                 GnadeLite                                --
   3 --                                                                          --
   4 --                         Copyright (C) 2006-2007                          --
   5 --                      Pascal Obry - Olivier Ramonat                       --
   6 --                                                                          --
   7 --  This library is free software; you can redistribute it and/or modify    --
   8 --  it under the terms of the GNU General Public License as published by    --
   9 --  the Free Software Foundation; either version 2 of the License, or (at   --
  10 --  your option) any later version.                                         --
  11 --                                                                          --
  12 --  This library is distributed in the hope that it will be useful, but     --
  13 --  WITHOUT ANY WARRANTY; without even the implied warranty of              --
  14 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
  15 --  General Public License for more details.                                --
  16 --                                                                          --
  17 --  You should have received a copy of the GNU General Public License       --
  18 --  along with this library; if not, write to the Free Software Foundation, --
  19 --  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.       --
  20 ------------------------------------------------------------------------------
  21
  22 with Ada.Unchecked_Deallocation;
  23
  24 with Morzhol.Logs;
  25
  26 package body DB.SQLite is
  27
  28    use GNU.DB;
  29    use Morzhol;
  30
  31    Module : constant Logs.Module_Name := "DB_SQLITE";
  32
  33    procedure Unchecked_Free is new Unchecked_Deallocation
  34      (Object => SQLite3.Object, Name => SQLite3.Handle);
  35
  36    procedure Check_Result
  37      (Routine : in String;
  38       Result  : in SQLite3.Return_Value);
  39    pragma Inline (Check_Result);
  40    --  Check result, raises and exception if it is an error code
  41
  42    procedure Step_Internal (Iter : in out Iterator);
  43    --  Advance to the next row and set Iter.More
  44
  45    -----------------------
  46    -- Begin_Transaction --
  47    -----------------------
  48
  49    overriding procedure Begin_Transaction (DB : in Handle) is
  50    begin
  51       Logs.Write (Module, "begin");
  52       Execute (DB, "begin");
  53    end Begin_Transaction;
  54
  55    ------------------
  56    -- Check_Result --
  57    ------------------
  58
  59    procedure Check_Result
  60      (Routine : in String;
  61       Result  : in SQLite3.Return_Value)
  62    is
  63       use type SQLite3.Return_Value;
  64    begin
  65       if Result /= SQLite3.SQLITE_OK then
  66          Logs.Write
  67            (Name    => Module,
  68             Kind    => Logs.Error,
  69             Content => Logs.NV
  70               ("Return_Value", SQLite3.Return_Value'Image (Result))
  71               & ", " & Logs.NV ("routine", Routine));
  72          raise DB_Error
  73            with "SQLite: Error " & SQLite3.Return_Value'Image (Result) &
  74              " in " & Routine;
  75       end if;
  76    end Check_Result;
  77
  78    -----------
  79    -- Close --
  80    -----------
  81
  82    overriding procedure Close (DB : in out Handle) is
  83    begin
  84       Logs.Write (Module, "close");
  85       Check_Result ("close", SQLite3.Close (DB.H));
  86       Unchecked_Free (DB.H);
  87    end Close;
  88
  89    ------------
  90    -- Commit --
  91    ------------
  92
  93    overriding procedure Commit (DB : in Handle) is
  94    begin
  95       Logs.Write (Module, "commit");
  96       Execute (DB, "commit");
  97    end Commit;
  98
  99    -------------
 100    -- Connect --
 101    -------------
 102
 103    overriding procedure Connect
 104      (DB       : in out Handle;
 105       Name     : in     String;
 106       User     : in     String := "";
 107       Password : in     String := "")
 108    is
 109       pragma Unreferenced (User, Password);
 110       use type GNU.DB.SQLite3.Handle;
 111    begin
 112       Logs.Write
 113         (Module, "connect " & Logs.NV ("Name", Name));
 114       if DB.H = null then
 115          DB.H := new GNU.DB.SQLite3.Object;
 116       end if;
 117       Check_Result ("connect", SQLite3.Open (DB.H, Name));
 118    end Connect;
 119
 120    ----------------
 121    -- End_Select --
 122    ----------------
 123
 124    overriding procedure End_Select (Iter : in out Iterator) is
 125    begin
 126       Logs.Write (Module, "end_select");
 127       Check_Result ("end_select", SQLite3.finalize (Iter.S'Unchecked_Access));
 128    end End_Select;
 129
 130    -------------
 131    -- Execute --
 132    -------------
 133
 134    overriding procedure Execute (DB : in Handle; SQL : in String) is
 135    begin
 136       Logs.Write
 137         (Module, "execute : " & Logs.NV ("SQL", SQL));
 138       Check_Result ("execute", SQLite3.Exec (DB.H, SQL));
 139    exception
 140       when DB_Error =>
 141          raise DB_Error with "DB_Error on Execute " & SQL;
 142    end Execute;
 143
 144    --------------
 145    -- Get_Line --
 146    --------------
 147
 148    overriding procedure Get_Line
 149      (Iter   : in out Iterator;
 150       Result :    out String_Vectors.Vector)
 151    is
 152       use type SQLite3.Return_Value;
 153    begin
 154       for K in 0 .. Iter.Col - 1 loop
 155          String_Vectors.Append
 156            (Result, SQLite3.column_text (Iter.S'Unchecked_Access, K));
 157       end loop;
 158
 159       Step_Internal (Iter);
 160    end Get_Line;
 161
 162    -----------------------
 163    -- Last_Insert_Rowid --
 164    -----------------------
 165
 166    overriding function Last_Insert_Rowid (DB : in Handle) return String is
 167    begin
 168       return SQLite3.uint64'Image (SQLite3.Last_Insert_Rowid (DB.H));
 169    end Last_Insert_Rowid;
 170
 171    ----------
 172    -- More --
 173    ----------
 174
 175    overriding function More (Iter : in Iterator) return Boolean is
 176    begin
 177       return Iter.More;
 178    end More;
 179
 180    --------------------
 181    -- Prepare_Select --
 182    --------------------
 183
 184    overriding procedure Prepare_Select
 185      (DB   : in     Handle;
 186       Iter : in out Standard.DB.Iterator'Class;
 187       SQL  : in     String)
 188    is
 189       use type SQLite3.Statement_Reference;
 190    begin
 191       pragma Assert (Iter in Iterator);
 192       Logs.Write
 193         (Module, "prepare select : " & Logs.NV ("SQL", SQL));
 194
 195       Iterator (Iter).H := DB;
 196       Iterator (Iter).More := False;
 197
 198       Check_Result
 199         ("prepare_select",
 200          SQLite3.prepare (DB.H, SQL, Iterator (Iter).S'Unchecked_Access));
 201
 202       Iterator (Iter).Col :=
 203         SQLite3.column_count (Iterator (Iter).S'Unchecked_Access);
 204
 205       Step_Internal (Iterator (Iter));
 206    end Prepare_Select;
 207
 208    --------------
 209    -- Rollback --
 210    --------------
 211
 212    overriding procedure Rollback (DB : in Handle) is
 213    begin
 214       Logs.Write (Module, "rollback");
 215       Execute (DB, "rollback");
 216    end Rollback;
 217
 218    -------------------
 219    -- Step_Internal --
 220    -------------------
 221
 222    procedure Step_Internal (Iter : in out Iterator) is
 223       use type SQLite3.Return_Value;
 224       R : SQLite3.Return_Value;
 225    begin
 226       R := SQLite3.step (Iter.S'Unchecked_Access);
 227
 228       if R = SQLite3.SQLITE_DONE then
 229          Iter.More := False;
 230       elsif R = SQLite3.SQLITE_ROW then
 231          Iter.More := True;
 232       else
 233          Check_Result ("step_internal", R);
 234          Iter.More := False;
 235       end if;
 236    end Step_Internal;
 237
 238 end DB.SQLite;