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

Comparing ibx/branches/journaling/runtime/nongui/IBDatabase.pas (file contents):
Revision 362 by tony, Tue Dec 7 13:27:39 2021 UTC vs.
Revision 363 by tony, Tue Dec 7 13:30:05 2021 UTC

# Line 45 | Line 45 | uses
45   {$ELSE}
46    unix,
47   {$ENDIF}
48 <  SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBInternals;
48 >  SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBInternals,
49 >  syncobjs;
50  
51   type
52    TIBDatabase = class;
# Line 222 | Line 223 | type
223  
224    TIBTransaction = class(TComponent)
225    private
226 +    class var FCriticalSection: TCriticalSection;
227 +    class var FTransactionList: TList;
228 +  private
229      FTransactionIntf: ITransaction;
230      FAfterDelete: TNotifyEvent;
231      FAfterEdit: TNotifyEvent;
# Line 243 | Line 247 | type
247      FTRParamsChanged    : Boolean;
248      FInEndTransaction   : boolean;
249      FEndAction          : TTransactionAction;
250 +    FTransactionName    : string;
251      procedure DoBeforeTransactionEnd;
252      procedure DoAfterTransactionEnd;
253      procedure DoOnStartTransaction;
# Line 255 | Line 260 | type
260      procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
261      function GetDatabase(Index: Integer): TIBDatabase;
262      function GetDatabaseCount: Integer;
263 +    function GetIsReadOnly: boolean;
264      function GetSQLObject(Index: Integer): TIBBase;
265      function GetSQLObjectCount: Integer;
266      function GetInTransaction: Boolean;
267      function GetIdleTimer: Integer;
268      procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
269      function GetTPBConstantNames(index: byte): string;
270 +    function GetTransactionID: integer;
271      procedure SetActive(Value: Boolean);
272      procedure SetDefaultDatabase(Value: TIBDatabase);
273      procedure SetIdleTimer(Value: Integer);
274 +    procedure SetTransactionName(AValue: string);
275      procedure SetTRParams(Value: TStrings);
276      procedure TimeoutTransaction(Sender: TObject);
277      procedure TRParamsChange(Sender: TObject);
# Line 272 | Line 280 | type
280      procedure RemoveSQLObject(Idx: Integer);
281      procedure RemoveSQLObjects;
282      function GenerateTPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): ITPB;
275
283    protected
284      procedure Loaded; override;
285      procedure Notification( AComponent: TComponent; Operation: TOperation); override;
# Line 291 | Line 298 | type
298      function AddDatabase(db: TIBDatabase): Integer;
299      function FindDatabase(db: TIBDatabase): Integer;
300      function FindDefaultDatabase: TIBDatabase;
301 +    class function FindTransactionNyName(aTransactionName: string): TIBTransaction;
302      function GetEndAction: TTransactionAction;
303      procedure RemoveDatabase(Idx: Integer);
304      procedure RemoveDatabases;
# Line 304 | Line 312 | type
312      property TransactionIntf: ITransaction read FTransactionIntf;
313      property TPB: ITPB read FTPB;
314      property TPBConstantNames[index: byte]: string read GetTPBConstantNames;
315 +    property TransactionID: integer read GetTransactionID;
316 +    property IsReadOnly: boolean read GetIsReadOnly;
317    published
318 +    property TransactionName: string read FTransactionName write SetTransactionName;
319      property Active: Boolean read GetInTransaction write SetActive;
320      property DefaultDatabase: TIBDatabase read FDefaultDatabase
321                                             write SetDefaultDatabase;
# Line 427 | Line 438 | begin
438    TStringList(FDBParams).OnChanging := DBParamsChanging;
439    FInternalTransaction := TIBTransaction.Create(self);
440    FInternalTransaction.DefaultDatabase := Self;
441 +  with FInternalTransaction.Params do
442 +  begin
443 +    Clear;
444 +    Add('concurrency');
445 +    Add('wait');
446 +    Add('read');
447 +  end;
448    FTimer := TFPTimer.Create(Self);
449    FTimer.Enabled := False;
450    FTimer.Interval := 0;
# Line 1566 | Line 1584 | end;
1584   { TIBTransaction }
1585  
1586   constructor TIBTransaction.Create(AOwner: TComponent);
1587 + var uuid: TGUID;
1588   begin
1589    inherited Create(AOwner);
1590    FDatabases := TList.Create;
# Line 1580 | Line 1599 | begin
1599    FTimer.Interval := 0;
1600    FTimer.OnTimer := TimeoutTransaction;
1601    FDefaultAction := taCommit;
1602 +  FTransactionList.Add(self);
1603 +  if (FTransactionName = '') and (CreateGUID(uuid) = 0) then
1604 +    FTransactionName := GUIDToString(uuid);
1605   end;
1606  
1607   destructor TIBTransaction.Destroy;
# Line 1593 | Line 1615 | begin
1615        SQLObjects[i].DoTransactionFree;
1616    RemoveSQLObjects;
1617    RemoveDatabases;
1618 +  if assigned(FTransactionList) then
1619 +    FTransactionList.Remove(self);
1620    FTPB := nil;
1621    FTRParams.Free;
1622    FSQLObjects.Free;
# Line 1735 | Line 1759 | end;
1759  
1760   procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1761    Force: Boolean);
1762 < var
1763 <  i: Integer;
1764 < begin
1765 <  CheckInTransaction;
1766 <  if FInEndTransaction then Exit;
1767 <  FInEndTransaction := true;
1768 <  FEndAction := Action;
1769 <  try
1770 <  case Action of
1771 <    TARollback, TACommit:
1772 <    begin
1773 <      try
1774 <        DoBeforeTransactionEnd;
1775 <      except on E: EIBInterBaseError do
1776 <        begin
1777 <          if not Force then
1762 >
1763 >
1764 >  procedure InternalDoBeforeTransactionEnd;
1765 >  var i: integer;
1766 >  begin
1767 >    try
1768 >      DoBeforeTransactionEnd;
1769 >    except on E: EIBInterBaseError do
1770 >      begin
1771 >        if not Force then
1772 >          raise;
1773 >      end;
1774 >    end;
1775 >
1776 >    for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1777 >    try
1778 >      SQLObjects[i].DoBeforeTransactionEnd(Action);
1779 >    except on E: EIBInterBaseError do
1780 >      begin
1781 >        if not Force then
1782              raise;
1783          end;
1784 <      end;
1784 >    end;
1785 >  end;
1786  
1787 <      for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1787 >  procedure InternalDoAfterTransctionEnd;
1788 >  var i: integer;
1789 >  begin
1790 >    for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1791        try
1792 <        SQLObjects[i].DoBeforeTransactionEnd(Action);
1792 >        SQLObjects[i].DoAfterTransactionEnd;
1793        except on E: EIBInterBaseError do
1794          begin
1795            if not Force then
1796 <              raise;
1797 <          end;
1796 >            raise;
1797 >        end;
1798        end;
1799 <
1800 <      if InTransaction then
1799 >    try
1800 >      DoAfterTransactionEnd;
1801 >    except on E: EIBInterBaseError do
1802        begin
1803 <        if (Action = TARollback) then
1804 <            FTransactionIntf.Rollback(Force)
1772 <        else
1773 <        try
1774 <          FTransactionIntf.Commit;
1775 <        except on E: EIBInterBaseError do
1776 <          begin
1777 <            if Force then
1778 <              FTransactionIntf.Rollback(Force)
1779 <            else
1780 <              raise;
1781 <          end;
1782 <        end;
1783 <
1784 <          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1785 <          try
1786 <            SQLObjects[i].DoAfterTransactionEnd;
1787 <          except on E: EIBInterBaseError do
1788 <            begin
1789 <              if not Force then
1790 <                raise;
1791 <            end;
1792 <          end;
1793 <        try
1794 <          DoAfterTransactionEnd;
1795 <        except on E: EIBInterBaseError do
1796 <          begin
1797 <            if not Force then
1798 <              raise;
1799 <          end;
1800 <        end;
1803 >        if not Force then
1804 >          raise;
1805        end;
1806      end;
1803    TACommitRetaining:
1804      FTransactionIntf.CommitRetaining;
1805
1806    TARollbackRetaining:
1807      FTransactionIntf.RollbackRetaining;
1808  end;
1809  if not (csDesigning in ComponentState) then
1810  begin
1811    case Action of
1812      TACommit:
1813        MonitorHook.TRCommit(Self);
1814      TARollback:
1815        MonitorHook.TRRollback(Self);
1816      TACommitRetaining:
1817        MonitorHook.TRCommitRetaining(Self);
1818      TARollbackRetaining:
1819        MonitorHook.TRRollbackRetaining(Self);
1820    end;
1807    end;
1808 +
1809 + begin
1810 +  CheckInTransaction;
1811 +  if FInEndTransaction then Exit;
1812 +  FCriticalSection.Enter; {Ensure that only one thread can commit a transaction
1813 +                           at any one time}
1814 +  FEndAction := Action;
1815 +  FInEndTransaction := true;
1816 +  try
1817 +   case Action of
1818 +     TARollback:
1819 +       begin
1820 +         InternalDoBeforeTransactionEnd;
1821 +         FTransactionIntf.Rollback(Force);
1822 +         InternalDoAfterTransctionEnd;
1823 +         if not (csDesigning in ComponentState) then
1824 +           MonitorHook.TRRollback(Self);
1825 +       end;
1826 +     TACommit:
1827 +       begin
1828 +         InternalDoBeforeTransactionEnd;
1829 +         try
1830 +           FTransactionIntf.Commit;
1831 +         except on E: EIBInterBaseError do
1832 +           begin
1833 +             if Force then
1834 +               FTransactionIntf.Rollback(Force)
1835 +             else
1836 +               raise;
1837 +           end;
1838 +         end;
1839 +         InternalDoAfterTransctionEnd;
1840 +         if not (csDesigning in ComponentState) then
1841 +           MonitorHook.TRCommit(Self);
1842 +      end;
1843 +     TACommitRetaining:
1844 +       begin
1845 +         FTransactionIntf.CommitRetaining;
1846 +         if not (csDesigning in ComponentState) then
1847 +           MonitorHook.TRCommitRetaining(Self);
1848 +       end;
1849 +
1850 +     TARollbackRetaining:
1851 +       begin
1852 +         FTransactionIntf.RollbackRetaining;
1853 +         if not (csDesigning in ComponentState) then
1854 +           MonitorHook.TRRollbackRetaining(Self);
1855 +       end;
1856 +     end;
1857    finally
1858 <    FInEndTransaction := false
1858 >    FInEndTransaction := false;
1859 >    FCriticalSection.Leave;
1860    end;
1861   end;
1862  
# Line 1839 | Line 1875 | begin
1875      Inc(result);
1876   end;
1877  
1878 + function TIBTransaction.GetIsReadOnly: boolean;
1879 + begin
1880 +  CheckInTransaction;
1881 +  Result := FTransactionIntf.GetIsReadOnly;
1882 + end;
1883 +
1884   function TIBTransaction.GetSQLObject(Index: Integer): TIBBase;
1885   begin
1886    result := FSQLObjects[Index];
# Line 1889 | Line 1931 | begin
1931    end;
1932   end;
1933  
1934 + class function TIBTransaction.FindTransactionNyName(aTransactionName: string
1935 +  ): TIBTransaction;
1936 + var i: integer;
1937 + begin
1938 +  Result := nil;
1939 +  for i := 0 to FTransactionList.Count - 1 do
1940 +    if TIBTransaction(FTransactionList[i]).TransactionName = aTransactionName then
1941 +    begin
1942 +      Result := FTransactionList[i];
1943 +      break;
1944 +    end;
1945 + end;
1946 +
1947   function TIBTransaction.GetEndAction: TTransactionAction;
1948   begin
1949    if FInEndTransaction then
# Line 1925 | Line 1980 | begin
1980      IBError(ibxeTPBConstantUnknown,[index]);
1981   end;
1982  
1983 + function TIBTransaction.GetTransactionID: integer;
1984 + begin
1985 +  CheckInTransaction;
1986 +  Result := FTransactionIntf.GetTransactionID;
1987 + end;
1988 +
1989   procedure TIBTransaction.RemoveDatabase(Idx: Integer);
1990   var
1991    DB: TIBDatabase;
# Line 2053 | Line 2114 | begin
2114        end;
2115   end;
2116  
2117 + procedure TIBTransaction.SetTransactionName(AValue: string);
2118 + begin
2119 +  if FTransactionName = AValue then Exit;
2120 +  CheckNotInTransaction;
2121 +  FTransactionName := AValue;
2122 + end;
2123 +
2124   procedure TIBTransaction.SetTRParams(Value: TStrings);
2125   begin
2126    FTRParams.Assign(Value);
# Line 2094 | Line 2162 | begin
2162        if Databases[i] <> nil then Inc(ValidDatabaseCount);
2163  
2164      if ValidDatabaseCount = 1 then
2165 <      FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
2165 >      FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,
2166 >                                                DefaultAction,TransactionName)
2167      else
2168      begin
2169        SetLength(Attachments,ValidDatabaseCount);
# Line 2102 | Line 2171 | begin
2171          if Databases[i] <> nil then
2172            Attachments[i] := Databases[i].Attachment;
2173  
2174 <      FTransactionIntf := Databases[0].FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
2174 >      FTransactionIntf := Databases[0].FirebirdAPI.StartTransaction(Attachments,FTPB,
2175 >                                              DefaultAction,TransactionName);
2176      end;
2177 +
2178    end;
2179  
2180    if not (csDesigning in ComponentState) then
2181 <      MonitorHook.TRStart(Self);
2181 >     MonitorHook.TRStart(Self);
2182 >
2183    DoOnStartTransaction;
2184   end;
2185  
# Line 2407 | Line 2479 | begin
2479    end;
2480   end;
2481  
2482 +
2483 + Initialization
2484 +  TIBTransaction.FCriticalSection := TCriticalSection.Create;
2485 +  TIBTransaction.FTransactionList := TList.Create;
2486 +
2487 + Finalization
2488 +  if assigned(TIBTransaction.FCriticalSection) then TIBTransaction.FCriticalSection.Free;
2489 +  if assigned(TIBTransaction.FTransactionList) then TIBTransaction.FTransactionList.Free;
2490 +
2491   end.
2492  
2493  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines