examples/services/LimboTransactionsUnit.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2015 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*) 
            
unit LimboTransactionsUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Grids, ActnList, db, memds, IBServices, IBDynamicGrid;

type
  { TLimboTransactionsForm }

  TLimboTransactionsForm = class(TForm)
    ApplySelectedAction: TAction;
    Commit2PhaseAll: TAction;
    RollbackAll: TAction;
    CommitAll: TAction;
    ActionList1: TActionList;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    IBDynamicGrid3: TIBDynamicGrid;
    InLimboList: TMemDataset;
    Label38: TLabel;
    Label39: TLabel;
    LimboListSource: TDataSource;
    LimboReport: TMemo;
    LimboTransactionValidation: TIBValidationService;
    procedure ApplySelectedActionExecute(Sender: TObject);
    procedure Commit2PhaseAllExecute(Sender: TObject);
    procedure CommitAllExecute(Sender: TObject);
    procedure CommitAllUpdate(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure InLimboListAfterOpen(DataSet: TDataSet);
    procedure InLimboListBeforeClose(DataSet: TDataSet);
    procedure InLimboListBeforePost(DataSet: TDataSet);
    procedure RollbackAllExecute(Sender: TObject);
  private
    { private declarations }
    FLoadingLimboTr: boolean;
    procedure DoRefresh(Data: PtrInt);
    procedure RunGFix;
  public
    { public declarations }
  end;

var
  LimboTransactionsForm: TLimboTransactionsForm;

implementation

{$R *.lfm}

uses MainFormUnit;

{ TLimboTransactionsForm }

procedure TLimboTransactionsForm.FormShow(Sender: TObject);
begin
  Application.QueueAsyncCall(@DoRefresh,0);
  LimboReport.Lines.Clear;
end;

procedure TLimboTransactionsForm.InLimboListAfterOpen(DataSet: TDataSet);

function TypeToStr(MultiDatabase: boolean): string;
begin
  if MultiDatabase then
    Result := 'Multi DB'
  else
    Result := 'Single DB';
end;

function StateToStr(State: TTransactionState): string;
begin
  case State of
  LimboState:
    Result := 'Limbo';
  CommitState:
    Result := 'Commit';
  RollbackState:
    Result := 'Rollback';
  else
    Result := 'Unknown';
  end;
end;

function AdviseToStr(Advise: TTransactionAdvise): string;
begin
  case Advise of
  CommitAdvise:
    Result := 'Commit';
  RollbackAdvise:
    Result := 'Rollback';
  else
    Result := 'Unknown';
  end;
end;

function ActionToStr(anAction: IBServices.TTransactionAction): string;
begin
  case anAction of
  CommitAction:
    Result := 'Commit';
  RollbackAction:
    Result := 'Rollback';
  end;
end;

var i: integer;
begin
  if FLoadingLimboTr then Exit;
  FLoadingLimboTr := true;
  with LimboTransactionValidation do
  try
    Active := true;
    ServiceStart;
    FetchLimboTransactionInfo;
    for i := 0 to LimboTransactionInfoCount - 1 do
    with LimboTransactionInfo[i] do
    begin
      InLimboList.Append;
      InLimboList.FieldByName('TransactionID').AsInteger := ID;
      InLimboList.FieldByName('TransactionType').AsString := TypeToStr(MultiDatabase);
      InLimboList.FieldByName('HostSite').AsString := HostSite;
      InLimboList.FieldByName('RemoteSite').AsString := RemoteSite;
      InLimboList.FieldByName('DatabasePath').AsString := RemoteDatabasePath;
      InLimboList.FieldByName('State').AsString := StateToStr(State);
      InLimboList.FieldByName('RecommendedAction').AsString := AdviseToStr(Advise);
      InLimboList.FieldByName('RequestedAction').AsString := ActionToStr(Action);
      InLimboList.Post;
    end;
  finally
    FLoadingLimboTr := false;
  end;
end;

procedure TLimboTransactionsForm.InLimboListBeforeClose(DataSet: TDataSet);
begin
  InLimboList.Clear(false);
end;

procedure TLimboTransactionsForm.InLimboListBeforePost(DataSet: TDataSet);
var i: integer;
begin
  if FLoadingLimboTr then Exit;
  with LimboTransactionValidation do
  for i := 0 to LimboTransactionInfoCount - 1 do
    with LimboTransactionInfo[i] do
    begin
      if ID = InLimboList.FieldByName('TransactionID').AsInteger then
      begin
       if InLimboList.FieldByName('RequestedAction').AsString = 'Commit' then
         Action := CommitAction
       else
         if InLimboList.FieldByName('RequestedAction').AsString = 'Rollback' then
           Action := RollbackAction;
       break;
      end;
    end;
end;

procedure TLimboTransactionsForm.RollbackAllExecute(Sender: TObject);
begin
  LimboTransactionValidation.GlobalAction := RollbackGlobal;
  RunGFix;
end;

procedure TLimboTransactionsForm.ApplySelectedActionExecute(Sender: TObject);
begin
  LimboTransactionValidation.GlobalAction := NoGlobalAction;
  RunGFix;
end;

procedure TLimboTransactionsForm.Commit2PhaseAllExecute(Sender: TObject);
begin
  LimboTransactionValidation.GlobalAction := RecoverTwoPhaseGlobal;
  RunGFix;
end;

procedure TLimboTransactionsForm.CommitAllExecute(Sender: TObject);
begin
  LimboTransactionValidation.GlobalAction := CommitGlobal;
  RunGFix;
end;

procedure TLimboTransactionsForm.CommitAllUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := InLimboList.Active and (InLimboList.RecordCount > 0);
end;

procedure TLimboTransactionsForm.FormClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  InLimboList.Active := false;
end;

procedure TLimboTransactionsForm.DoRefresh(Data: PtrInt);
begin
  InLimboList.Active := false;
  InLimboList.Active := true;
end;

procedure TLimboTransactionsForm.RunGFix;
begin
  if not InLimboList.Active then
    raise Exception.Create('Limbo Transactions List not available');

  with InLimboList do
    if State = dsEdit then Post;
  LimboReport.Lines.Clear;

  with LimboTransactionValidation do
  begin
    LimboReport.Lines.Add('Starting Limbo transaction resolution');
    FixLimboTransactionErrors;
    while not Eof do
    begin
      LimboReport.Lines.Add(GetNextLine);
      Application.ProcessMessages;
    end;
    LimboReport.Lines.Add('Limbo Transaction resolution complete');
    Application.QueueAsyncCall(@DoRefresh,0);
  end;
end;

end.

Revision:	147
Committed:	Mon Feb 26 11:14:30 2018 UTC (6 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	6901 byte(s)
Log Message:	Fixes merged
#	Content
1	(*
2	* IBX For Lazarus (Firebird Express)
3	*
4	* The contents of this file are subject to the Initial Developer's
5	* Public License Version 1.0 (the "License"); you may not use this
6	* file except in compliance with the License. You may obtain a copy
7	* of the License here:
8	*
9	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
10	*
11	* Software distributed under the License is distributed on an "AS
12	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13	* implied. See the License for the specific language governing rights
14	* and limitations under the License.
15	*
16	* The Initial Developer of the Original Code is Tony Whyman.
17	*
18	* The Original Code is (C) 2015 Tony Whyman, MWA Software
19	* (http://www.mwasoftware.co.uk).
20	*
21	* All Rights Reserved.
22	*
23	* Contributor(s): ______________________________________.
24	*
25	*)
26
27	unit LimboTransactionsUnit;
28
29	{$mode objfpc}{$H+}
30
31	interface
32
33	uses
34	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35	Grids, ActnList, db, memds, IBServices, IBDynamicGrid;
36
37	type
38	{ TLimboTransactionsForm }
39
40	TLimboTransactionsForm = class(TForm)
41	ApplySelectedAction: TAction;
42	Commit2PhaseAll: TAction;
43	RollbackAll: TAction;
44	CommitAll: TAction;
45	ActionList1: TActionList;
46	Button1: TButton;
47	Button2: TButton;
48	Button3: TButton;
49	Button4: TButton;
50	Button5: TButton;
51	IBDynamicGrid3: TIBDynamicGrid;
52	InLimboList: TMemDataset;
53	Label38: TLabel;
54	Label39: TLabel;
55	LimboListSource: TDataSource;
56	LimboReport: TMemo;
57	LimboTransactionValidation: TIBValidationService;
58	procedure ApplySelectedActionExecute(Sender: TObject);
59	procedure Commit2PhaseAllExecute(Sender: TObject);
60	procedure CommitAllExecute(Sender: TObject);
61	procedure CommitAllUpdate(Sender: TObject);
62	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
63	procedure FormShow(Sender: TObject);
64	procedure InLimboListAfterOpen(DataSet: TDataSet);
65	procedure InLimboListBeforeClose(DataSet: TDataSet);
66	procedure InLimboListBeforePost(DataSet: TDataSet);
67	procedure RollbackAllExecute(Sender: TObject);
68	private
69	{ private declarations }
70	FLoadingLimboTr: boolean;
71	procedure DoRefresh(Data: PtrInt);
72	procedure RunGFix;
73	public
74	{ public declarations }
75	end;
76
77	var
78	LimboTransactionsForm: TLimboTransactionsForm;
79
80	implementation
81
82	{$R *.lfm}
83
84	uses MainFormUnit;
85
86	{ TLimboTransactionsForm }
87
88	procedure TLimboTransactionsForm.FormShow(Sender: TObject);
89	begin
90	Application.QueueAsyncCall(@DoRefresh,0);
91	LimboReport.Lines.Clear;
92	end;
93
94	procedure TLimboTransactionsForm.InLimboListAfterOpen(DataSet: TDataSet);
95
96	function TypeToStr(MultiDatabase: boolean): string;
97	begin
98	if MultiDatabase then
99	Result := 'Multi DB'
100	else
101	Result := 'Single DB';
102	end;
103
104	function StateToStr(State: TTransactionState): string;
105	begin
106	case State of
107	LimboState:
108	Result := 'Limbo';
109	CommitState:
110	Result := 'Commit';
111	RollbackState:
112	Result := 'Rollback';
113	else
114	Result := 'Unknown';
115	end;
116	end;
117
118	function AdviseToStr(Advise: TTransactionAdvise): string;
119	begin
120	case Advise of
121	CommitAdvise:
122	Result := 'Commit';
123	RollbackAdvise:
124	Result := 'Rollback';
125	else
126	Result := 'Unknown';
127	end;
128	end;
129
130	function ActionToStr(anAction: IBServices.TTransactionAction): string;
131	begin
132	case anAction of
133	CommitAction:
134	Result := 'Commit';
135	RollbackAction:
136	Result := 'Rollback';
137	end;
138	end;
139
140	var i: integer;
141	begin
142	if FLoadingLimboTr then Exit;
143	FLoadingLimboTr := true;
144	with LimboTransactionValidation do
145	try
146	Active := true;
147	ServiceStart;
148	FetchLimboTransactionInfo;
149	for i := 0 to LimboTransactionInfoCount - 1 do
150	with LimboTransactionInfo[i] do
151	begin
152	InLimboList.Append;
153	InLimboList.FieldByName('TransactionID').AsInteger := ID;
154	InLimboList.FieldByName('TransactionType').AsString := TypeToStr(MultiDatabase);
155	InLimboList.FieldByName('HostSite').AsString := HostSite;
156	InLimboList.FieldByName('RemoteSite').AsString := RemoteSite;
157	InLimboList.FieldByName('DatabasePath').AsString := RemoteDatabasePath;
158	InLimboList.FieldByName('State').AsString := StateToStr(State);
159	InLimboList.FieldByName('RecommendedAction').AsString := AdviseToStr(Advise);
160	InLimboList.FieldByName('RequestedAction').AsString := ActionToStr(Action);
161	InLimboList.Post;
162	end;
163	finally
164	FLoadingLimboTr := false;
165	end;
166	end;
167
168	procedure TLimboTransactionsForm.InLimboListBeforeClose(DataSet: TDataSet);
169	begin
170	InLimboList.Clear(false);
171	end;
172
173	procedure TLimboTransactionsForm.InLimboListBeforePost(DataSet: TDataSet);
174	var i: integer;
175	begin
176	if FLoadingLimboTr then Exit;
177	with LimboTransactionValidation do
178	for i := 0 to LimboTransactionInfoCount - 1 do
179	with LimboTransactionInfo[i] do
180	begin
181	if ID = InLimboList.FieldByName('TransactionID').AsInteger then
182	begin
183	if InLimboList.FieldByName('RequestedAction').AsString = 'Commit' then
184	Action := CommitAction
185	else
186	if InLimboList.FieldByName('RequestedAction').AsString = 'Rollback' then
187	Action := RollbackAction;
188	break;
189	end;
190	end;
191	end;
192
193	procedure TLimboTransactionsForm.RollbackAllExecute(Sender: TObject);
194	begin
195	LimboTransactionValidation.GlobalAction := RollbackGlobal;
196	RunGFix;
197	end;
198
199	procedure TLimboTransactionsForm.ApplySelectedActionExecute(Sender: TObject);
200	begin
201	LimboTransactionValidation.GlobalAction := NoGlobalAction;
202	RunGFix;
203	end;
204
205	procedure TLimboTransactionsForm.Commit2PhaseAllExecute(Sender: TObject);
206	begin
207	LimboTransactionValidation.GlobalAction := RecoverTwoPhaseGlobal;
208	RunGFix;
209	end;
210
211	procedure TLimboTransactionsForm.CommitAllExecute(Sender: TObject);
212	begin
213	LimboTransactionValidation.GlobalAction := CommitGlobal;
214	RunGFix;
215	end;
216
217	procedure TLimboTransactionsForm.CommitAllUpdate(Sender: TObject);
218	begin
219	(Sender as TAction).Enabled := InLimboList.Active and (InLimboList.RecordCount > 0);
220	end;
221
222	procedure TLimboTransactionsForm.FormClose(Sender: TObject;
223	var CloseAction: TCloseAction);
224	begin
225	InLimboList.Active := false;
226	end;
227
228	procedure TLimboTransactionsForm.DoRefresh(Data: PtrInt);
229	begin
230	InLimboList.Active := false;
231	InLimboList.Active := true;
232	end;
233
234	procedure TLimboTransactionsForm.RunGFix;
235	begin
236	if not InLimboList.Active then
237	raise Exception.Create('Limbo Transactions List not available');
238
239	with InLimboList do
240	if State = dsEdit then Post;
241	LimboReport.Lines.Clear;
242
243	with LimboTransactionValidation do
244	begin
245	LimboReport.Lines.Add('Starting Limbo transaction resolution');
246	FixLimboTransactionErrors;
247	while not Eof do
248	begin
249	LimboReport.Lines.Add(GetNextLine);
250	Application.ProcessMessages;
251	end;
252	LimboReport.Lines.Add('Limbo Transaction resolution complete');
253	Application.QueueAsyncCall(@DoRefresh,0);
254	end;
255	end;
256
257	end.
258