diff options
Diffstat (limited to 'src/sqlite3.adb')
| -rw-r--r-- | src/sqlite3.adb | 372 |
1 files changed, 372 insertions, 0 deletions
diff --git a/src/sqlite3.adb b/src/sqlite3.adb new file mode 100644 index 0000000..081d076 --- /dev/null +++ b/src/sqlite3.adb @@ -0,0 +1,372 @@ + + +with + + Interfaces.C.Strings; + + +package body SQLite3 is + + + procedure Open + (Filename : in String; + Handle : out SQLite3_DB) + is + function sqlite3_open + (Filename : in Interfaces.C.char_array; + DB_Handle : access DB_Private_Access) + return Interfaces.C.int + with Import => True, Convention => C; + + Code : Interfaces.C.int; + begin + Code := sqlite3_open (Interfaces.C.To_C (Filename), Handle.Ptr'Access); + if Status_Code (Code) /= SQLITE_OK then + raise Program_Error with Error_Message (Handle); + end if; + end Open; + + + procedure Open + (Filename : in String; + Handle : out SQLite3_DB; + Flags : in Open_Flag) + is + function sqlite3_open_v2 + (Filename : in Interfaces.C.char_array; + DB_Handle : access DB_Private_Access; + Flags : in Interfaces.C.int; + VFS : in Interfaces.C.char_array) + return Interfaces.C.int + with Import => True, Convention => C; + + Code : Interfaces.C.int; + begin + Code := sqlite3_open_v2 + (Interfaces.C.To_C (Filename), + Handle.Ptr'Access, + Interfaces.C.int (Flags), + Interfaces.C.To_C ("")); + if Status_Code (Code) /= SQLITE_OK then + raise Program_Error with Error_Message (Handle); + end if; + end Open; + + + procedure Close + (Handle : in out SQLite3_DB) + is + function sqlite3_close + (DB_Handle : in DB_Private_Access) + return Interfaces.C.int + with Import => True, Convention => C; + + Code : Interfaces.C.int; + Status : Status_Code; + begin + Code := sqlite3_close (Handle.Ptr); + Status := Status_Code (Code); + if Status /= SQLITE_OK and Status /= SQLITE_ROW and Status /= SQLITE_DONE 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) + is + type Chars_Ptr_Ptr is access all Interfaces.C.Strings.chars_ptr; + + -- int sqlite3_prepare_v2( + -- sqlite3 *db, /* Database handle */ + -- const char *zSql, /* SQL statement, UTF-8 encoded */ + -- int nByte, /* Maximum length of zSql in bytes. */ + -- sqlite3_stmt **ppStmt, /* OUT: Statement handle */ + -- const char **pzTail /* OUT: Pointer to unused portion of zSql */ + -- ); + function sqlite3_prepare_v2 + (DB_Handle : in DB_Private_Access; + zSql : in Interfaces.C.char_array; + nByte : in Interfaces.C.int; + ppStmt : access Statement_Private_Access; + pzTail : in Chars_Ptr_Ptr) + return Interfaces.C.int + with Import => True, Convention => C; + + SQL_Str : Interfaces.C.char_array := Interfaces.C.To_C (SQL); + Code : Interfaces.C.int; + begin + Code := sqlite3_prepare_v2 + (DB_Handle => Handle.Ptr, + zSql => SQL_Str, + nByte => SQL_Str'Length, + ppStmt => SQL_Handle.Ptr'Access, + pzTail => null); + if Status_Code (Code) /= SQLITE_OK then + raise Program_Error with Error_Message (Handle); + end if; + end Prepare; + + + procedure Prepare + (Handle : in SQLite3_DB; + SQL : in String; + Flags : in Prepare_Flag; + SQL_Handle : out SQLite3_Statement) + is + type Chars_Ptr_Ptr is access all Interfaces.C.Strings.chars_ptr; + + -- int sqlite3_prepare_v3( + -- sqlite3 *db, /* Database handle */ + -- const char *zSql, /* SQL statement, UTF-8 encoded */ + -- int nByte, /* Maximum length of zSql in bytes. */ + -- unsigned int prepFlags /* Zero or more SQLITE_PREPARE_ flags */ + -- sqlite3_stmt **ppStmt, /* OUT: Statement handle */ + -- const char **pzTail /* OUT: Pointer to unused portion of zSql */ + -- ); + function sqlite3_prepare_v2 + (DB_Handle : in DB_Private_Access; + zSql : in Interfaces.C.char_array; + nByte : in Interfaces.C.int; + prepFlags : in Interfaces.C.unsigned; + ppStmt : access Statement_Private_Access; + pzTail : in Chars_Ptr_Ptr) + return Interfaces.C.int + with Import => True, Convention => C; + + SQL_Str : Interfaces.C.char_array := Interfaces.C.To_C (SQL); + Code : Interfaces.C.int; + begin + Code := sqlite3_prepare_v2 + (DB_Handle => Handle.Ptr, + zSql => SQL_Str, + nByte => SQL_Str'Length, + prepFlags => Interfaces.C.unsigned (Flags), + ppStmt => SQL_Handle.Ptr'Access, + pzTail => null); + if Status_Code (Code) /= 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) + is + -- int sqlite3_step(sqlite3_stmt*); + function sqlite3_step + (Stmt : in Statement_Private_Access) + return Interfaces.C.int + with Import => True, Convention => C; + + 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); + end if; + end Step; + + + procedure Finish + (SQL_Handle : in SQLite3_Statement) + is + -- int sqlite3_finalize(sqlite3_stmt*); + function sqlite3_finalize + (Stmt : in Statement_Private_Access) + return Interfaces.C.int + with Import => True, Convention => C; + + Code : Interfaces.C.int; + Status : Status_Code; + begin + Code := sqlite3_finalize (SQL_Handle.Ptr); + Status := Status_Code (Code); + if Status /= SQLITE_OK then + raise Program_Error with Error_String (Status); + end if; + end Finish; + + + procedure Reset + (SQL_Handle : in SQLite3_Statement) + is + -- int sqlite3_reset(sqlite3_stmt*); + function sqlite3_reset + (Stmt : in Statement_Private_Access) + return Interfaces.C.int + 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); + end if; + end Reset; + + + procedure Bind + (SQL_Handle : in 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) + is + -- int sqlite3_bind_int(sqlite3_stmt*, int, int); + function sqlite3_bind_int + (Stmt : in Statement_Private_Access; + Index : in Interfaces.C.int; + Value : in Interfaces.C.int) + return Interfaces.C.int + 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); + end if; + end Bind; + + + procedure Bind + (SQL_Handle : in SQLite3_Statement; + Index : in SQL_Parameter_Index; + Value : in Ada.Strings.Unbounded.Unbounded_String) + is + use Ada.Strings.Unbounded; + + -- int sqlite3_bind_text + -- (sqlite3_stmt*, + -- int, + -- const char*, + -- int, + -- void(*)(void*)); + function sqlite3_bind_text + (Stmt : in Statement_Private_Access; + Index : in Interfaces.C.int; + Value : in Interfaces.C.char_array; + Bytes : in Interfaces.C.int; + Opt : in Interfaces.C.long) + return Interfaces.C.int + with Import => True, Convention => C; + + Code : Interfaces.C.int; + Status : Status_Code; + begin + Code := sqlite3_bind_text + (Stmt => SQL_Handle.Ptr, + Index => Interfaces.C.int (Index), + 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); + end if; + end Bind; + + + procedure Column + (SQL_Handle : in SQLite3_Statement; + Index : in SQL_Column_Index; + Value : out Int) + is + -- int sqlite3_column_int(sqlite3_stmt*, int iCol); + function sqlite3_column_int + (Stmt : in Statement_Private_Access; + Index : in Interfaces.C.int) + return Interfaces.C.int + with Import => True, Convention => C; + + Ret_Val : Interfaces.C.int; + begin + Ret_Val := sqlite3_column_int + (Stmt => SQL_Handle.Ptr, + Index => Interfaces.C.int (Index)); + Value := Int (Ret_Val); + end Column; + + + procedure Column + (SQL_Handle : in SQLite3_Statement; + Index : in SQL_Column_Index; + Value : out Ada.Strings.Unbounded.Unbounded_String) + is + use Ada.Strings.Unbounded; + use Interfaces; + use type Interfaces.C.Strings.chars_ptr; + + -- const unsigned char *sqlite3_column_text(sqlite3_stmt*, int iCol); + function sqlite3_column_text + (Stmt : in Statement_Private_Access; + Index : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr + with Import => True, Convention => C; + + Ret_Val : Interfaces.C.Strings.chars_ptr; + begin + Ret_Val := sqlite3_column_text + (Stmt => SQL_Handle.Ptr, + Index => Interfaces.C.int (Index)); + if Ret_Val = C.Strings.Null_Ptr then + Value := Null_Unbounded_String; + else + Value := To_Unbounded_String (C.To_Ada (C.Strings.Value (Ret_Val))); + end if; + end Column; + + + function Error_Message + (Handle : in SQLite3_DB) + return String + is + use Interfaces; + + -- const char *sqlite3_errmsg(sqlite3*); + function sqlite3_errmsg + (DB_Handle : in DB_Private_Access) + return C.Strings.chars_ptr + with Import => True, Convention => C; + begin + return C.To_Ada (C.Strings.Value (sqlite3_errmsg (Handle.Ptr))); + end Error_Message; + + + function Error_String + (Status : in Status_Code) + return String + is + use Interfaces; + + function sqlite3_errstr + (Code : in Interfaces.C.int) + return C.Strings.chars_ptr + with Import => True, Convention => C; + begin + return C.To_Ada (C.Strings.Value (sqlite3_errstr (Interfaces.C.int (Status)))); + end Error_String; + + +end SQLite3; + + |