From 109379f51430ea057d810791b43ba02c22a30e46 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Wed, 3 Nov 2021 12:30:31 +1300 Subject: SQL binding now automatically closes databases and finishes statements --- src/deck_io.adb | 12 ++--- src/sqlite3.adb | 146 +++++++++++++++++++++++++++++++++++--------------------- src/sqlite3.ads | 92 +++++++++++++++++++++-------------- 3 files changed, 152 insertions(+), 98 deletions(-) diff --git a/src/deck_io.adb b/src/deck_io.adb index 20eb6c1..8830df0 100644 --- a/src/deck_io.adb +++ b/src/deck_io.adb @@ -40,7 +40,6 @@ package body Deck_IO is (This : in out Deck_Handle) is begin if This.Opened then - SQLite3.Close (This.SQL_Handle); FD.Delete_File (-This.Tempfile); end if; end Finalize; @@ -123,7 +122,7 @@ package body Deck_IO is Temp : String := Generate_Temp_Name; begin UnZip.Extract (Filename, "collection.anki2", Temp); - SQLite3.Open (Temp, Deck.SQL_Handle); + Deck.SQL_Handle.Open (Temp); Deck.Opened := True; Deck.Tempfile := +Temp; end Open_Database; @@ -143,7 +142,7 @@ package body Deck_IO is if Deck.Opened = False then return; end if; - SQLite3.Close (Deck.SQL_Handle); + Deck.SQL_Handle.Close; Deck.Opened := False; FD.Delete_File (-Deck.Tempfile); Deck.Tempfile := +""; @@ -250,10 +249,9 @@ package body Deck_IO is Extract_Model (Name, Value, Models); end JSON_Callback; begin - SQLite3.Prepare (Deck.SQL_Handle, "SELECT models FROM col", Statement); - SQLite3.Step (Statement, Deck.Status); - SQLite3.Column (Statement, 0, Raw_Data); - SQLite3.Finish (Statement); + Deck.SQL_Handle.Prepare ("SELECT models FROM col", Statement); + Statement.Step; + Raw_Data := Statement.Column (0); JSON_Data := JS.Read (-Raw_Data); JS.Map_JSON_Object (JSON_Data, JSON_Callback'Access); end Query_Models; diff --git a/src/sqlite3.adb b/src/sqlite3.adb index 081d076..d39fd6c 100644 --- a/src/sqlite3.adb +++ b/src/sqlite3.adb @@ -8,9 +8,25 @@ with package body SQLite3 is + procedure Finalize + (This : in out SQLite3_DB) is + begin + This.Close; + end Finalize; + + + procedure Finalize + (This : in out SQLite3_Statement) is + begin + This.Finish; + end Finalize; + + + + procedure Open - (Filename : in String; - Handle : out SQLite3_DB) + (Handle : out SQLite3_DB; + Filename : in String) is function sqlite3_open (Filename : in Interfaces.C.char_array; @@ -21,6 +37,7 @@ package body SQLite3 is Code : Interfaces.C.int; begin Code := sqlite3_open (Interfaces.C.To_C (Filename), Handle.Ptr'Access); + Handle.Prep := True; if Status_Code (Code) /= SQLITE_OK then raise Program_Error with Error_Message (Handle); end if; @@ -28,8 +45,8 @@ package body SQLite3 is procedure Open - (Filename : in String; - Handle : out SQLite3_DB; + (Handle : out SQLite3_DB; + Filename : in String; Flags : in Open_Flag) is function sqlite3_open_v2 @@ -47,6 +64,7 @@ package body SQLite3 is Handle.Ptr'Access, Interfaces.C.int (Flags), Interfaces.C.To_C ("")); + Handle.Prep := True; if Status_Code (Code) /= SQLITE_OK then raise Program_Error with Error_Message (Handle); end if; @@ -62,20 +80,24 @@ package body SQLite3 is with Import => True, Convention => C; Code : Interfaces.C.int; - Status : Status_Code; begin + if Handle.Prep = False then + return; + end if; Code := sqlite3_close (Handle.Ptr); - Status := Status_Code (Code); - if Status /= SQLITE_OK and Status /= SQLITE_ROW and Status /= SQLITE_DONE then + Handle.Prep := False; + if Status_Code (Code) /= SQLITE_OK then raise Program_Error with Error_Message (Handle); end if; end Close; + + procedure Prepare (Handle : in SQLite3_DB; SQL : in String; - SQL_Handle : out SQLite3_Statement) + SQL_Handle : out SQLite3_Statement'Class) is type Chars_Ptr_Ptr is access all Interfaces.C.Strings.chars_ptr; @@ -104,7 +126,9 @@ package body SQLite3 is nByte => SQL_Str'Length, ppStmt => SQL_Handle.Ptr'Access, pzTail => null); - if Status_Code (Code) /= SQLITE_OK then + SQL_Handle.Prep := True; + SQL_Handle.Status := Status_Code (Code); + if SQL_Handle.Status /= SQLITE_OK then raise Program_Error with Error_Message (Handle); end if; end Prepare; @@ -114,7 +138,7 @@ package body SQLite3 is (Handle : in SQLite3_DB; SQL : in String; Flags : in Prepare_Flag; - SQL_Handle : out SQLite3_Statement) + SQL_Handle : out SQLite3_Statement'Class) is type Chars_Ptr_Ptr is access all Interfaces.C.Strings.chars_ptr; @@ -146,15 +170,16 @@ package body SQLite3 is prepFlags => Interfaces.C.unsigned (Flags), ppStmt => SQL_Handle.Ptr'Access, pzTail => null); - if Status_Code (Code) /= SQLITE_OK then + SQL_Handle.Prep := True; + SQL_Handle.Status := Status_Code (Code); + if SQL_Handle.Status /= SQLITE_OK then raise Program_Error with Error_Message (Handle); end if; end Prepare; procedure Step - (SQL_Handle : in SQLite3_Statement; - Status : out Status_Code) + (SQL_Handle : in out SQLite3_Statement) is -- int sqlite3_step(sqlite3_stmt*); function sqlite3_step @@ -165,15 +190,26 @@ package body SQLite3 is Code : Interfaces.C.int; begin Code := sqlite3_step (SQL_Handle.Ptr); - Status := Status_Code (Code); - if Status /= SQLITE_OK and Status /= SQLITE_ROW and Status /= SQLITE_DONE then - raise Program_Error with Error_String (Status); + SQL_Handle.Status := Status_Code (Code); + if SQL_Handle.Status /= SQLITE_OK and + SQL_Handle.Status /= SQLITE_ROW and + SQL_Handle.Status /= SQLITE_DONE + then + raise Program_Error with Error_String (SQL_Handle.Status); end if; end Step; - procedure Finish + function Status (SQL_Handle : in SQLite3_Statement) + return Status_Code is + begin + return SQL_Handle.Status; + end Status; + + + procedure Finish + (SQL_Handle : in out SQLite3_Statement) is -- int sqlite3_finalize(sqlite3_stmt*); function sqlite3_finalize @@ -182,18 +218,21 @@ package body SQLite3 is with Import => True, Convention => C; Code : Interfaces.C.int; - Status : Status_Code; begin + if SQL_Handle.Prep = False then + return; + end if; Code := sqlite3_finalize (SQL_Handle.Ptr); - Status := Status_Code (Code); - if Status /= SQLITE_OK then - raise Program_Error with Error_String (Status); + SQL_Handle.Prep := False; + SQL_Handle.Status := Status_Code (Code); + if SQL_Handle.Status /= SQLITE_OK then + raise Program_Error with Error_String (SQL_Handle.Status); end if; end Finish; procedure Reset - (SQL_Handle : in SQLite3_Statement) + (SQL_Handle : in out SQLite3_Statement) is -- int sqlite3_reset(sqlite3_stmt*); function sqlite3_reset @@ -202,29 +241,28 @@ package body SQLite3 is with Import => True, Convention => C; Code : Interfaces.C.int; - Status : Status_Code; begin Code := sqlite3_reset (SQL_Handle.Ptr); - Status := Status_Code (Code); - if Status /= SQLITE_OK then - raise Program_Error with Error_String (Status); + SQL_Handle.Status := Status_Code (Code); + if SQL_Handle.Status /= SQLITE_OK then + raise Program_Error with Error_String (SQL_Handle.Status); end if; end Reset; procedure Bind - (SQL_Handle : in SQLite3_Statement; - Index : in SQL_Parameter_Index; - Value : in Integer) is + (SQL_Handle : in out SQLite3_Statement; + Index : in SQL_Parameter_Index; + Value : in Integer) is begin Bind (SQL_Handle, Index, Long_Integer (Value)); end Bind; procedure Bind - (SQL_Handle : in SQLite3_Statement; - Index : in SQL_Parameter_Index; - Value : in Long_Integer) + (SQL_Handle : in out SQLite3_Statement; + Index : in SQL_Parameter_Index; + Value : in Long_Integer) is -- int sqlite3_bind_int(sqlite3_stmt*, int, int); function sqlite3_bind_int @@ -235,23 +273,22 @@ package body SQLite3 is with Import => True, Convention => C; Code : Interfaces.C.int; - Status : Status_Code; begin Code := sqlite3_bind_int (Stmt => SQL_Handle.Ptr, Index => Interfaces.C.int (Index), Value => Interfaces.C.int (Value)); - Status := Status_Code (Code); - if Status /= SQLITE_OK then - raise Program_Error with Error_String (Status); + SQL_Handle.Status := Status_Code (Code); + if SQL_Handle.Status /= SQLITE_OK then + raise Program_Error with Error_String (SQL_Handle.Status); end if; end Bind; procedure Bind - (SQL_Handle : in SQLite3_Statement; - Index : in SQL_Parameter_Index; - Value : in Ada.Strings.Unbounded.Unbounded_String) + (SQL_Handle : in out SQLite3_Statement; + Index : in SQL_Parameter_Index; + Value : in Ada.Strings.Unbounded.Unbounded_String) is use Ada.Strings.Unbounded; @@ -271,7 +308,6 @@ package body SQLite3 is with Import => True, Convention => C; Code : Interfaces.C.int; - Status : Status_Code; begin Code := sqlite3_bind_text (Stmt => SQL_Handle.Ptr, @@ -279,17 +315,17 @@ package body SQLite3 is Value => Interfaces.C.To_C (To_String (Value)), Bytes => Interfaces.C.int (Length (Value)), Opt => SQLITE_TRANSIENT); - Status := Status_Code (Code); - if Status /= SQLITE_OK then - raise Program_Error with Error_String (Status); + SQL_Handle.Status := Status_Code (Code); + if SQL_Handle.Status /= SQLITE_OK then + raise Program_Error with Error_String (SQL_Handle.Status); end if; end Bind; - procedure Column - (SQL_Handle : in SQLite3_Statement; - Index : in SQL_Column_Index; - Value : out Int) + function Column + (SQL_Handle : in SQLite3_Statement; + Index : in SQL_Column_Index) + return Integer is -- int sqlite3_column_int(sqlite3_stmt*, int iCol); function sqlite3_column_int @@ -303,14 +339,14 @@ package body SQLite3 is Ret_Val := sqlite3_column_int (Stmt => SQL_Handle.Ptr, Index => Interfaces.C.int (Index)); - Value := Int (Ret_Val); + return Integer (Ret_Val); end Column; - procedure Column - (SQL_Handle : in SQLite3_Statement; - Index : in SQL_Column_Index; - Value : out Ada.Strings.Unbounded.Unbounded_String) + function Column + (SQL_Handle : in SQLite3_Statement; + Index : in SQL_Column_Index) + return Ada.Strings.Unbounded.Unbounded_String is use Ada.Strings.Unbounded; use Interfaces; @@ -329,13 +365,15 @@ package body SQLite3 is (Stmt => SQL_Handle.Ptr, Index => Interfaces.C.int (Index)); if Ret_Val = C.Strings.Null_Ptr then - Value := Null_Unbounded_String; + return Null_Unbounded_String; else - Value := To_Unbounded_String (C.To_Ada (C.Strings.Value (Ret_Val))); + return To_Unbounded_String (C.To_Ada (C.Strings.Value (Ret_Val))); end if; end Column; + + function Error_Message (Handle : in SQLite3_DB) return String diff --git a/src/sqlite3.ads b/src/sqlite3.ads index 667fdd6..df49e2c 100644 --- a/src/sqlite3.ads +++ b/src/sqlite3.ads @@ -2,16 +2,18 @@ with - Ada.Strings.Unbounded, - System, - Interfaces.C; + Ada.Strings.Unbounded; + +private with + + Ada.Finalization; package SQLite3 is - type SQLite3_DB is private; - type SQLite3_Statement is private; + type SQLite3_DB is tagged limited private; + type SQLite3_Statement is tagged limited private; type Open_Flag is mod 2**32; type Prepare_Flag is mod 2**32; @@ -19,7 +21,6 @@ package SQLite3 is subtype SQL_Parameter_Index is Integer range 1 .. Integer'Last; subtype SQL_Column_Index is Integer; - type Int is new Interfaces.C.int; OPEN_READONLY : constant Open_Flag := 1; @@ -56,62 +57,66 @@ package SQLite3 is procedure Open - (Filename : in String; - Handle : out SQLite3_DB); + (Handle : out SQLite3_DB; + Filename : in String); procedure Open - (Filename : in String; - Handle : out SQLite3_DB; + (Handle : out SQLite3_DB; + Filename : in String; Flags : in Open_Flag); procedure Close (Handle : in out SQLite3_DB); + procedure Prepare (Handle : in SQLite3_DB; SQL : in String; - SQL_Handle : out SQLite3_Statement); + SQL_Handle : out SQLite3_Statement'Class); procedure Prepare (Handle : in SQLite3_DB; SQL : in String; Flags : in Prepare_Flag; - SQL_Handle : out SQLite3_Statement); + SQL_Handle : out SQLite3_Statement'Class); procedure Step - (SQL_Handle : in SQLite3_Statement; - Status : out Status_Code); + (SQL_Handle : in out SQLite3_Statement); + + function Status + (SQL_Handle : in SQLite3_Statement) + return Status_Code; procedure Finish - (SQL_Handle : in SQLite3_Statement); + (SQL_Handle : in out SQLite3_Statement); procedure Reset - (SQL_Handle : in SQLite3_Statement); + (SQL_Handle : in out SQLite3_Statement); procedure Bind - (SQL_Handle : in SQLite3_Statement; - Index : in SQL_Parameter_Index; - Value : in Integer); + (SQL_Handle : in out SQLite3_Statement; + Index : in SQL_Parameter_Index; + Value : in Integer); procedure Bind - (SQL_Handle : in SQLite3_Statement; - Index : in SQL_Parameter_Index; - Value : in Long_Integer); + (SQL_Handle : in out SQLite3_Statement; + Index : in SQL_Parameter_Index; + Value : in Long_Integer); procedure Bind - (SQL_Handle : in SQLite3_Statement; - Index : in SQL_Parameter_Index; - Value : in Ada.Strings.Unbounded.Unbounded_String); + (SQL_Handle : in out SQLite3_Statement; + Index : in SQL_Parameter_Index; + Value : in Ada.Strings.Unbounded.Unbounded_String); - procedure Column - (SQL_Handle : in SQLite3_Statement; - Index : in SQL_Column_Index; - Value : out Int); + function Column + (SQL_Handle : in SQLite3_Statement; + Index : in SQL_Column_Index) + return Integer; - procedure Column - (SQL_Handle : in SQLite3_Statement; - Index : in SQL_Column_Index; - Value : out Ada.Strings.Unbounded.Unbounded_String); + function Column + (SQL_Handle : in SQLite3_Statement; + Index : in SQL_Column_Index) + return Ada.Strings.Unbounded.Unbounded_String; private @@ -132,16 +137,29 @@ private type DB_Private is null record; type DB_Private_Access is access all DB_Private; - type SQLite3_DB is record - Ptr : aliased DB_Private_Access; + type SQLite3_DB is new Ada.Finalization.Limited_Controlled with record + Ptr : aliased DB_Private_Access; + Prep : Boolean := False; end record; + overriding + procedure Finalize + (This : in out SQLite3_DB); + + type Statement_Private is null record; type Statement_Private_Access is access all Statement_Private; - type SQLite3_Statement is record - Ptr : aliased Statement_Private_Access; + + type SQLite3_Statement is new Ada.Finalization.Limited_Controlled with record + Ptr : aliased Statement_Private_Access; + Status : Status_Code := SQLITE_OK; + Prep : Boolean := False; end record; + overriding + procedure Finalize + (This : in out SQLite3_Statement); + end SQLite3; -- cgit