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

* fcl-db: TSQLScript: support explicit COMMIT/COMMIT WORK and COMMIT RETAIN script commands (with UseCommit) to use commit, respectively commit retaining.

Browse Source 
git-svn-id: trunk@26120 -
This commit is contained in:
reiniero 2013-11-23 17:32:36 +00:00
parent 951727f453
commit 494d79bd7e
2 changed files with 32 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
packages/fcl-db/src/base/sqlscript.pp
View File

@ -63,12 +63,14 @@ type
function Available: Boolean; function Available: Boolean;
procedure InternalStatement (Statement: TStrings; var StopExecution: Boolean); procedure InternalStatement (Statement: TStrings; var StopExecution: Boolean);
procedure InternalDirective (Directive, Argument: String; var StopExecution: Boolean); procedure InternalDirective (Directive, Argument: String; var StopExecution: Boolean);
procedure InternalCommit; // Runs commit. If ComitRetaining, use CommitRetraining if possible, else stop/starttransaction
procedure InternalCommit(CommitRetaining: boolean=true);
protected protected
procedure DefaultDirectives; virtual; procedure DefaultDirectives; virtual;
procedure ExecuteStatement (Statement: TStrings; var StopExecution: Boolean); virtual; abstract; procedure ExecuteStatement (Statement: TStrings; var StopExecution: Boolean); virtual; abstract;
procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); virtual; abstract; procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); virtual; abstract;
procedure ExecuteCommit; virtual; abstract; // Executes commit. If possible and CommitRetaining, use CommitRetaining, else
procedure ExecuteCommit(CommitRetaining: boolean=true); virtual; abstract;
public public
constructor Create (AnOwner: TComponent); override; constructor Create (AnOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@ -100,7 +102,7 @@ type
protected protected
procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override; procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override;
procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override; procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override;
procedure ExecuteCommit; override; procedure ExecuteCommit(CommitRetaining: boolean=true); override;
public public
procedure Execute; override; procedure Execute; override;
property Aborted; property Aborted;
@ -344,7 +346,7 @@ begin
end; end;
end; end;
procedure TCustomSQLScript.InternalCommit; procedure TCustomSQLScript.InternalCommit(CommitRetaining: boolean=true);
var var
cont : boolean; cont : boolean;
@ -352,7 +354,7 @@ var
begin begin
try try
ExecuteCommit; ExecuteCommit(CommitRetaining);
except except
on E : Exception do on E : Exception do
begin begin
@ -404,9 +406,16 @@ begin
else If Not FIsSkipping then else If Not FIsSkipping then
begin begin
// If AutoCommit, skip any explicit commits. // If AutoCommit, skip any explicit commits.
if FUseCommit and (Directive = 'COMMIT') and not FAutoCommit then if FUseCommit
InternalCommit and ((Directive = 'COMMIT') or (Directive = 'COMMIT WORK' {SQL standard}))
else if FUseSetTerm and (Directive = 'SET TERM') then and not FAutoCommit then
InternalCommit(false) //explicit commit, no commit retaining
else if FUseCommit
and (Directive = 'COMMIT RETAIN') {at least Firebird syntax}
and not FAutoCommit then
InternalCommit(true)
else if FUseSetTerm
and (Directive = 'SET TERM' {Firebird/Interbase only}) then
FTerminator:=S FTerminator:=S
else else
InternalDirective (Directive,S,FAborted) InternalDirective (Directive,S,FAborted)
@ -543,7 +552,11 @@ begin
if FUseSetTerm then if FUseSetTerm then
Add('SET TERM'); Add('SET TERM');
if FUseCommit then if FUseCommit then
Add('COMMIT'); begin
Add('COMMIT'); {Shorthand used in many dbs, e.g. Firebird}
Add('COMMIT RETAIN'); {Firebird/Interbase; probably won't hurt on other dbs}
Add('COMMIT WORK'); {SQL Standard, equivalent to commit}
end;
if FUseDefines then if FUseDefines then
begin begin
Add('#IFDEF'); Add('#IFDEF');
@ -650,7 +663,7 @@ begin
FOnDirective (Self, Directive, Argument, StopExecution); FOnDirective (Self, Directive, Argument, StopExecution);
end; end;
procedure TEventSQLScript.ExecuteCommit; procedure TEventSQLScript.ExecuteCommit(CommitRetaining: boolean=true);
begin begin
if assigned (FOnCommit) then if assigned (FOnCommit) then
FOnCommit (Self); FOnCommit (Self);

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

@ -500,7 +500,7 @@ type
protected protected
procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override; procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override;
procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override; procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override;
procedure ExecuteCommit; override; procedure ExecuteCommit(CommitRetaining: boolean=true); override;
Procedure SetDatabase (Value : TDatabase); virtual; Procedure SetDatabase (Value : TDatabase); virtual;
Procedure SetTransaction(Value : TDBTransaction); virtual; Procedure SetTransaction(Value : TDBTransaction); virtual;
Procedure CheckDatabase; Procedure CheckDatabase;
@ -2389,10 +2389,16 @@ begin
FOnDirective (Self, Directive, Argument, StopExecution); FOnDirective (Self, Directive, Argument, StopExecution);
end; end;
procedure TSQLScript.ExecuteCommit; procedure TSQLScript.ExecuteCommit(CommitRetaining: boolean=true);
begin begin
if FTransaction is TSQLTransaction then if FTransaction is TSQLTransaction then
TSQLTransaction(FTransaction).CommitRetaining if CommitRetaining then
TSQLTransaction(FTransaction).CommitRetaining
else
begin
TSQLTransaction(FTransaction).Commit;
TSQLTransaction(FTransaction).StartTransaction;
end
else else
begin begin
FTransaction.Active := false; FTransaction.Active := false;