paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 08:29:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Indicate and use sqSequences connection info, fix bug #0035241 (statement for sqlite next sequence value)

Browse Source 
git-svn-id: trunk@43655 -
This commit is contained in:
michael 2019-12-06 09:57:10 +00:00
parent feb1dacd33
commit 147a766890
8 changed files with 86 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-db/src/sqldb/interbase/ibconnection.pp
View File

@ -189,7 +189,7 @@ constructor TIBConnection.Create(AOwner : TComponent);
begin
inherited;
FConnOptions := FConnOptions + [sqSupportParams, sqEscapeRepeat, sqSupportReturning];
FConnOptions := FConnOptions + [sqSupportParams, sqEscapeRepeat, sqSupportReturning, sqSequences];
FBlobSegmentSize := 65535; //Shows we're using the maximum segment size
FDialect := INVALID_DATA;
FWireCompression := False;

2
packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
View File

@ -317,7 +317,7 @@ end;
constructor TMSSQLConnection.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FConnOptions := [sqSupportEmptyDatabaseName, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID];
FConnOptions := [sqSupportEmptyDatabaseName, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSequences];
//FieldNameQuoteChars:=DoubleQuotes; //default
Ftds := DBTDS_UNKNOWN;
end;

2
packages/fcl-db/src/sqldb/oracle/oracleconnection.pp
View File

@ -1263,7 +1263,7 @@ end;
constructor TOracleConnection.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FConnOptions := FConnOptions + [sqEscapeRepeat];
FConnOptions := FConnOptions + [sqEscapeRepeat,sqSequences];
FOciEnvironment := nil;
FOciError := nil;
FOciServer := nil;

2
packages/fcl-db/src/sqldb/postgres/pqconnection.pp
View File

@ -276,7 +276,7 @@ constructor TPQConnection.Create(AOwner : TComponent);
begin
inherited;
FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction,sqSupportReturning];
FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction,sqSupportReturning,sqSequences];
FieldNameQuoteChars:=DoubleQuotes;
VerboseErrors:=True;
FConnectionPool:=TThreadlist.Create;

2
packages/fcl-db/src/sqldb/sqldb.pp
View File

@ -174,7 +174,7 @@ type
TDBLogNotifyEvent = Procedure (Sender : TSQLConnection; EventType : TDBEventType; Const Msg : String) of object;
TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning);
TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning,sqSequences);
TConnOptions= set of TConnOption;
TSQLConnectionOption = (scoExplicitConnect, scoApplyUpdatesChecksRowsAffected);

16
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
View File

@ -107,6 +107,7 @@ Type
procedure checkerror(const aerror: integer);
function stringsquery(const asql: string): TArrayStringArray;
procedure execsql(const asql: string);
function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; override;
public
constructor Create(AOwner : TComponent); override;
procedure GetFieldNames(const TableName : string; List : TStrings); override;
@ -296,7 +297,7 @@ end;
constructor TSQLite3Connection.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FConnOptions := [sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction, sqLastInsertID];
FConnOptions := [sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction, sqLastInsertID, sqSequences];
FieldNameQuoteChars:=DoubleQuotes;
FOpenFlags:=DefaultOpenFlags;
end;
@ -893,6 +894,11 @@ begin
databaseerror(str1);
end;
function TSQLite3Connection.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
begin
Result:=Format('SELECT seq+%d FROM sqlite_sequence WHERE (name=''%s'')',[IncrementBy,SequenceName]);
end;
function execcallback(adata: pointer; ncols: longint; //adata = PStringArray
avalues: PPchar; anames: PPchar):longint; cdecl;
var
@ -939,6 +945,14 @@ begin
stTables : result := 'select name as table_name from sqlite_master where type = ''table'' order by 1';
stSysTables : result := 'select ''sqlite_master'' as table_name';
stColumns : result := 'pragma table_info(''' + (SchemaObjectName) + ''')';
stSequences : Result := 'SELECT 1 as recno, '+
'''' + DatabaseName + ''' as sequence_catalog,' +
''''' as sequence_schema,' +
'name as sequence_name ' +
'FROM ' +
'sqlite_sequence ' +
'ORDER BY ' +
'name';
else
DatabaseError(SMetadataUnavailable)
end; {case}

49
packages/fcl-db/tests/sqldbtoolsunit.pas
View File

@ -56,6 +56,8 @@ type
Function InternalGetFieldDataset : TDataSet; override;
public
procedure TryDropIfExist(ATableName : String);
procedure TryCreateSequence(ASequenceName : String);
procedure TryDropSequence(ASequenceName: String);
destructor Destroy; override;
constructor Create; override;
procedure ExecuteDirect(const SQL: string);
@ -684,6 +686,53 @@ begin
end;
end;
procedure TSQLDBConnector.TryDropSequence(ASequenceName: String);
var
NoSeq : Boolean;
begin
NoSeq:=False;
try
case SQLServerType of
ssInterbase,
ssFirebird: FConnection.ExecuteDirect('DROP GENERATOR '+ASequenceName);
ssOracle,
ssPostgreSQL,
ssSybase,
ssMSSQL : FConnection.ExecuteDirect('DROP SEQUENCE '+ASequenceName+' START WITH 1 INCREMENT BY 1');
ssSQLite : FConnection.ExecuteDirect('delete from sqlite_sequence where (name='''+ASequenceName+''')');
else
NoSeq:=True;
end;
except
FTransaction.RollbackRetaining;
end;
if NoSeq then
Raise EDatabaseError.Create('Engine does not support sequences');
end;
procedure TSQLDBConnector.TryCreateSequence(ASequenceName: String);
var
NoSeq : Boolean;
begin
NoSeq:=False;
case SQLServerType of
ssInterbase,
ssFirebird: FConnection.ExecuteDirect('CREATE GENERATOR '+ASequenceName);
ssOracle,
ssPostgreSQL,
ssSybase,
ssMSSQL : FConnection.ExecuteDirect('CREATE SEQUENCE '+ASequenceName+' START WITH 1 INCREMENT BY 1');
ssSQLite : FConnection.ExecuteDirect('insert into sqlite_sequence (name,seq) values ('''+ASequenceName+''',1)');
else
Raise EDatabaseError.Create('Engine does not support sequences');
end;
end;
procedure TSQLDBConnector.ExecuteDirect(const SQL: string);
begin
Connection.ExecuteDirect(SQL);

17
packages/fcl-db/tests/testsqldb.pas
View File

@ -77,6 +77,7 @@ type
procedure TestUseExplicitTransaction;
procedure TestExplicitConnect;
procedure TestGetStatementInfo;
procedure TestGetNextValue;
end;
{ TTestTSQLScript }
@ -945,6 +946,22 @@ begin
AssertEquals('Updateable', False, StmtInfo.Updateable);
end;
procedure TTestTSQLConnection.TestGetNextValue;
begin
if not (sqSequences in SQLDBConnector.Connection.ConnOptions) then
Ignore('Connector '+SQLDBConnector.Connection.ClassName+' does not support sequences');
if SQLServerType=ssSQLite then
begin
SQLDBConnector.TryDropIfExist('me');
SQLDBConnector.ExecuteDirect('create table me (a integer primary key autoincrement,b int)');
SQLDBConnector.ExecuteDirect('insert into me (b) values (1)');// Will create table sqlite_sequence if it didn't exist yet
SQLDBConnector.ExecuteDirect('drop table me');
end;
SQLDBConnector.TryDropSequence('me');
SQLDBConnector.TryCreateSequence('me');
AssertTrue('Get value',SQLDBConnector.Connection.GetNextValue('me',1)>0);
end;
{ TTestTSQLScript }