ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/branches/udr/client/FBTransaction.pas

Comparing:
ibx/trunk/fbintf/client/FBTransaction.pas (file contents), Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC vs.
ibx/branches/udr/client/FBTransaction.pas (file contents), Revision 387 by tony, Wed Jan 19 13:34:42 2022 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	+	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 102 | 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 138 | Line 157 | type
157		function LookupItemType(ParamTypeName: AnsiString): byte; override;
158		public
159		constructor Create(api: TFBClientAPI);
160	+	function GetParamTypeName(ParamType: byte): Ansistring;
161	+	{$IFDEF FPC}
162	+	function ITPB.GetDPBParamTypeName = GetParamTypeName;
163	+	{$ELSE}
164		function GetDPBParamTypeName(ParamType: byte): Ansistring;
165	+	{$ENDIF}
166	+	function AsText: AnsiString;
167	+	end;
168	+
169	+	{$IFDEF FPC}
170	+	TTrInfoItem = class;
171	+
172	+	{ TTrInfoItem }
173	+
174	+	TTrInfoItem = class(TOutputBlockItemGroup<TTrInfoItem,ITrInfoItem>,ITrInfoItem)
175	+	{$ELSE}
176	+	TTrInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,ITrInfoItem>,ITrInfoItem)
177	+	{$ENDIF}
178	+	public
179	+	procedure DecodeTraIsolation(var IsolationType, RecVersion: byte);
180	+	end;
181	+
182	+	{ TTrInformation }
183	+
184	+	TTrInformation = class(TCustomOutputBlock<TTrInfoItem,ITrInfoItem>, ITrInformation)
185	+	protected
186	+	procedure DoParseBuffer; override;
187	+	public
188	+	constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
189	+	{$IFNDEF FPC}
190	+	function Find(ItemType: byte): ITrInfoItem;
191	+	{$ENDIF}
192		end;
193
194	+
195		implementation
196
197		uses FBMessages;
#	Line 185 | Line 236 | begin
236		Result.Add(sl[i]);
237		end;
238
239	+	procedure TFBTransaction.CheckHandle;
240	+	begin
241	+	if not InTransaction then
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 222 | 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 236 | Line 299 | begin
299		SetLength(FAttachments,1);
300		FAttachments[0] := Attachment;
301		FTPB := TPB;
302	+	FTransactionName := aName;
303		Start(DefaultCompletion);
304		end;
305
#	Line 250 | 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 272 | 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
378	+	Info := GetTrInformation(isc_info_tra_access);
379	+	if (Info.Count > 0) and (Info[0].getItemType = isc_info_tra_access) then
380	+	Result := Info[0].getAsInteger = isc_info_tra_readonly
381	+	else
382	+	Result := false;
383	+	end;
384	+
385	+	function TFBTransaction.GetTransactionID: integer;
386	+	var Info: ITrInformation;
387	+	begin
388	+	Result := -1;
389	+	Info := GetTrInformation(isc_info_tra_id);
390	+	if (Info.Count > 0) and (Info[0].getItemType = isc_info_tra_id) then
391	+	Result := Info[0].getAsInteger;
392	+	end;
393	+
394		function TFBTransaction.GetAttachmentCount: integer;
395		begin
396		Result := Length(FAttachments);
#	Line 285 | 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 292 | Line 482 | begin
482		Start(DefaultCompletion);
483		end;
484
485	+	function TFBTransaction.GetTrInformation(Requests: array of byte
486	+	): ITrInformation;
487	+	var ReqBuffer: PByte;
488	+	i: integer;
489	+	begin
490	+	CheckHandle;
491	+	if Length(Requests) = 1 then
492	+	Result := GetTrInformation(Requests[0])
493	+	else
494	+	begin
495	+	GetMem(ReqBuffer,Length(Requests));
496	+	try
497	+	for i := 0 to Length(Requests) - 1 do
498	+	ReqBuffer[i] := Requests[i];
499	+
500	+	Result := GetTrInfo(ReqBuffer,Length(Requests));
501	+
502	+	finally
503	+	FreeMem(ReqBuffer);
504	+	end;
505	+	end;
506	+	end;
507	+
508	+	function TFBTransaction.GetTrInformation(Request: byte): ITrInformation;
509	+	begin
510	+	CheckHandle;
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 309 | Line 538 | begin
538		FBuffer^ := isc_tpb_version3;
539		end;
540
541	<	function TTPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
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
565	+	Result := GetParamTypeName(ParamType);
566	+	end;
567	+	{$ENDIF}
568	+
569	+
570		function TTPB.LookupItemType(ParamTypeName: AnsiString): byte;
571		var i: byte;
572		begin
#	Line 333 | Line 583 | begin
583		end;
584		end;
585
586	+	{ TTrInfoItem }
587	+
588	+	procedure TTrInfoItem.DecodeTraIsolation(var IsolationType, RecVersion: byte);
589	+	begin
590	+	with FFirebirdClientAPI, ItemData^ do
591	+	if getItemType = isc_info_tra_isolation then
592	+	begin
593	+	if FDataLength = 1 then
594	+	begin
595	+	IsolationType := getAsInteger;
596	+	RecVersion := 0;
597	+	end
598	+	else
599	+	begin
600	+	IsolationType := (FBufPtr + 3)^;
601	+	RecVersion := (FBufPtr + 4)^;
602	+	end
603	+	end
604	+	else
605	+	IBError(ibxeInfoBufferTypeError,[integer(FBufPtr^)]);
606	+	end;
607	+
608	+	{ TTrInformation }
609	+
610	+	procedure TTrInformation.DoParseBuffer;
611	+	var P: PByte;
612	+	index: integer;
613	+	begin
614	+	P := Buffer;
615	+	index := 0;
616	+	SetLength(FItems,0);
617	+	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
618	+	begin
619	+	SetLength(FItems,index+1);
620	+	case byte(P^) of
621	+	isc_info_tra_id,
622	+	isc_info_tra_oldest_interesting,
623	+	isc_info_tra_oldest_active,
624	+	isc_info_tra_oldest_snapshot,
625	+	fb_info_tra_snapshot_number,
626	+	isc_info_tra_lock_timeout:
627	+	FItems[index] := AddIntegerItem(P);
628	+
629	+	isc_info_tra_isolation,
630	+	{return transaction isolation mode of current transaction.
631	+	format of returned clumplets is following:
632	+
633	+	isc_info_tra_isolation,
634	+	1, isc_info_tra_consistency | isc_info_tra_concurrency
635	+	|
636	+	2, isc_info_tra_read_committed,
637	+	isc_info_tra_no_rec_version | isc_info_tra_rec_version
638	+
639	+	i.e. for read committed transactions returned 2 items while for
640	+	other transactions returned 1 item}
641	+
642	+	isc_info_tra_access:
643	+	FItems[index] := AddIntegerItem(P);
644	+	fb_info_tra_dbpath:
645	+	FItems[index] := AddStringItem(P);
646	+	else
647	+	FItems[index] := AddItem(P);
648	+	end;
649	+	P := P + FItems[index]^.FSize;
650	+	Inc(index);
651	+	end;
652	+	end;
653	+
654	+	constructor TTrInformation.Create(api: TFBClientAPI; aSize: integer);
655	+	begin
656	+	inherited Create(api,aSize);
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

Comparing:
ibx/trunk/fbintf/client/FBTransaction.pas (property svn:eol-style), Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC vs.
ibx/branches/udr/client/FBTransaction.pas (property svn:eol-style), Revision 387 by tony, Wed Jan 19 13:34:42 2022 UTC

#	Line 0 | Line 1
1	+	native

Diff Legend

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