ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBTransaction.pas
(Generate patch)

Comparing ibx/trunk/fbintf/client/FBTransaction.pas (file contents):
Revision 401 by tony, Mon Jan 10 10:13:17 2022 UTC vs.
Revision 402 by tony, Mon Aug 1 10:07:24 2022 UTC

# Line 84 | Line 84 | type
84    protected
85      FTPB: ITPB;
86      FSeqNo: integer;
87 <    FDefaultCompletion: TTransactionAction;
87 >    FDefaultCompletion: TTransactionCompletion;
88      FAttachments: array of IAttachment; {Keep reference to attachment - ensures
89                                            attachment cannot be freed before transaction}
90 +    FTransactionName: AnsiString;
91 +    FForeignHandle: boolean;
92      procedure CheckHandle;
93      function GetActivityIntf(att: IAttachment): IActivityMonitor; virtual; abstract;
94 +    function GetJournalIntf(Attachment: IAttachment): IJournallingHook;
95      procedure SetInterface(api: TFBClientAPI); virtual;
96      function GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer): ITrInformation; virtual; abstract;
97 +    procedure InternalStartSingle(attachment: IAttachment); virtual; abstract;
98 +    procedure InternalStartMultiple; virtual; abstract;
99 +    function InternalCommit(Force: boolean): TTrCompletionState; virtual; abstract;
100 +    procedure InternalCommitRetaining; virtual; abstract;
101 +    function InternalRollback(Force: boolean): TTrCompletionState; virtual; abstract;
102 +    procedure InternalRollbackRetaining; virtual; abstract;
103    public
104 <    constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
105 <    constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
106 <    constructor Create(api: TFBClientAPI; Attachment: IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
107 <    constructor Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
104 >    constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction; aName: AnsiString); overload;
105 >    constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction; aName: AnsiString); overload;
106 >    constructor Create(api: TFBClientAPI; Attachment: IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction; aName: AnsiString); overload;
107 >    constructor Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction; aName: AnsiString); overload;
108      destructor Destroy; override;
109      procedure DoDefaultTransactionEnd(Force: boolean);
110      property FirebirdAPI: TFBClientAPI read FFirebirdAPI;
# Line 104 | Line 113 | type
113      {ITransaction}
114      function getTPB: ITPB;
115      procedure PrepareForCommit;virtual; abstract;
116 <    procedure Commit(Force: boolean=false);  virtual; abstract;
117 <    procedure CommitRetaining;  virtual; abstract;
116 >    function Commit(Force: boolean=false): TTrCompletionState;
117 >    procedure CommitRetaining;
118      function GetInTransaction: boolean; virtual; abstract;
119      function GetIsReadOnly: boolean;
120      function GetTransactionID: integer;
121      function GetAttachmentCount: integer;
122      function GetAttachment(index: integer): IAttachment;
123 <    procedure Rollback(Force: boolean=false);  virtual; abstract;
124 <    procedure RollbackRetaining;  virtual; abstract;
125 <    procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; virtual; abstract;
123 >    function GetJournalingActive(attachment: IAttachment): boolean;
124 >    function GetDefaultCompletion: TTransactionCompletion;
125 >    function Rollback(Force: boolean=false): TTrCompletionState;
126 >    procedure RollbackRetaining;
127 >    procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload;
128      procedure Start(TPB: ITPB; DefaultCompletion: TTransactionCompletion=taCommit); overload;
129      function GetTrInformation(Requests: array of byte): ITrInformation; overload;
130      function GetTrInformation(Request: byte): ITrInformation; overload;
131 +    function GetTransactionName: AnsiString;
132 +    procedure SetTransactionName(aValue: AnsiString);
133  
134      property InTransaction: boolean read GetInTransaction;
135      property TransactionSeqNo: integer read FSeqNo;
# Line 150 | Line 163 | type
163      {$ELSE}
164      function GetDPBParamTypeName(ParamType: byte): Ansistring;
165      {$ENDIF}
166 +    function AsText: AnsiString;
167   end;
168  
169    {$IFDEF FPC}
# Line 159 | Line 173 | end;
173  
174    TTrInfoItem = class(TOutputBlockItemGroup<TTrInfoItem,ITrInfoItem>,ITrInfoItem)
175    {$ELSE}
176 <    TTransInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,ITransInfoItem>,ITransInfoItem)
176 >    TTrInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,ITrInfoItem>,ITrInfoItem)
177    {$ENDIF}
178      public
179        procedure DecodeTraIsolation(var IsolationType, RecVersion: byte);
# Line 173 | Line 187 | end;
187    public
188      constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
189      {$IFNDEF FPC}
190 <    function Find(ItemType: byte): ITransInfoItem;
190 >    function Find(ItemType: byte): ITrInfoItem;
191      {$ENDIF}
192    end;
193  
194 +
195   implementation
196  
197   uses FBMessages;
# Line 227 | Line 242 | begin
242      IBError(ibxeNotInTransaction,[]);
243   end;
244  
245 + function TFBTransaction.GetJournalIntf(Attachment: IAttachment): IJournallingHook;
246 + begin
247 +  Attachment.QueryInterface(IJournallingHook,Result)
248 + end;
249 +
250   procedure TFBTransaction.SetInterface(api: TFBClientAPI);
251   begin
252    FFirebirdAPI := api;
253   end;
254  
255   constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment;
256 <  Params: array of byte; DefaultCompletion: TTransactionAction);
256 >  Params: array of byte; DefaultCompletion: TTransactionAction; aName: AnsiString);
257   begin
258 <  Create(api, Attachments,GenerateTPB(Params), DefaultCompletion);
258 >  Create(api, Attachments,GenerateTPB(Params), DefaultCompletion, aName);
259   end;
260  
261   constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB;
262 <  DefaultCompletion: TTransactionAction);
262 >  DefaultCompletion: TTransactionAction; aName: AnsiString);
263   var
264    i: Integer;
265   begin
266    inherited Create(nil);
267 +  FTransactionName := aName;
268    SetInterface(api);
269    if Length(Attachments) = 0 then
270      IBError(ibxeEmptyAttachmentsList,[nil]);
# Line 264 | Line 285 | begin
285   end;
286  
287   constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment;
288 <  Params: array of byte; DefaultCompletion: TTransactionAction);
288 >  Params: array of byte; DefaultCompletion: TTransactionAction; aName: AnsiString);
289   begin
290 <  Create(api,Attachment,GenerateTPB(Params),DefaultCompletion);
290 >  Create(api,Attachment,GenerateTPB(Params),DefaultCompletion,aName);
291   end;
292  
293   constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB;
294 <  DefaultCompletion: TTransactionAction);
294 >  DefaultCompletion: TTransactionAction; aName: AnsiString);
295   begin
296    inherited Create(nil);
297    SetInterface(api);
# Line 278 | Line 299 | begin
299    SetLength(FAttachments,1);
300    FAttachments[0] := Attachment;
301    FTPB := TPB;
302 +  FTransactionName := aName;
303    Start(DefaultCompletion);
304   end;
305  
# Line 292 | Line 314 | var i: integer;
314      intf: IUnknown;
315      user: ITransactionUser;
316   begin
317 <  if InTransaction then
317 >  if InTransaction and not FForeignHandle then
318    begin
319      for i := 0 to InterfaceCount - 1 do
320      begin
# Line 314 | Line 336 | begin
336    Result := FTPB;
337   end;
338  
339 + function TFBTransaction.Commit(Force: boolean): TTrCompletionState;
340 + var i: integer;
341 +    TransactionID: integer;
342 +    TransactionEndNeeded: array of boolean;
343 + begin
344 +  if not GetInTransaction then Exit;
345 +
346 +  if FForeignHandle then
347 +    IBError(ibxeTransactionNotOwned,[nil]);
348 +
349 +  SetLength(TransactionEndNeeded,Length(FAttachments));
350 +  TransactionID := GetTransactionID;
351 +  for i := 0 to Length(FAttachments) - 1 do
352 +    if (FAttachments[i] <> nil)  then
353 +      TransactionEndNeeded[i] := GetJournalingActive(FAttachments[i])
354 +    else
355 +      TransactionEndNeeded[i] := false;
356 +  Result := InternalCommit(Force);
357 +  for i := 0 to Length(FAttachments) - 1 do
358 +    if TransactionEndNeeded[i] then
359 +       GetJournalIntf(FAttachments[i]).TransactionEnd(TransactionID, Result);
360 + end;
361 +
362 + procedure TFBTransaction.CommitRetaining;
363 + var i: integer;
364 +    TransactionID: integer;
365 + begin
366 +  if not GetInTransaction then Exit;
367 +
368 +  TransactionID := GetTransactionID;
369 +  InternalCommitRetaining;
370 +  for i := 0 to Length(FAttachments) - 1 do
371 +    if (FAttachments[i] <> nil) and GetJournalingActive(FAttachments[i]) then
372 +       GetJournalIntf(FAttachments[i]).TransactionRetained(self,TransactionID, TACommitRetaining);
373 + end;
374 +
375   function TFBTransaction.GetIsReadOnly: boolean;
376   var Info: ITrInformation;
377   begin
# Line 346 | Line 404 | begin
404      IBError(ibxeAttachmentListIndexError,[index]);
405   end;
406  
407 + function TFBTransaction.GetJournalingActive(attachment: IAttachment): boolean;
408 + begin
409 +  Result := false;
410 +  if (attachment = nil) and (length(FAttachments) > 0) then
411 +    attachment := FAttachments[0];
412 +  if attachment <> nil then
413 +  with attachment do
414 +  Result := self.GetInTransaction and JournalingActive and
415 +     ((((joReadOnlyTransactions in GetJournalOptions) and self.GetIsReadOnly)) or
416 +     ((joReadWriteTransactions in GetJournalOptions) and not self.GetIsReadOnly));
417 + end;
418 +
419 + function TFBTransaction.GetDefaultCompletion: TTransactionCompletion;
420 + begin
421 +  Result := FDefaultCompletion;
422 + end;
423 +
424 + function TFBTransaction.Rollback(Force: boolean): TTrCompletionState;
425 + var i: integer;
426 +    TransactionID: integer;
427 +    TransactionEndNeeded: array of boolean;
428 + begin
429 +  if not GetInTransaction then Exit;
430 +
431 +  if FForeignHandle then
432 +    IBError(ibxeTransactionNotOwned,[nil]);
433 +
434 +  SetLength(TransactionEndNeeded,Length(FAttachments));
435 +  TransactionID := GetTransactionID;
436 +  for i := 0 to Length(FAttachments) - 1 do
437 +    if (FAttachments[i] <> nil)  then
438 +      TransactionEndNeeded[i] := GetJournalingActive(FAttachments[i])
439 +    else
440 +      TransactionEndNeeded[i] := false;
441 +  Result := InternalRollback(Force);
442 +  for i := 0 to Length(FAttachments) - 1 do
443 +    if TransactionEndNeeded[i] then
444 +       GetJournalIntf(FAttachments[i]).TransactionEnd(TransactionID, Result);
445 + end;
446 +
447 + procedure TFBTransaction.RollbackRetaining;
448 + var i: integer;
449 +    TransactionID: integer;
450 + begin
451 +  if not GetInTransaction then Exit;
452 +
453 +  TransactionID := GetTransactionID;
454 +  InternalRollbackRetaining;
455 +  for i := 0 to Length(FAttachments) - 1 do
456 +    if (FAttachments[i] <> nil) and GetJournalingActive(FAttachments[i]) then
457 +       GetJournalIntf(FAttachments[i]).TransactionRetained(self,TransactionID,TARollbackRetaining);
458 + end;
459 +
460 + procedure TFBTransaction.Start(DefaultCompletion: TTransactionCompletion);
461 + var i: integer;
462 + begin
463 +  if GetInTransaction then
464 +    Exit;
465 +
466 +  FDefaultCompletion := DefaultCompletion;
467 +
468 +  if Length(FAttachments) = 1 then
469 +    InternalStartSingle(FAttachments[0])
470 +  else
471 +    InternalStartMultiple;
472 +  for i := 0 to Length(FAttachments) - 1 do
473 +    if (FAttachments[i] <> nil) and GetJournalingActive(FAttachments[i]) then
474 +      GetJournalIntf(FAttachments[i]).TransactionStart(self);
475 +  Inc(FSeqNo);
476 + end;
477 +
478   procedure TFBTransaction.Start(TPB: ITPB; DefaultCompletion: TTransactionCompletion
479    );
480   begin
# Line 382 | Line 511 | begin
511    Result := GetTrInfo(@Request,1);
512   end;
513  
514 + function TFBTransaction.GetTransactionName: AnsiString;
515 + begin
516 +  Result := FTransactionName;
517 + end;
518 +
519 + procedure TFBTransaction.SetTransactionName(aValue: AnsiString);
520 + begin
521 +  FTransactionName := aValue;
522 + end;
523 +
524   { TTPBItem }
525  
526   function TTPBItem.getParamTypeName: AnsiString;
# Line 402 | Line 541 | end;
541   function TTPB.GetParamTypeName(ParamType: byte): Ansistring;
542   begin
543    if ParamType <= isc_tpb_last_tpb_constant then
544 <    Result := TPBConstantNames[ParamType]
544 >    Result := TPBPrefix + TPBConstantNames[ParamType]
545    else
546      Result := '';
547   end;
548  
549 + function TTPB.AsText: AnsiString;
550 + var i: integer;
551 + begin
552 +  Result := '[';
553 +  for i := 0 to getCount - 1 do
554 +  begin
555 +    Result := Result + GetParamTypeName(getItems(i).getParamType);
556 +    if i < getCount - 1 then
557 +      Result := Result + ',';
558 +  end;
559 +  Result := Result + ']';
560 + end;
561 +
562   {$IFNDEF FPC}
563   function TTPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
564   begin
# Line 505 | Line 657 | begin
657    FIntegerType := dtInteger;
658   end;
659  
660 + {$IFNDEF FPC}
661 + function TTrInformation.Find(ItemType: byte): ITrInfoItem;
662 + begin
663 +  Result := inherited Find(ItemType);
664 +  if Result.GetSize = 0 then
665 +    Result := nil;
666 + end;
667 + {$ENDIF}
668 +
669   end.
670  

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines