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, 9 months ago) by tony
Content type:	text/x-pascal
File size:	6901 byte(s)
Log Message:	Fixes merged
#	User	Rev	Content
1	tony	143	(*
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	tony	45	unit LimboTransactionsUnit;
28
29			{$mode objfpc}{$H+}
30
31			interface
32
33			uses
34			Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35	tony	147	Grids, ActnList, db, memds, IBServices, IBDynamicGrid;
36	tony	45
37			type
38			{ TLimboTransactionsForm }
39
40			TLimboTransactionsForm = class(TForm)
41	tony	147	ApplySelectedAction: TAction;
42			Commit2PhaseAll: TAction;
43			RollbackAll: TAction;
44			CommitAll: TAction;
45			ActionList1: TActionList;
46	tony	45	Button1: TButton;
47			Button2: TButton;
48			Button3: TButton;
49			Button4: TButton;
50	tony	147	Button5: TButton;
51			IBDynamicGrid3: TIBDynamicGrid;
52			InLimboList: TMemDataset;
53			Label38: TLabel;
54			Label39: TLabel;
55			LimboListSource: TDataSource;
56			LimboReport: TMemo;
57	tony	143	LimboTransactionValidation: TIBValidationService;
58	tony	147	procedure ApplySelectedActionExecute(Sender: TObject);
59			procedure Commit2PhaseAllExecute(Sender: TObject);
60			procedure CommitAllExecute(Sender: TObject);
61			procedure CommitAllUpdate(Sender: TObject);
62	tony	143	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
63	tony	45	procedure FormShow(Sender: TObject);
64	tony	147	procedure InLimboListAfterOpen(DataSet: TDataSet);
65			procedure InLimboListBeforeClose(DataSet: TDataSet);
66			procedure InLimboListBeforePost(DataSet: TDataSet);
67			procedure RollbackAllExecute(Sender: TObject);
68	tony	45	private
69			{ private declarations }
70	tony	147	FLoadingLimboTr: boolean;
71	tony	45	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	tony	143	uses MainFormUnit;
85	tony	45
86			{ TLimboTransactionsForm }
87
88			procedure TLimboTransactionsForm.FormShow(Sender: TObject);
89			begin
90			Application.QueueAsyncCall(@DoRefresh,0);
91	tony	147	LimboReport.Lines.Clear;
92	tony	45	end;
93
94	tony	147	procedure TLimboTransactionsForm.InLimboListAfterOpen(DataSet: TDataSet);
95	tony	45
96	tony	147	function TypeToStr(MultiDatabase: boolean): string;
97	tony	45	begin
98	tony	147	if MultiDatabase then
99			Result := 'Multi DB'
100			else
101			Result := 'Single DB';
102	tony	45	end;
103
104	tony	147	function StateToStr(State: TTransactionState): string;
105	tony	45	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	tony	147	function AdviseToStr(Advise: TTransactionAdvise): string;
119	tony	45	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	tony	147	function ActionToStr(anAction: IBServices.TTransactionAction): string;
131	tony	45	begin
132			case anAction of
133			CommitAction:
134			Result := 'Commit';
135			RollbackAction:
136			Result := 'Rollback';
137			end;
138			end;
139
140	tony	147	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	tony	45	procedure TLimboTransactionsForm.RunGFix;
235			begin
236	tony	147	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	tony	143	with LimboTransactionValidation do
244	tony	45	begin
245	tony	147	LimboReport.Lines.Add('Starting Limbo transaction resolution');
246	tony	45	FixLimboTransactionErrors;
247			while not Eof do
248			begin
249	tony	147	LimboReport.Lines.Add(GetNextLine);
250	tony	45	Application.ProcessMessages;
251			end;
252	tony	147	LimboReport.Lines.Add('Limbo Transaction resolution complete');
253	tony	45	Application.QueueAsyncCall(@DoRefresh,0);
254			end;
255			end;
256
257			end.
258