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

* postgres part of sqldb returning support, fixes Mantis #20133

Browse Source 
Patch by Lacak2

git-svn-id: trunk@19008 -
This commit is contained in:
marco 2011-09-07 12:21:52 +00:00
parent 3401a3be83
commit b1c0d35dbe
2 changed files with 19 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -24,10 +24,10 @@ type
TPQCursor = Class(TSQLCursor)
protected
Statement : string;
StmtName : string;
tr : TPQTrans;
res : PPGresult;
CurTuple : integer;
Nr : string;
FieldBinding : array of integer;
end;
@ -516,16 +516,16 @@ begin
with (cursor as TPQCursor) do
begin
FPrepared := False;
nr := inttostr(FCursorcount);
inc(FCursorCount);
// Prior to v8 there is no support for cursors and parameters.
// So that's not supported.
if FStatementType in [stInsert,stUpdate,stDelete, stSelect] then
begin
StmtName := 'prepst'+inttostr(FCursorCount);
inc(FCursorCount);
tr := TPQTrans(aTransaction.Handle);
// Only available for pq 8.0, so don't use it...
// Res := pqprepare(tr,'prepst'+name+nr,pchar(buf),params.Count,pchar(''));
s := 'prepare prepst'+nr+' ';
s := 'prepare '+StmtName+' ';
if Assigned(AParams) and (AParams.count > 0) then
begin
s := s + '(';
@ -548,6 +548,15 @@ begin
pqclear(res);
DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
end;
// if statement is INSERT, UPDATE, DELETE with RETURNING clause, then
// override the statement type derrived by parsing the query.
if (FStatementType in [stInsert,stUpdate,stDelete]) and (pos('RETURNING', upcase(s)) > 0) then
begin
PQclear(res);
res := PQdescribePrepared(tr.PGConn,pchar(StmtName));
if (PQresultStatus(res) = PGRES_COMMAND_OK) and (PQnfields(res) > 0) then
FStatementType := stSelect;
end;
FPrepared := True;
end
else
@ -563,7 +572,7 @@ begin
if not tr.ErrorOccured then
begin
PQclear(res);
res := pqexec(tr.PGConn,pchar('deallocate prepst'+nr));
res := pqexec(tr.PGConn,pchar('deallocate '+StmtName));
if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
begin
pqclear(res);
@ -630,12 +639,12 @@ begin
end
else
FreeAndNil(ar[i]);
res := PQexecPrepared(tr.PGConn,pchar('prepst'+nr),Aparams.count,@Ar[0],@Lengths[0],@Formats[0],1);
res := PQexecPrepared(tr.PGConn,pchar(StmtName),Aparams.count,@Ar[0],@Lengths[0],@Formats[0],1);
for i := 0 to AParams.count -1 do
FreeMem(ar[i]);
end
else
res := PQexecPrepared(tr.PGConn,pchar('prepst'+nr),0,nil,nil,nil,1);
res := PQexecPrepared(tr.PGConn,pchar(StmtName),0,nil,nil,nil,1);
end
else
begin

6
packages/fcl-db/tests/testfieldtypes.pas
View File

@ -1171,15 +1171,15 @@ end;
procedure TTestFieldTypes.TestInsertReturningQuery;
begin
if (SQLDbType <> interbase) then Ignore('This test does only apply to Firebird.');
if not(SQLDbType in [postgresql,interbase,oracle]) then Ignore('This test does not apply to this db-engine');
with TSQLDBConnector(DBConnector) do
begin
// This only works with databases that supports 'insert into .. returning'
// for example, Firebird version 2.0 and up
// for example: PostgreSQL, Oracle, Firebird version 2.0 and up
CreateTableWithFieldType(ftInteger,'int');
Query.SQL.Text:='insert into FPDEV2 values(154) returning FT';
Query.Open;
AssertEquals('FT',Query.fields[0].FieldName);
AssertTrue(CompareText('FT',Query.Fields[0].FieldName)=0);
AssertEquals(154,Query.fields[0].AsInteger);
Query.Close;
end;