Add option flags for database creation

This commit is contained in:
Folkert Kevelam 2025-07-25 16:17:14 +02:00
parent e6779e4868
commit 7b7c5df611
2 changed files with 161 additions and 0 deletions

View File

@ -1,6 +1,10 @@
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Ada.Unchecked_Conversion;
package body Sqlite is
procedure Finalize (Db : in out Database) is
@ -39,6 +43,75 @@ package body Sqlite is
end Open;
procedure Open (
Db : in out Database;
Filename : String;
RW : Database_Open;
Create : Boolean;
Filename_URI : Boolean := False;
Open_In_Memory : Boolean := False;
Mutex : Database_Mutex := Disabled;
Cache : Database_Cache := Disabled;
Expres_Code : Boolean := False;
No_Follow : Boolean := False)
is
function sqlite3_open_v2 (
Filename : Chars_Ptr;
ppDb : out Database_Int;
Flags : Int;
zVfs : Chars_Ptr) return Int
with Import, Convention => C;
function Convert is new Ada.Unchecked_Conversion (
Source => Database_Int_Flags,
Target => Int);
Flags : Database_Int_Flags;
Error : Int;
begin
case RW is
when ReadOnly =>
Flags.Open_ReadOnly := True;
when ReadWrite =>
Flags.Open_ReadWrite := True;
end case;
Flags.Open_Create := Create;
Flags.Open_URI := Filename_URI;
FLags.Open_Memory := Open_In_Memory;
case Mutex is
when Disabled =>
null;
when No_Mutex =>
Flags.Open_NoMutex := True;
when Full_Mutex =>
Flags.Open_FullMutex := True;
end case;
case Cache is
when Disabled =>
null;
when Shared_Cache =>
Flags.Open_SharedCache := True;
when Private_Cache =>
Flags.Open_PrivateCache := True;
end case;
Put_Line (Convert (Flags)'Image);
Error := sqlite3_open_v2 (
New_String (Filename),
Db.Internal,
Convert (Flags),
Null_Ptr);
Db.Version := v2;
end Open;
procedure Close (Db : in out Database) is
begin
Db.Finalize;

View File

@ -2,9 +2,39 @@ with Ada.Finalization;
package Sqlite is
type Database_Open is (
ReadOnly,
ReadWrite
);
type Database_Mutex is (
Disabled,
No_Mutex,
Full_Mutex
);
type Database_Cache is (
Disabled,
Shared_Cache,
Private_Cache
);
type Database is tagged private;
procedure Open (Db : in out Database; Filename : String);
procedure Open (
Db : in out Database;
Filename : String;
RW : Database_Open;
Create : Boolean;
Filename_URI : Boolean := False;
Open_In_Memory : Boolean := False;
Mutex : Database_Mutex := Disabled;
Cache : Database_Cache := Disabled;
Expres_Code : Boolean := False;
No_Follow : Boolean := False);
procedure Close (Db : in out Database);
private
@ -23,4 +53,62 @@ private
overriding
procedure Finalize (Db : in out Database);
type Bit_10 is mod 2**10
with Size => 10;
type Database_Int_Flags is
record
Open_ReadOnly : Boolean := False;
Open_ReadWrite : Boolean := False;
Open_Create : Boolean := False;
Open_DeleteOnClose : Boolean := False;
Open_Exclusive : Boolean := False;
Open_AutoProxy : Boolean := False;
Open_URI : Boolean := False;
Open_Memory : Boolean := False;
Open_Main_DB : Boolean := False;
Open_Temp_DB : Boolean := False;
Open_Transient_DB : Boolean := False;
Open_Main_Journal : Boolean := False;
Open_Temp_Journal : Boolean := False;
Open_Sub_Journal : Boolean := False;
Open_Super_Journal : Boolean := False;
Open_NoMutex : Boolean := False;
Open_FullMutex : Boolean := False;
Open_SharedCache : Boolean := False;
Open_PrivateCache : Boolean := False;
Open_WAL : Boolean := False;
Open_NoFollow : Boolean := False;
Open_ExpresCode : Boolean := False;
Reserved : Bit_10 := 0;
end record
with Size => 32;
for Database_Int_Flags use
record
Open_ReadOnly at 0 range 0 .. 0;
Open_ReadWrite at 0 range 1 .. 1;
Open_Create at 0 range 2 .. 2;
Open_DeleteOnClose at 0 range 3 .. 3;
Open_Exclusive at 0 range 4 .. 4;
Open_AutoProxy at 0 range 5 .. 5;
Open_URI at 0 range 6 .. 6;
Open_Memory at 0 range 7 .. 7;
Open_Main_DB at 0 range 8 .. 8;
Open_Temp_DB at 0 range 9 .. 9;
Open_Transient_DB at 0 range 10 .. 10;
Open_Main_Journal at 0 range 11 .. 11;
Open_Temp_Journal at 0 range 12 .. 12;
Open_Sub_Journal at 0 range 13 .. 13;
Open_Super_Journal at 0 range 14 .. 14;
Open_NoMutex at 0 range 15 .. 15;
Open_FullMutex at 0 range 16 .. 16;
Open_SharedCache at 0 range 17 .. 17;
Open_PrivateCache at 0 range 18 .. 18;
Open_WAL at 0 range 19 .. 19;
Open_NoFollow at 0 range 20 .. 20;
Open_ExpresCode at 0 range 21 .. 21;
Reserved at 0 range 22 .. 31;
end record;
end Sqlite;