src/db-sqlite.adb

   1 ------------------------------------------------------------------------------
   2 --                                GnadeLite                                 --
   3 --                                                                          --
   4 --                         Copyright (C) 2006-2008                          --
   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    Unique_Handle : SQLite3.Handle := null;
  34    --  Unique handle to use when we want to use in memory connection
  35
  36    procedure Unchecked_Free is new Unchecked_Deallocation
  37      (Object => SQLite3.Object, Name => SQLite3.Handle);
  38
  39    procedure Check_Result
  40      (Routine : in String;
  41       Result  : in SQLite3.Return_Value);
  42    pragma Inline (Check_Result);
  43    --  Check result, raises and exception if it is an error code
  44
  45    procedure Step_Internal (Iter : in out Iterator);
  46    --  Advance to the next row and set Iter.More
  47
  48    --  Thread safe access to the SQLite database
  49
  50    protected SQLite_Safe is
  51
  52       procedure Close
  53         (DB : in Handle; Result : out SQLite3.Return_Value);
  54       --  Close the database
  55
  56       procedure Exec
  57         (DB : in Handle; SQL : in String; Result : out SQLite3.Return_Value);
  58       --  Execute an SQL statement
  59
  60       procedure Open
  61         (DB : in Handle; Name : in String; Result : out SQLite3.Return_Value);
  62       --  Open the database
  63
  64       function Prepare_Select
  65         (DB   : in Handle;
  66          Iter : in Standard.DB.Iterator'Class;
  67          SQL  : in String) return Standard.DB.Iterator'Class;
  68       --  Prepare a select statement
  69
  70    end SQLite_Safe;
  71
  72    -----------------------
  73    -- Begin_Transaction --
  74    -----------------------
  75
  76    overriding procedure Begin_Transaction (DB : in Handle) is
  77    begin
  78       Logs.Write (Module, "begin");
  79       Execute (DB, "begin");
  80    end Begin_Transaction;
  81
  82    ------------------
  83    -- Check_Result --
  84    ------------------
  85
  86    procedure Check_Result
  87      (Routine : in String;
  88       Result  : in SQLite3.Return_Value)
  89    is
  90       use type SQLite3.Return_Value;
  91    begin
  92       if Result /= SQLite3.SQLITE_OK then
  93          Logs.Write
  94            (Name    => Module,
  95             Kind    => Logs.Error,
  96             Content => Logs.NV
  97               ("Return_Value", SQLite3.Return_Value'Image (Result))
  98               & ", " & Logs.NV ("routine", Routine));
  99          raise DB_Error
 100            with "SQLite: Error " & SQLite3.Return_Value'Image (Result) &
 101              " in " & Routine;
 102       end if;
 103    end Check_Result;
 104
 105    -----------
 106    -- Close --
 107    -----------
 108
 109    overriding procedure Close (DB : in out Handle) is
 110       Result : SQLite3.Return_Value;
 111    begin
 112       Logs.Write (Module, "close");
 113       SQLite_Safe.Close (DB, Result);
 114       Check_Result ("close", Result);
 115       Unchecked_Free (DB.H);
 116    end Close;
 117
 118    ------------
 119    -- Commit --
 120    ------------
 121
 122    overriding procedure Commit (DB : in Handle) is
 123    begin
 124       Logs.Write (Module, "commit");
 125       Execute (DB, "commit");
 126    end Commit;
 127
 128    -------------
 129    -- Connect --
 130    -------------
 131
 132    overriding procedure Connect
 133      (DB       : in out Handle;
 134       Name     : in     String;
 135       User     : in     String := "";
 136       Password : in     String := "")
 137    is
 138       pragma Unreferenced (User, Password);
 139       use type GNU.DB.SQLite3.Handle;
 140
 141       Result : SQLite3.Return_Value;
 142    begin
 143       Logs.Write (Module, "connect " & Logs.NV ("Name", Name));
 144
 145       if Name = In_Memory_Database then
 146          if Unique_Handle = null then
 147             --  Open only one database connection !
 148
 149             Unique_Handle := new GNU.DB.SQLite3.Object;
 150             DB.H := Unique_Handle;
 151             SQLite_Safe.Open (DB, Name, Result);
 152             Check_Result ("connect", Result);
 153
 154          elsif DB.H = null then
 155             --  Get the open database connection
 156             DB.H := Unique_Handle;
 157          end if;
 158
 159       else
 160          if DB.H = null then
 161             DB.H := new GNU.DB.SQLite3.Object;
 162          end if;
 163
 164          SQLite_Safe.Open (DB, Name, Result);
 165          Check_Result ("connect", Result);
 166       end if;
 167    end Connect;
 168
 169    ----------------
 170    -- End_Select --
 171    ----------------
 172
 173    overriding procedure End_Select (Iter : in out Iterator) is
 174    begin
 175       Logs.Write (Module, "end_select");
 176       Check_Result ("end_select", SQLite3.finalize (Iter.S'Unchecked_Access));
 177    end End_Select;
 178
 179    -------------
 180    -- Execute --
 181    -------------
 182
 183    overriding procedure Execute (DB : in Handle; SQL : in String) is
 184       Result : SQLite3.Return_Value;
 185    begin
 186       Logs.Write (Module, "execute : " & Logs.NV ("SQL", SQL));
 187       SQLite_Safe.Exec (DB, SQL, Result);
 188       Check_Result ("execute", Result);
 189    exception
 190       when DB_Error =>
 191          raise DB_Error with "DB_Error on Execute " & SQL;
 192    end Execute;
 193
 194    --------------
 195    -- Get_Line --
 196    --------------
 197
 198    overriding procedure Get_Line
 199      (Iter   : in out Iterator;
 200       Result :    out String_Vectors.Vector)
 201    is
 202       use type SQLite3.Return_Value;
 203    begin
 204       for K in 0 .. Iter.Col - 1 loop
 205          String_Vectors.Append
 206            (Result, SQLite3.column_text (Iter.S'Unchecked_Access, K));
 207       end loop;
 208
 209       Step_Internal (Iter);
 210    end Get_Line;
 211
 212    -----------------------
 213    -- Last_Insert_Rowid --
 214    -----------------------
 215
 216    overriding function Last_Insert_Rowid (DB : in Handle) return String is
 217       Rowid : constant String :=
 218                 SQLite3.uint64'Image (SQLite3.Last_Insert_Rowid (DB.H));
 219    begin
 220       --  Skip first whitespace returned by 'Image
 221       return Rowid (Rowid'First + 1 .. Rowid'Last);
 222    end Last_Insert_Rowid;
 223
 224    ----------
 225    -- More --
 226    ----------
 227
 228    overriding function More (Iter : in Iterator) return Boolean is
 229    begin
 230       return Iter.More;
 231    end More;
 232
 233    --------------------
 234    -- Prepare_Select --
 235    --------------------
 236
 237    overriding procedure Prepare_Select
 238      (DB   : in     Handle;
 239       Iter : in out Standard.DB.Iterator'Class;
 240       SQL  : in     String)
 241    is
 242       use type SQLite3.Statement_Reference;
 243    begin
 244       Iter := SQLite_Safe.Prepare_Select (DB, Iter, SQL);
 245    end Prepare_Select;
 246
 247    --------------
 248    -- Rollback --
 249    --------------
 250
 251    overriding procedure Rollback (DB : in Handle) is
 252    begin
 253       Logs.Write (Module, "rollback");
 254       Execute (DB, "rollback");
 255    end Rollback;
 256
 257    -----------------
 258    -- SQLite_Safe --
 259    -----------------
 260
 261    protected body SQLite_Safe is
 262
 263       -----------
 264       -- Close --
 265       -----------
 266
 267       procedure Close
 268         (DB : in Handle; Result : out SQLite3.Return_Value) is
 269       begin
 270          Result := SQLite3.Close (DB.H);
 271       end Close;
 272
 273       ----------
 274       -- Exec --
 275       ----------
 276
 277       procedure Exec
 278         (DB : in Handle; SQL : in String; Result : out SQLite3.Return_Value) is
 279       begin
 280          Result := SQLite3.Exec (DB.H, SQL);
 281       end Exec;
 282
 283       ----------
 284       -- Open --
 285       ----------
 286
 287       procedure Open
 288         (DB     : in Handle;
 289          Name   : in String;
 290          Result : out SQLite3.Return_Value) is
 291       begin
 292          Result := SQLite3.Open (DB.H, Name);
 293       end Open;
 294
 295       --------------------
 296       -- Prepare_Select --
 297       --------------------
 298
 299       function Prepare_Select
 300         (DB   : in Handle;
 301          Iter : in Standard.DB.Iterator'Class;
 302          SQL  : in String) return Standard.DB.Iterator'Class
 303       is
 304          use type SQLite3.Statement_Reference;
 305          Select_Iter : Standard.DB.Iterator'Class := Iter;
 306       begin
 307          pragma Assert (Select_Iter in Iterator);
 308          Logs.Write
 309            (Module, "prepare select : " & Logs.NV ("SQL", SQL));
 310
 311          Iterator (Select_Iter).H := DB;
 312          Iterator (Select_Iter).More := False;
 313
 314          Check_Result
 315            ("prepare_select",
 316             SQLite3.prepare
 317               (DB.H, SQL, Iterator (Select_Iter).S'Unchecked_Access));
 318
 319          Iterator (Select_Iter).Col :=
 320            SQLite3.column_count (Iterator (Select_Iter).S'Unchecked_Access);
 321
 322          Step_Internal (Iterator (Select_Iter));
 323          return Select_Iter;
 324       end Prepare_Select;
 325
 326    end SQLite_Safe;
 327
 328    -------------------
 329    -- Step_Internal --
 330    -------------------
 331
 332    procedure Step_Internal (Iter : in out Iterator) is
 333       use type SQLite3.Return_Value;
 334       R : SQLite3.Return_Value;
 335    begin
 336       R := SQLite3.step (Iter.S'Unchecked_Access);
 337
 338       if R = SQLite3.SQLITE_DONE then
 339          Iter.More := False;
 340
 341       elsif R = SQLite3.SQLITE_ROW then
 342          Iter.More := True;
 343
 344       else
 345          Check_Result ("step_internal", R);
 346          Iter.More := False;
 347       end if;
 348    end Step_Internal;
 349
 350 end DB.SQLite;