src/db-sqlite.adb

   1 ------------------------------------------------------------------------------
   2 --                                GnadeLite                                 --
   3 --                                                                          --
   4 --                         Copyright (C) 2006-2010                          --
   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 Interfaces.C.Strings;
  23 with System;
  24
  25 with Morzhol.Logs;
  26
  27 package body DB.SQLite is
  28
  29    use Morzhol;
  30    use Interfaces.C;
  31    use type sqlite3_h.Handle_Access;
  32
  33    Module : constant Logs.Module_Name := "DB_SQLITE";
  34
  35    Unique_Handle : sqlite3_h.Handle_Access := null;
  36    --  Unique handle to use when we want to use in memory connection
  37
  38    procedure Check_Result
  39      (Routine   : in String;
  40       Result    : in int;
  41       Error_Msg : in Strings.chars_ptr := Strings.Null_Ptr);
  42    --  Check result, raises and exception if it is an error code
  43
  44    procedure Step_Internal (Iter : in out Iterator);
  45    --  Advance to the next row and set Iter.More
  46
  47    --  Thread safe access to the SQLite database
  48
  49    protected SQLite_Safe is
  50
  51       procedure Close
  52         (DB : in out Handle; Result : out int);
  53       --  Close the database
  54       pragma Precondition (DB.H /= null);
  55
  56       procedure Exec
  57         (DB     : in Handle;
  58          SQL    : in String);
  59       --  Execute an SQL statement
  60       --  Raise DB_Error is case of failure
  61       pragma Precondition (SQL /= "");
  62       pragma Precondition (DB.H /= null);
  63       pragma Postcondition (DB.H /= null);
  64
  65       procedure Open
  66         (DB     : in out Handle;
  67          Name   : in     String;
  68          Result :    out int);
  69       --  Open the database
  70       pragma Precondition (Name /= "");
  71
  72       function Prepare_Select
  73         (DB   : in Handle;
  74          Iter : in Standard.DB.Iterator'Class;
  75          SQL  : in String) return Standard.DB.Iterator'Class;
  76       --  Prepare a select statement
  77       pragma Precondition (SQL /= "");
  78       pragma Precondition (DB.H /= null);
  79       pragma Postcondition (DB.H /= null);
  80
  81    end SQLite_Safe;
  82
  83    -----------------------
  84    -- Begin_Transaction --
  85    -----------------------
  86
  87    overriding procedure Begin_Transaction (DB : in Handle) is
  88    begin
  89       Logs.Write (Module, "begin");
  90       Execute (DB, "begin");
  91    end Begin_Transaction;
  92
  93    ------------------
  94    -- Check_Result --
  95    ------------------
  96
  97    procedure Check_Result
  98      (Routine   : in String;
  99       Result    : in int;
 100       Error_Msg : in Strings.chars_ptr := Strings.Null_Ptr)
 101    is
 102       use type sqlite3_h.sqlite_result;
 103
 104       DB_Result : sqlite3_h.sqlite_result;
 105       for DB_Result'Address use Result'Address;
 106
 107       function Error_Message return String;
 108       --  Returns and free Error_Msg content if not null
 109
 110       -------------------
 111       -- Error_Message --
 112       -------------------
 113
 114       function Error_Message return String is
 115          use type Strings.chars_ptr;
 116       begin
 117          if Error_Msg = Strings.Null_Ptr then
 118             return "";
 119
 120          else
 121             Free : declare
 122                V : constant String := Strings.Value (Error_Msg);
 123             begin
 124                sqlite3_h.sqlite3_free (Error_Msg'Address);
 125                return V;
 126             end Free;
 127          end if;
 128       end Error_Message;
 129
 130    begin
 131       if not DB_Result'Valid then
 132          Logs.Write
 133            (Name    => Module,
 134             Kind    => Logs.Error,
 135             Content => "SQLite3 has return an unknown result in !" & Routine);
 136          raise DB_Error with "SQlite: Error (Unknown Error) in " & Routine;
 137       end if;
 138
 139       if DB_Result /= sqlite3_h.SQLITE_OK then
 140          Logs.Write
 141            (Name    => Module,
 142             Kind    => Logs.Error,
 143             Content => Logs.NV
 144               ("Return_Value", sqlite3_h.sqlite_result'Image (DB_Result))
 145             & ", " & Logs.NV ("routine", Routine)
 146             & ", " & Logs.NV ("message", Error_Message));
 147          raise DB_Error
 148            with "SQLite: Error "
 149              & sqlite3_h.sqlite_result'Image (DB_Result) & " in " & Routine;
 150       end if;
 151    end Check_Result;
 152
 153    -----------
 154    -- Close --
 155    -----------
 156
 157    overriding procedure Close (DB : in out Handle) is
 158       Result : int;
 159    begin
 160       Logs.Write (Module, "close");
 161       SQLite_Safe.Close (DB, Result);
 162       Check_Result ("close", Result);
 163    end Close;
 164
 165    ------------
 166    -- Commit --
 167    ------------
 168
 169    overriding procedure Commit (DB : in Handle) is
 170    begin
 171       Logs.Write (Module, "commit");
 172       Execute (DB, "commit");
 173    end Commit;
 174
 175    -------------
 176    -- Connect --
 177    -------------
 178
 179    overriding procedure Connect
 180      (DB       : in out Handle;
 181       Name     : in     String;
 182       User     : in     String := "";
 183       Password : in     String := "")
 184    is
 185       pragma Unreferenced (User, Password);
 186
 187       Result : int;
 188    begin
 189       Logs.Write (Module, "connect " & Logs.NV ("Name", Name));
 190       SQLite_Safe.Open (DB, Name, Result);
 191       Check_Result ("connect", Result);
 192    end Connect;
 193
 194    ----------------
 195    -- End_Select --
 196    ----------------
 197
 198    overriding procedure End_Select (Iter : in out Iterator) is
 199    begin
 200       Logs.Write (Module, "end_select");
 201       Check_Result ("end_select_reset",
 202                     sqlite3_h.sqlite3_reset (Iter.S.all'Address));
 203       Check_Result ("end_select",
 204                     sqlite3_h.sqlite3_finalize (Iter.S.all'Address));
 205    end End_Select;
 206
 207    -------------
 208    -- Execute --
 209    -------------
 210
 211    overriding procedure Execute (DB : in Handle; SQL : in String) is
 212    begin
 213       Logs.Write (Module, "execute : " & Logs.NV ("SQL", SQL));
 214       SQLite_Safe.Exec (DB, SQL);
 215    exception
 216       when DB_Error =>
 217          raise DB_Error with "DB_Error on Execute " & SQL;
 218    end Execute;
 219
 220    --------------
 221    -- Get_Line --
 222    --------------
 223
 224    overriding procedure Get_Line
 225      (Iter   : in out Iterator;
 226       Result :    out String_Vectors.Vector)
 227    is
 228    begin
 229       Result.Clear;
 230       for K in 0 .. Iter.Col - 1 loop
 231          declare
 232             Text : constant Strings.chars_ptr :=
 233                      sqlite3_h.sqlite3_column_text (Iter.S.all'Address, K);
 234             use type Strings.chars_ptr;
 235          begin
 236             if Text /= Strings.Null_Ptr then
 237                String_Vectors.Append
 238                  (Result,
 239                   Interfaces.C.Strings.Value (Text));
 240             else
 241                String_Vectors.Append (Result, "");
 242             end if;
 243          end;
 244       end loop;
 245
 246       Step_Internal (Iter);
 247    end Get_Line;
 248
 249    -----------------------
 250    -- Last_Insert_Rowid --
 251    -----------------------
 252
 253    overriding function Last_Insert_Rowid (DB : in Handle) return String is
 254       Rowid : constant String :=
 255                 sqlite3_h.sqlite_int64'Image
 256                   (sqlite3_h.sqlite3_last_insert_rowid (DB.H.all'Address));
 257    begin
 258       --  Skip first whitespace returned by 'Image
 259       return Rowid (Rowid'First + 1 .. Rowid'Last);
 260    end Last_Insert_Rowid;
 261
 262    ----------
 263    -- More --
 264    ----------
 265
 266    overriding function More (Iter : in Iterator) return Boolean is
 267    begin
 268       return Iter.More;
 269    end More;
 270
 271    --------------------
 272    -- Prepare_Select --
 273    --------------------
 274
 275    overriding procedure Prepare_Select
 276      (DB   : in     Handle;
 277       Iter : in out Standard.DB.Iterator'Class;
 278       SQL  : in     String)
 279    is
 280    begin
 281       Iter := SQLite_Safe.Prepare_Select (DB, Iter, SQL);
 282    end Prepare_Select;
 283
 284    --------------
 285    -- Rollback --
 286    --------------
 287
 288    overriding procedure Rollback (DB : in Handle) is
 289    begin
 290       Logs.Write (Module, "rollback");
 291       Execute (DB, "rollback");
 292    end Rollback;
 293
 294    -----------------
 295    -- SQLite_Safe --
 296    -----------------
 297
 298    protected body SQLite_Safe is
 299
 300       -----------
 301       -- Close --
 302       -----------
 303
 304       procedure Close
 305         (DB : in out Handle; Result : out int) is
 306       begin
 307          if DB.Ref_Count /= 0 then
 308             DB.Ref_Count := DB.Ref_Count - 1;
 309             Result := 0; --  SQLite3_OK;
 310          else
 311             Result := sqlite3_h.sqlite3_close (DB.H.all'Address);
 312          end if;
 313       end Close;
 314
 315       ----------
 316       -- Exec --
 317       ----------
 318
 319       procedure Exec
 320         (DB : in Handle; SQL : in String)
 321       is
 322          SQL_Stat  : Strings.chars_ptr := Strings.New_String (SQL);
 323          Result    : int;
 324          Error_Msg : Strings.chars_ptr;
 325       begin
 326          Result := sqlite3_h.sqlite3_exec_no_callback
 327            (DB.H.all'Address, SQL_Stat, System.Null_Address,
 328             System.Null_Address, Error_Msg'Address);
 329
 330          Check_Result ("Execute", Result, Error_Msg);
 331
 332          --  Free
 333
 334          Strings.Free (SQL_Stat);
 335       end Exec;
 336
 337       ----------
 338       -- Open --
 339       ----------
 340
 341       procedure Open
 342         (DB     : in out Handle;
 343          Name   : in     String;
 344          Result :    out int) is
 345
 346          procedure Open_Db;
 347          --  Open a database connection
 348
 349          -------------
 350          -- Open_Db --
 351          -------------
 352
 353          procedure Open_Db is
 354             SQL_Name : Strings.chars_ptr := Strings.New_String (Name);
 355          begin
 356             Result := sqlite3_h.sqlite3_open (SQL_Name, DB.H'Address);
 357             Strings.Free (SQL_Name);
 358          end Open_Db;
 359
 360       begin
 361          if Name = In_Memory_Database then
 362             if Unique_Handle = null then
 363                --  Open only one database connection !
 364                Open_Db;
 365                Unique_Handle := DB.H;
 366
 367             elsif DB.H = null then
 368                --  Get the open database connection
 369                DB.H   := Unique_Handle;
 370                Result := 0; --  SQLite_OK
 371
 372                --  Increment the reference counter
 373                DB.Ref_Count := DB.Ref_Count + 1;
 374
 375             else
 376                --  Nothing to do. Return OK
 377                Result := 0; -- SQLite_OK
 378             end if;
 379
 380          else
 381             Open_Db;
 382          end if;
 383       end Open;
 384
 385       --------------------
 386       -- Prepare_Select --
 387       --------------------
 388
 389       function Prepare_Select
 390         (DB   : in Handle;
 391          Iter : in Standard.DB.Iterator'Class;
 392          SQL  : in String) return Standard.DB.Iterator'Class
 393       is
 394          Select_Iter : Standard.DB.Iterator'Class := Iter;
 395          zSql        : Strings.chars_ptr := Strings.New_String (SQL);
 396          Select_Res  : int;
 397       begin
 398          pragma Assert (Select_Iter in Iterator);
 399
 400          Logs.Write
 401            (Module, "prepare select : " & Logs.NV ("SQL", SQL));
 402
 403          Iterator (Select_Iter).H := DB;
 404          Iterator (Select_Iter).More := False;
 405
 406          Select_Res := sqlite3_h.sqlite3_prepare_v2
 407               (db     => DB.H.all'Address,
 408                zSql   => zSql,
 409                nByte  => SQL'Length + 1,
 410                ppStmt => Iterator (Select_Iter).S'Address,
 411                pzTail => System.Null_Address);
 412
 413          Check_Result ("prepare_select", Select_Res);
 414
 415          Column_Count : declare
 416             use type sqlite3_h.sqlite_result;
 417
 418             DB_Result : sqlite3_h.sqlite_result;
 419             for DB_Result'Address use Select_Res'Address;
 420          begin
 421             if DB_Result = sqlite3_h.SQLITE_DONE then
 422                Iterator (Select_Iter).Col := 0;
 423             else
 424                Iterator (Select_Iter).Col :=
 425                  sqlite3_h.sqlite3_column_count
 426                    (Iterator (Select_Iter).S.all'Address);
 427                Step_Internal (Iterator (Select_Iter));
 428             end if;
 429          end Column_Count;
 430
 431          Strings.Free (zSql);
 432          return Select_Iter;
 433       end Prepare_Select;
 434
 435    end SQLite_Safe;
 436
 437    -------------------
 438    -- Step_Internal --
 439    -------------------
 440
 441    procedure Step_Internal (Iter : in out Iterator) is
 442       R : int;
 443    begin
 444       R := sqlite3_h.sqlite3_step (Iter.S.all'Address);
 445
 446       Analyse_Result : declare
 447          Result : sqlite3_h.sqlite_result;
 448          for Result'Address use R'Address;
 449
 450          use type sqlite3_h.sqlite_result;
 451       begin
 452          if not Result'Valid then
 453             raise DB_Error with "Wrong result from sqlite3_step ?";
 454          else
 455             if Result = sqlite3_h.SQLITE_DONE then
 456                Iter.More := False;
 457             elsif Result = sqlite3_h.SQLITE_ROW then
 458                Iter.More := True;
 459             else
 460                Check_Result ("step_internal", R);
 461                Iter.More := False;
 462             end if;
 463          end if;
 464       end Analyse_Result;
 465    end Step_Internal;
 466
 467 begin
 468    --  sqlite3_initialize is present only in very recent SQLite3
 469    --  versions and it is safe to disable the call for now
 470    --  Check_Result ("initialize", sqlite3_h.sqlite3_initialize);
 471    null;
 472 end DB.SQLite;