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

Comparing:
ibx/trunk/fbintf/client/FBTransaction.pas (file contents), Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC vs.
ibx/branches/journaling/fbintf/client/FBTransaction.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 2021 UTC

# Line 72 | Line 72 | unit FBTransaction;
72   interface
73  
74   uses
75 <  Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor, FBClientAPI;
75 >  Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor, FBClientAPI, FBOutputBlock;
76  
77   type
78    { TFBTransaction }
# 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 +    procedure CheckHandle;
92      function GetActivityIntf(att: IAttachment): IActivityMonitor; virtual; abstract;
93 +    function GetJournalIntf(Attachment: IAttachment): IJournallingHook;
94      procedure SetInterface(api: TFBClientAPI); virtual;
95 +    function GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer): ITrInformation; virtual; abstract;
96 +    procedure InternalStartSingle(attachment: IAttachment); virtual; abstract;
97 +    procedure InternalStartMultiple; virtual; abstract;
98 +    procedure InternalCommit(Force: boolean); virtual; abstract;
99 +    procedure InternalCommitRetaining; virtual; abstract;
100 +    procedure InternalRollback(Force: boolean); virtual; abstract;
101 +    procedure InternalRollbackRetaining; virtual; abstract;
102    public
103 <    constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
104 <    constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
105 <    constructor Create(api: TFBClientAPI; Attachment: IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
106 <    constructor Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
103 >    constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction; aName: AnsiString); overload;
104 >    constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction; aName: AnsiString); overload;
105 >    constructor Create(api: TFBClientAPI; Attachment: IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction; aName: AnsiString); overload;
106 >    constructor Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction; aName: AnsiString); overload;
107      destructor Destroy; override;
108      procedure DoDefaultTransactionEnd(Force: boolean);
109      property FirebirdAPI: TFBClientAPI read FFirebirdAPI;
# Line 102 | Line 112 | type
112      {ITransaction}
113      function getTPB: ITPB;
114      procedure PrepareForCommit;virtual; abstract;
115 <    procedure Commit(Force: boolean=false);  virtual; abstract;
116 <    procedure CommitRetaining;  virtual; abstract;
115 >    procedure Commit(Force: boolean=false);
116 >    procedure CommitRetaining;
117      function GetInTransaction: boolean; virtual; abstract;
118 +    function GetIsReadOnly: boolean;
119 +    function GetTransactionID: integer;
120      function GetAttachmentCount: integer;
121      function GetAttachment(index: integer): IAttachment;
122 <    procedure Rollback(Force: boolean=false);  virtual; abstract;
123 <    procedure RollbackRetaining;  virtual; abstract;
124 <    procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; virtual; abstract;
122 >    function GetJournalingActive(attachment: IAttachment): boolean;
123 >    function GetDefaultCompletion: TTransactionCompletion;
124 >    procedure Rollback(Force: boolean=false);
125 >    procedure RollbackRetaining;
126 >    procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload;
127      procedure Start(TPB: ITPB; DefaultCompletion: TTransactionCompletion=taCommit); overload;
128 +    function GetTrInformation(Requests: array of byte): ITrInformation; overload;
129 +    function GetTrInformation(Request: byte): ITrInformation; overload;
130 +    function GetTransactionName: AnsiString;
131 +    procedure SetTransactionName(aValue: AnsiString);
132  
133      property InTransaction: boolean read GetInTransaction;
134      property TransactionSeqNo: integer read FSeqNo;
# Line 138 | Line 156 | type
156      function LookupItemType(ParamTypeName: AnsiString): byte; override;
157    public
158      constructor Create(api: TFBClientAPI);
159 +    function GetParamTypeName(ParamType: byte): Ansistring;
160 +    {$IFDEF FPC}
161 +    function ITPB.GetDPBParamTypeName = GetParamTypeName;
162 +    {$ELSE}
163      function GetDPBParamTypeName(ParamType: byte): Ansistring;
164 +    {$ENDIF}
165 +    function AsText: AnsiString;
166 + end;
167 +
168 +  {$IFDEF FPC}
169 +  TTrInfoItem = class;
170 +
171 +  { TTrInfoItem }
172 +
173 +  TTrInfoItem = class(TOutputBlockItemGroup<TTrInfoItem,ITrInfoItem>,ITrInfoItem)
174 +  {$ELSE}
175 +    TTrInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,ITrInfoItem>,ITrInfoItem)
176 +  {$ENDIF}
177 +    public
178 +      procedure DecodeTraIsolation(var IsolationType, RecVersion: byte);
179 +  end;
180 +
181 +  { TTrInformation }
182 +
183 +  TTrInformation = class(TCustomOutputBlock<TTrInfoItem,ITrInfoItem>, ITrInformation)
184 +  protected
185 +    procedure DoParseBuffer; override;
186 +  public
187 +    constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
188 +    {$IFNDEF FPC}
189 +    function Find(ItemType: byte): ITrInfoItem;
190 +    {$ENDIF}
191    end;
192  
193 +
194   implementation
195  
196   uses FBMessages;
# Line 185 | Line 235 | begin
235      Result.Add(sl[i]);
236   end;
237  
238 + procedure TFBTransaction.CheckHandle;
239 + begin
240 +  if not InTransaction then
241 +    IBError(ibxeNotInTransaction,[]);
242 + end;
243 +
244 + function TFBTransaction.GetJournalIntf(Attachment: IAttachment): IJournallingHook;
245 + begin
246 +  Attachment.QueryInterface(IJournallingHook,Result)
247 + end;
248 +
249   procedure TFBTransaction.SetInterface(api: TFBClientAPI);
250   begin
251    FFirebirdAPI := api;
252   end;
253  
254   constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment;
255 <  Params: array of byte; DefaultCompletion: TTransactionAction);
255 >  Params: array of byte; DefaultCompletion: TTransactionAction; aName: AnsiString);
256   begin
257 <  Create(api, Attachments,GenerateTPB(Params), DefaultCompletion);
257 >  Create(api, Attachments,GenerateTPB(Params), DefaultCompletion, aName);
258   end;
259  
260   constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB;
261 <  DefaultCompletion: TTransactionAction);
261 >  DefaultCompletion: TTransactionAction; aName: AnsiString);
262   var
263    i: Integer;
264   begin
265    inherited Create(nil);
266 +  FTransactionName := aName;
267    SetInterface(api);
268    if Length(Attachments) = 0 then
269      IBError(ibxeEmptyAttachmentsList,[nil]);
# Line 222 | Line 284 | begin
284   end;
285  
286   constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment;
287 <  Params: array of byte; DefaultCompletion: TTransactionAction);
287 >  Params: array of byte; DefaultCompletion: TTransactionAction; aName: AnsiString);
288   begin
289 <  Create(api,Attachment,GenerateTPB(Params),DefaultCompletion);
289 >  Create(api,Attachment,GenerateTPB(Params),DefaultCompletion,aName);
290   end;
291  
292   constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB;
293 <  DefaultCompletion: TTransactionAction);
293 >  DefaultCompletion: TTransactionAction; aName: AnsiString);
294   begin
295    inherited Create(nil);
296    SetInterface(api);
# Line 236 | Line 298 | begin
298    SetLength(FAttachments,1);
299    FAttachments[0] := Attachment;
300    FTPB := TPB;
301 +  FTransactionName := aName;
302    Start(DefaultCompletion);
303   end;
304  
# Line 272 | Line 335 | begin
335    Result := FTPB;
336   end;
337  
338 + procedure TFBTransaction.Commit(Force: boolean);
339 + var i: integer;
340 +    TransactionID: integer;
341 +    TransactionEndNeeded: array of boolean;
342 + begin
343 +  if not GetInTransaction then Exit;
344 +
345 +  SetLength(TransactionEndNeeded,Length(FAttachments));
346 +  TransactionID := GetTransactionID;
347 +  for i := 0 to Length(FAttachments) - 1 do
348 +    if (FAttachments[i] <> nil)  then
349 +      TransactionEndNeeded[i] := GetJournalingActive(FAttachments[i])
350 +    else
351 +      TransactionEndNeeded[i] := false;
352 +  InternalCommit(Force);
353 +  for i := 0 to Length(FAttachments) - 1 do
354 +    if TransactionEndNeeded[i] then
355 +       GetJournalIntf(FAttachments[i]).TransactionEnd(TransactionID, TACommit);
356 + end;
357 +
358 + procedure TFBTransaction.CommitRetaining;
359 + var i: integer;
360 +    TransactionID: integer;
361 + begin
362 +  if not GetInTransaction then Exit;
363 +
364 +  TransactionID := GetTransactionID;
365 +  InternalCommitRetaining;
366 +  for i := 0 to Length(FAttachments) - 1 do
367 +    if (FAttachments[i] <> nil) and GetJournalingActive(FAttachments[i]) then
368 +       GetJournalIntf(FAttachments[i]).TransactionRetained(self,TransactionID, TACommitRetaining);
369 + end;
370 +
371 + function TFBTransaction.GetIsReadOnly: boolean;
372 + var Info: ITrInformation;
373 + begin
374 +  Info := GetTrInformation(isc_info_tra_access);
375 +  if (Info.Count > 0) and (Info[0].getItemType = isc_info_tra_access) then
376 +    Result := Info[0].getAsInteger = isc_info_tra_readonly
377 +  else
378 +    Result := false;
379 + end;
380 +
381 + function TFBTransaction.GetTransactionID: integer;
382 + var Info: ITrInformation;
383 + begin
384 +  Result := -1;
385 +  Info := GetTrInformation(isc_info_tra_id);
386 +  if (Info.Count > 0) and (Info[0].getItemType = isc_info_tra_id) then
387 +    Result := Info[0].getAsInteger;
388 + end;
389 +
390   function TFBTransaction.GetAttachmentCount: integer;
391   begin
392    Result := Length(FAttachments);
# Line 285 | Line 400 | begin
400      IBError(ibxeAttachmentListIndexError,[index]);
401   end;
402  
403 + function TFBTransaction.GetJournalingActive(attachment: IAttachment): boolean;
404 + begin
405 +  Result := false;
406 +  if (attachment = nil) and (length(FAttachments) > 0) then
407 +    attachment := FAttachments[0];
408 +  if attachment <> nil then
409 +  with attachment do
410 +  Result := self.GetInTransaction and JournalingActive and
411 +     ((((joReadOnlyTransactions in GetJournalOptions) and self.GetIsReadOnly)) or
412 +     ((joReadWriteTransactions in GetJournalOptions) and not self.GetIsReadOnly));
413 + end;
414 +
415 + function TFBTransaction.GetDefaultCompletion: TTransactionCompletion;
416 + begin
417 +  Result := FDefaultCompletion;
418 + end;
419 +
420 + procedure TFBTransaction.Rollback(Force: boolean);
421 + var i: integer;
422 +    TransactionID: integer;
423 +    TransactionEndNeeded: array of boolean;
424 + begin
425 +  if not GetInTransaction then Exit;
426 +
427 +  SetLength(TransactionEndNeeded,Length(FAttachments));
428 +  TransactionID := GetTransactionID;
429 +  for i := 0 to Length(FAttachments) - 1 do
430 +    if (FAttachments[i] <> nil)  then
431 +      TransactionEndNeeded[i] := GetJournalingActive(FAttachments[i])
432 +    else
433 +      TransactionEndNeeded[i] := false;
434 +  InternalRollback(Force);
435 +  for i := 0 to Length(FAttachments) - 1 do
436 +    if TransactionEndNeeded[i] then
437 +       GetJournalIntf(FAttachments[i]).TransactionEnd(TransactionID, TARollback);
438 + end;
439 +
440 + procedure TFBTransaction.RollbackRetaining;
441 + var i: integer;
442 +    TransactionID: integer;
443 + begin
444 +  if not GetInTransaction then Exit;
445 +
446 +  TransactionID := GetTransactionID;
447 +  InternalRollbackRetaining;
448 +  for i := 0 to Length(FAttachments) - 1 do
449 +    if (FAttachments[i] <> nil) and GetJournalingActive(FAttachments[i]) then
450 +       GetJournalIntf(FAttachments[i]).TransactionRetained(self,TransactionID,TARollbackRetaining);
451 + end;
452 +
453 + procedure TFBTransaction.Start(DefaultCompletion: TTransactionCompletion);
454 + var i: integer;
455 + begin
456 +  if GetInTransaction then
457 +    Exit;
458 +
459 +  FDefaultCompletion := DefaultCompletion;
460 +
461 +  if Length(FAttachments) = 1 then
462 +    InternalStartSingle(FAttachments[0])
463 +  else
464 +    InternalStartMultiple;
465 +  for i := 0 to Length(FAttachments) - 1 do
466 +    if (FAttachments[i] <> nil) and GetJournalingActive(FAttachments[i]) then
467 +      GetJournalIntf(FAttachments[i]).TransactionStart(self);
468 +  Inc(FSeqNo);
469 + end;
470 +
471   procedure TFBTransaction.Start(TPB: ITPB; DefaultCompletion: TTransactionCompletion
472    );
473   begin
# Line 292 | Line 475 | begin
475    Start(DefaultCompletion);
476   end;
477  
478 + function TFBTransaction.GetTrInformation(Requests: array of byte
479 +  ): ITrInformation;
480 + var ReqBuffer: PByte;
481 +    i: integer;
482 + begin
483 +  CheckHandle;
484 +  if Length(Requests) = 1 then
485 +    Result := GetTrInformation(Requests[0])
486 +  else
487 +  begin
488 +    GetMem(ReqBuffer,Length(Requests));
489 +    try
490 +      for i := 0 to Length(Requests) - 1 do
491 +        ReqBuffer[i] := Requests[i];
492 +
493 +      Result := GetTrInfo(ReqBuffer,Length(Requests));
494 +
495 +    finally
496 +      FreeMem(ReqBuffer);
497 +    end;
498 +  end;
499 + end;
500 +
501 + function TFBTransaction.GetTrInformation(Request: byte): ITrInformation;
502 + begin
503 +  CheckHandle;
504 +  Result := GetTrInfo(@Request,1);
505 + end;
506 +
507 + function TFBTransaction.GetTransactionName: AnsiString;
508 + begin
509 +  Result := FTransactionName;
510 + end;
511 +
512 + procedure TFBTransaction.SetTransactionName(aValue: AnsiString);
513 + begin
514 +  FTransactionName := aValue;
515 + end;
516 +
517   { TTPBItem }
518  
519   function TTPBItem.getParamTypeName: AnsiString;
# Line 309 | Line 531 | begin
531    FBuffer^ := isc_tpb_version3;
532   end;
533  
534 < function TTPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
534 > function TTPB.GetParamTypeName(ParamType: byte): Ansistring;
535   begin
536    if ParamType <= isc_tpb_last_tpb_constant then
537 <    Result := TPBConstantNames[ParamType]
537 >    Result := TPBPrefix + TPBConstantNames[ParamType]
538    else
539      Result := '';
540   end;
541  
542 + function TTPB.AsText: AnsiString;
543 + var i: integer;
544 + begin
545 +  Result := '[';
546 +  for i := 0 to getCount - 1 do
547 +  begin
548 +    Result := Result + GetParamTypeName(getItems(i).getParamType);
549 +    if i < getCount - 1 then
550 +      Result := Result + ',';
551 +  end;
552 +  Result := Result + ']';
553 + end;
554 +
555 + {$IFNDEF FPC}
556 + function TTPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
557 + begin
558 +  Result := GetParamTypeName(ParamType);
559 + end;
560 + {$ENDIF}
561 +
562 +
563   function TTPB.LookupItemType(ParamTypeName: AnsiString): byte;
564   var i: byte;
565   begin
# Line 333 | Line 576 | begin
576      end;
577   end;
578  
579 + { TTrInfoItem }
580 +
581 + procedure TTrInfoItem.DecodeTraIsolation(var IsolationType, RecVersion: byte);
582 + begin
583 +  with FFirebirdClientAPI, ItemData^ do
584 +  if getItemType = isc_info_tra_isolation then
585 +  begin
586 +    if FDataLength = 1 then
587 +    begin
588 +      IsolationType := getAsInteger;
589 +      RecVersion := 0;
590 +    end
591 +    else
592 +    begin
593 +      IsolationType := (FBufPtr + 3)^;
594 +      RecVersion := (FBufPtr + 4)^;
595 +    end
596 +  end
597 +  else
598 +    IBError(ibxeInfoBufferTypeError,[integer(FBufPtr^)]);
599 + end;
600 +
601 + { TTrInformation }
602 +
603 + procedure TTrInformation.DoParseBuffer;
604 + var P: PByte;
605 +    index: integer;
606 + begin
607 +  P := Buffer;
608 +  index := 0;
609 +  SetLength(FItems,0);
610 +  while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
611 +  begin
612 +    SetLength(FItems,index+1);
613 +    case byte(P^) of
614 +    isc_info_tra_id,
615 +    isc_info_tra_oldest_interesting,
616 +    isc_info_tra_oldest_active,
617 +    isc_info_tra_oldest_snapshot,
618 +    fb_info_tra_snapshot_number,
619 +    isc_info_tra_lock_timeout:
620 +      FItems[index] := AddIntegerItem(P);
621 +
622 +    isc_info_tra_isolation,
623 +      {return transaction isolation mode of current transaction.
624 +        format of returned clumplets is following:
625 +
626 +        isc_info_tra_isolation,
627 +                1, isc_info_tra_consistency | isc_info_tra_concurrency
628 +        |
629 +                2, isc_info_tra_read_committed,
630 +                         isc_info_tra_no_rec_version | isc_info_tra_rec_version
631 +
632 +        i.e. for read committed transactions returned 2 items while for
633 +        other transactions returned 1 item}
634 +
635 +    isc_info_tra_access:
636 +      FItems[index] := AddIntegerItem(P);
637 +    fb_info_tra_dbpath:
638 +      FItems[index] := AddStringItem(P);
639 +    else
640 +      FItems[index] := AddItem(P);
641 +    end;
642 +    P := P + FItems[index]^.FSize;
643 +    Inc(index);
644 +  end;
645 + end;
646 +
647 + constructor TTrInformation.Create(api: TFBClientAPI; aSize: integer);
648 + begin
649 +  inherited Create(api,aSize);
650 +  FIntegerType := dtInteger;
651 + end;
652 +
653 + {$IFNDEF FPC}
654 + function TTrInformation.Find(ItemType: byte): ITrInfoItem;
655 + begin
656 +  Result := inherited Find(ItemType);
657 +  if Result.GetSize = 0 then
658 +    Result := nil;
659 + end;
660 + {$ENDIF}
661 +
662   end.
663  

Diff Legend

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