Commit для изменений свойств объектов

Brainenjii · Сообщение **Brainenjii** » 12.05.2011 12:57:56

В продолжение этого топика
Не знаю даже как начать - появилась сегодня идея по изменению свойств объектов во многопользовательском приложении, показалась интересной, но при реализации возникли проблемы.
В общем ^_^ Во всех работающих с БД проектах встречается следующая конструкция: есть объект и отражение его в БД записью в ассоциированой таблице. Что-то вроде недоORM ^_^ Изначально это было примерно так:

Код: Выделить всё

...
Interface
...
Type

{ BObjectClass }

BObjectClass = Class
  Protected
    bCaption: String;
    bID: Integer;
  Public
    Property ID: Integer Read bID;
    Property Caption: String Read bCaption;
    Procedure Save;
    Constructor Build(Const aID: Integer; Const aCaption: String);
    Destructor Burn;
End;
...
Procedure GetObjects;
Procedure GetObject(Const aID: Integer): BObjectClass;

Var
  ObjectsList: TThreadList;

Implementation
...
Procedure GetObjects;
Begin
  With TQuery.Create Do
    Begin
      Open('SELECT ID, CAPTION FROM BOBJECTCLASS ORDER BY ID');
      While Not(EOF) Do
        Begin
          ObjectsList.Add(BObjectClass.Build(ByInteger('ID'),
            ByString('Caption')));
          Next;
        End;
      Free;
    End;
End;

Function GetObject(Const aID: Integer): BObjectClass;
Var
  i: Integer;
Begin
  With ObjectsList.LockList Do
    For i := 0 To Count - 1 Do
      If BObjectClass(Items[i]).ID = aID Then
        Begin
          Result := BObjectClass(Items[i]);
          Break;
        End;
  ObjectsList.UnlockList;
End;

...

Constructor BObjectClass.Build(Const aID: Integer; Const aCaption: String);
Begin
  bID := aID;
  bCaption := aCaption;
End;

Procedure BObjectClass.Save;
Begin
  With TQuery.Create Do
    Begin
      If ID < 0 Then
        SQL.Text := 'INSERT INTO BOBJECTCLASS (ID, CAPTION) VALUES' +
          '(:ID, :CAPTION) RETURNING ID';
      Else
        Begin
          SQL.Text := 'UPDATE OR INSERT INTO BOBJECTCLASS (ID, CAPTION) VALUES' +
            '(:ID, :CAPTION) RETURNING ID';
          ParamAsInteger['ID'] := ID;
        End;
      ParamAsString['CAPTION'] := Caption;
      ExecSQL;
      Free;
    End;
End;

Всё работало, но во-первых, используется глобальная переменная, много кода каждый раз и ещё много-много проблем... В один прекрасный момент была описана пара базовых классов:

Код: Выделить всё

Unit BObjectUnit;

{$mode objfpc}{$H+}

Interface

Uses
  Classes, SysUtils;

Type

{ BObjectClass }

BObjectClass = Class
  Protected
    bID: Integer;
    bCaption: String;
  Public
    Property ID: Integer Read bID;
    Property Caption: String Read bCaption Write bCaption;
    Constructor Build(Const aID: Integer; Const aCaption: String);
    Destructor Burn; Virtual;
End;

Type

{ BManagerClass }

BManagerClass = Class
  Protected
    bNonCommited: TThreadList;
    bNonCommitedIndex: Integer;
    Function FindByID(Const aList: TThreadList;
      Const aID: Integer): BObjectClass;
    Function FindByCaption(Const aList: TThreadList;
      Const aCaption: String): BObjectClass;
  Public
    Function BuildObject(Const aCaption: String): BObjectClass;
    Constructor Build;
    Destructor Burn; Virtual
End;

Implementation

{ BObjectClass }

Constructor BObjectClass.Build(Const aID: Integer; Const aCaption: String);
Begin
  bID := aID;
  bCaption := aCaption;
End;

Destructor BObjectClass.Burn;
Begin
End;

{ BManagerClass }

Function BManagerClass.FindByID(Const aList: TThreadList;
  Const aID: Integer): BObjectClass;
Var
  i: Integer;
Begin
  Result := nil;
  With aList.LockList Do
    For i := 0 To Count - 1 Do
      If BObjectClass(Items[i]).ID = aID Then
        Begin
          Result := BObjectClass(Items[i]);
          Break;
        End;
  aList.UnlockList;
End;

Function BManagerClass.FindByCaption(Const aList: TThreadList;
  Const aCaption: String): BObjectClass;
Var
  i: Integer;
Begin
  Result := nil;
  With aList.LockList Do
    For i := 0 To Count - 1 Do
      If BObjectClass(Items[i]).Caption = aCaption Then
        Begin
          Result := BObjectClass(Items[i]);
          Break;
        End;
  aList.UnlockList;
End;

Function BManagerClass.BuildObject(Const aCaption: String): BObjectClass;
Begin
  Dec(bNonCommitedIndex);
  Result := BObjectClass.Build(bNonCommitedIndex, aCaption);
  bNonCommited.Add(Result);
End;

Constructor BManagerClass.Build;
Begin
  bNonCommited := TThreadList.Create;
  bNonCommitedIndex := -1;
End;

Destructor BManagerClass.Burn;
Var
  i: Integer;
Begin
  With bNonCommited.LockList Do
    For i := 0 To Count - 1 Do
      BObjectClass(Items[i]).Burn;
  bNonCommited.UnlockList;
  bNonCommited.Free;
End;

End.

Конструкции с наследованием от этих классов стали выглядеть опрятнее, упростилась групповая обработка и вообще, ИМХО, стало лучше ^_^

Код: Выделить всё

Unit Unit1;

{$mode objfpc}{$H+}
{$static on}

Interface

Uses
  Classes, SysUtils, BObjectUnit, BQueryUnit, BSQLUnit;

Type

{ BExtObjectClass }

BExtObjectClass = Class(BObjectClass)
  Private
    bField: String;
  Public
    Property Field: String Read bField Write bField;
    Procedure Save;
    Constructor Build(Const aID: Integer; Const aCaption, aField: String);
    Destructor Burn;
End;

Type

{ BExtManagerClass }

BExtManagerClass = Class(BManagerClass)
  Private
    bExtObjects: TThreadList; Static;
  Public
    Procedure Load;
    Procedure Commit;
    Function AddExtObject(Const aCaption, aField: String): BExtObjectClass;
    Function GetExtObject(Const aID: Integer): BExtObjectClass;
    Constructor Build;
    Destructor Burn;
End;

Implementation

{ BExtManagerClass }

Function BExtManagerClass.AddExtObject(
  Const aCaption, aField: String): BExtObjectClass;
Begin
  Dec(bNonCommitedIndex);
  Result := BExtObjectClass.Build(bNonCommitedIndex, aCaption, aField);
  bNonCommited.Add(Result);
End;

Procedure BExtManagerClass.Load;
Var
  aList: TList;
Begin
  With BQueryClass.Build Do
    Begin
      aList := bExtObjects.LockList;
      aList.Clear;
      Get('SELECT ID, CAPTION, FIELD FROM BEXTOBJECTCLASS ORDER BY ID'); // Open
      While Not(EOF) Do
        Begin
          aList.Add(BExtObjectClass.Build(ByInteger('ID'), ByString('CAPTION'),
            ByString('FIELD')));
          Next;
        End;
      bExtObjects.UnlockList;
      Burn;
    End;
End;

Procedure BExtManagerClass.Commit;
Var
  i: Integer;
  aNonCommited, aExtObjects: TList;
Begin
  aNonCommited :=bNonCommited.LockList;
  aExtObjects := bExtObjects.LockList;
  For i := 0 To aNonCommited.Count - 1 Do
    Begin
      BExtObjectClass(aNonCommited[i]).Save;
      aExtObjects.Add(aNonCommited[i]);
    End;
  aNonCommited.Clear;
  bExtObjects.UnlockList;
  bNonCommited.UnlockList;
End;

Function BExtManagerClass.GetExtObject(Const aID: Integer): BExtObjectClass;
Begin
  Result := FindByID(bExtObjects, aID);
End;

Constructor BExtManagerClass.Build;
Begin
  Inherited Build;
End;

Destructor BExtManagerClass.Burn;
Begin
  Inherited Burn;
End;

{ BExtObjectClass }

Procedure BExtObjectClass.Save;
Var
  aSQL: BSQLClass;
Begin
  // Запросы обычно выносятся в именнованные константы в разделе ResourceString
  If ID < 0 Then
    aSQL := BSQLClass.Build('INSERT INTO BEXTOBJECTCLASS(ID, CAPTION, FIELD) ' +
      'VALUES(GEN_ID(GEN_BEXTOBJECTCLASS_ID, 1),:CAPTION, :FIELD) RETURNING ID')
  Else
    Begin
      aSQL := BSQLClass.Build('UPDATE OR INSERT INTO BEXTOBJECTCLASS VALUES(' +
        ':ID, :CAPTION, :FIELD)');
      aSQL.AddParam('ID', ID);
    End;
  aSQL.AddParam('CAPTION', Caption);
  aSQL.AddParam('FIELD', Field);
  With BQueryClass.Build Do
    Begin
      Post(aSQL); // ExecSql с расстановкой параметров из BSQLClass
      If ID < 0 Then bID := ByInteger('ID');
      aSQL.Burn;
      Go; // Commit
      Burn;
    End;
End;

Constructor BExtObjectClass.Build(Const aID: Integer; Const aCaption,
  aField: String);
Begin
  Inherited Build(aID, aCaption);
  bField := aField;
End;

Destructor BExtObjectClass.Burn;
Begin

End;

Var
  loop: Integer;

Initialization
Begin
  BExtManagerClass.bExtObjects := TThreadList.Create;
End;

Finalization
Begin
  With BExtManagerClass.bExtObjects.LockList Do
    For loop := 0 To Count - 1 Do
      BExtObjectClass(Items[i]).Burn;
  BExtManagerClass.bExtObjects.UnlockList;
  BExtManagerClass.bExtObjects.Free;
End;

End.

Вот ^_^ Здесь уже добавленные объекты не сразу становятся всем доступны, а только после Commit'a менеджера. Легким движением руки схожим образом организуется удаление объектов. Но как быть с изменениями? Т.е. если один пользователь изменил Caption или Field одного из объектов - это изменение разом увидят все, даже до Commit'а менеджера. Идея,которая у меня появилась - при попытке изменении какого либо свойства объекта:

создаётся копия объекта;
свойство меняется у копии;
копия выносится в отдельный список конкретного менеджера;
оригинальный объект помечается как Changed (новое свойство базового класса);
при выдаче объекта менеджером, производящим изменени, идёт проверка - если он помечен как Changed, то ему возвращается не оригинальный объект, а копия из списка.

При Commit'e идёт запись всех полей в копий во поля оригинальных объектов и список и список копий очищается. Если коммита не было - то все остальные пользователи ничего и не увидят (оригинальные объекты останутся нетронутыми).
Механизм мне очень понравился, но при реализации выявились проблемы - как подменить оригинальный объект копией для пользователя, производящего измерения? Пока у меня 3 варианта - все прямые доступы к полям через свойства заменить на Get* Set* и в них проверять - если есть изменения - возвращать копию с менеджера; второй - вообще оставить BObjectClass и производные только что чтения, а все правки производить только через менеджер, т.е.

Код: Выделить всё

...
BExtManagerClass = Class(BManagerClass)
  Private
    bExtObjects: TThreadList; Static;
  Public
    Function AddExtObject(Const aCaption, aField: String): BExtObjectClass;
    Procedure Load;
    Procedure Commit;
    Procedure ChangeField(Const aExtObject: BExtObjectClass; Const aField: String);
    Function GetExtObject(Const aID: Integer): BExtObjectClass;
    Constructor Build;
    Destructor Burn;
End;

третий - быть ответственным, и не менять свойства объектов BExtObjectClass просто так, а первоначально запрашивать у менеджера копию этого объекта:

Код: Выделить всё

...
BExtManagerClass = Class(BManagerClass)
  Private
    bExtObjects: TThreadList; Static;
  Public
    Procedure Load;
    Procedure Commit;
    Function AddExtObject(Const aCaption, aField: String): BExtObjectClass;
    Function GetExtObject(Const aID: Integer): BExtObjectClass;
    Function ChangeExtObject(Const aExtObject: BExtObjectClass): BExtObjectClass;
    Constructor Build;
    Destructor Burn;
End;

Буду очень рад другим вариантам, или предложениям - как лучше было бы организовать подобную конструкцию ^_^
Спасибо
// и извините за многословие...

vada · Сообщение **vada** » 12.05.2011 13:59:49

Посмотрите в сторону EJB (Enterprise Java Beans). Там все расписано как и чё.

PS. Все уже придумано до нас.

Brainenjii · Сообщение **Brainenjii** » 12.05.2011 14:13:40

Всколзь пробежался - сходу как в EJB решена моя проблема - не понял ^_^ Если можно - в двух словах?

Вечером почитаю посерьёзней

vada · Сообщение **vada** » 12.05.2011 15:33:50

Если на пальцах...
Образ записи Bean ОДИН. К нему только разный доступ ro/rw. Зависит от того, как первый клиент запросил бин из базы. Если ro, то и изменения ему никакие не можно, если rw, то остальным только ro, или ждать... (после коммита правило может поменяться) Вообще-то все гараздо сложнее.
Вообще есть варианты. Можно ведь и средствами SQL сервера проблему порешать. Типа SELECT FOR UPDATE...
Вообще-то лучше до колизий дело не доводить. Как показал опыт, сообщение, типа запись занята пользователем воспринимается как ошибка. Ждать он не хочет. Лучше разделить политикой доступа (ролями клиентов). У записи в любой момент ее жизни только один владелец, остальные только чтение, или у поля таблицы свой владелец... Например, PostgreSQL это позволяет.

Brainenjii · Сообщение **Brainenjii** » 16.05.2011 14:54:36

Продолжаем разговор ^_^
Вроде что-то уже начало получаться и даже работает... Принцип такой - есть управляющий и управляемые объекты(Manager и Object для сокращения). У Manager'a есть статический член - список всех Object'ов, и ещё 2 списка - для запрошенных на удаление и запрошенных на создание/изменение у конкретных Manager'ов, уже не статические.
У базового Manager'a есть несколько методов - загрузить объекты (Load), запросить на удаление(RequestDelete), запросить на изменение(RequestChange), запросить на создание(поставить в очередь на создание- RequestQueue), подтвердить изменения (Commit), получить объект (GetObject) и проверить объект (CheckObject).

Load выполняется пока при старте (в планах сделать загрузку по запросу), всем созданным объектам присваивается флаг Commited.
При запросах на создание/изменение/удаление создаётся копия целевого Object'а, помечается соответсвующим флагом (Deleted, New, Changed) и добавляется в соответствующие списки.
Commit проходит по всем спискам и выполняет ассоциированные действия - сохраняет/удаляет/создаёт, после чего возвращает изменения в статический список и очищает все "динамические".
Получить объект проходит сначала по списку удаленённых, и если там обнаруживается искомый объект - возвращает nil, затем по списку изменённых и возвращает копию реального объект, если находит), и наконец по статическому списку, общему для всех.
Проверить объект действует по аналогии с предыдущим методом - замещает объект на копию, в случае её наличия (или на nil, если объект удалён)

Вот... В рамках одного объекта - всё работает... Но как быть, если Object является полем совсем другого объекта. Ведь если при изменении одного объекта это изменение видно только этому. Значит все другие классы должны тоже иметь доступ к тому самому менеджеру... И все обращения к этим полям должны проходить через менеджер, чтобы сделать CheckObject?
Вот код (здесь ещё добавлен иерархический объект и вывод в формате JSON):

Код: Выделить всё

Unit BObjectUnit;

{$mode objfpc}{$H+}

Interface

Uses
  Classes, SysUtils, BQueryUnit, BCommonUnit;

Const
  DEFAULT_ID = -1;

Type BORMStateKind = (ormCommited, ormChanged, ormAdded, ormDeleted);

Type

{ BObjectClass }

BObjectClass = Class
  Private
    bORMState: BORMStateKind;
  Protected
    bID: Integer;
    Function BuildClone: BObjectClass; Virtual; Abstract;
    Procedure Load(Const aObject: BObjectClass); Virtual; Abstract;
    Function GetJSON: String; Virtual; Abstract;
  Public
    Property ID: Integer Read bID;
    Property ORMState: BORMStateKind Read bORMState;
    Property JSON: String Read GetJSON;
    Function Save(aQuery: BQueryClass): Boolean; Virtual; Abstract;
    Function Delete(aQuery: BQueryClass): Boolean; Virtual; Abstract;
    Constructor Build; Virtual; Abstract;
    Destructor Burn; Virtual; Abstract;
End;

Type

{ BTreeObjectClass }

BTreeObjectClass = Class(BObjectClass)
Private
  Procedure SetParent(Const aValue: BTreeObjectClass);
  Protected
    bParent: BTreeObjectClass;
    bChildren: TThreadList;
    Function GetNodeJSON: String; Virtual; Abstract;
  Public
    Property Parent: BTreeObjectClass Read bParent Write SetParent;
    Property NodeJSON: String Read GetNodeJSON;
End;

Type

{ BManagerClass }

BManagerClass = Class
  Private
    bModified: Boolean;
    Function FindByID(Const aList: TList; Const aID: Integer): BObjectClass;
    Function FindByID(Const aList: TThreadList;
      Const aID: Integer): BObjectClass;
    Procedure PurgeList(Const aList: TThreadList);
  Protected
    bDeleted: TThreadList;
    bManaged: TThreadList;
    bNonCommited: TThreadList;
    bDBIndex, bNonCommitedIndex: Integer;
    Procedure CheckObject(Var aObject: BObjectClass);
    Function RequestQueue(Const aObject: BObjectClass): Boolean; Virtual;
    Function RequestChange(Const aObject: BObjectClass): BObjectClass;
    Procedure RequestDelete(Const aObject: BObjectClass);
    Function GetObject(Const aID: Integer): BObjectClass;
  Public
    Function GetJSON: TStringList; Virtual;
    Function GetNodeJSON(Const aParentObject:BTreeObjectClass): String; Virtual;
    Procedure Commit; Virtual;
    Constructor Build(Const aManagedList: TThreadList;
      Const aDBIndex: Integer); Virtual;
    Destructor Burn; Virtual;
End;

Implementation

ResourceString
  STR_ORM_ERROR_GET = 'ORM object request error occurred. ID can''t be "-1"';
  STR_ORM_ERROR_BUILD = 'ORM queue build error occurred. ID should be "-1"';
  STR_ORM_ERROR_CHANGE = 'ORM change request error occurred. ID can''t be "-1"';
  STR_ORM_ERROR_DELETE = 'ORM delete request error occurred. ID can''t be "-1"';

{ BTreeObjectClass }

Procedure BTreeObjectClass.SetParent(Const aValue: BTreeObjectClass);
Begin
  If bParent = aValue Then Exit;
  If bORMState = ormCommited Then
    If Not(bParent = nil) Then bParent.bChildren.Remove(Self);
  bParent:=aValue;
  If Not(bParent = nil) Then bParent.bChildren.Add(Self);
End;

{ BManagerClass }

Function BManagerClass.FindByID(Const aList: TList;
  Const aID: Integer): BObjectClass;
Var
  i: Integer;
Begin
  Result := nil;
  For i := 0 To aList.Count - 1 Do
    If BObjectClass(aList[i]).ID = aID Then
      Begin
        Result := BObjectClass(aList[i]);
        Exit;
      End;
End;

Function BManagerClass.FindByID(Const aList: TThreadList;
  Const aID: Integer): BObjectClass;
Var
  i: Integer;
Begin
  If aID = -1 Then Exit;
  Result := FindByID(aList.LockList, aID);
  aList.UnlockList;
End;

Procedure BManagerClass.CheckObject(Var aObject: BObjectClass);
Var
  aBufferObject: BObjectClass;
Begin
  // check for nil/ID
  If (aObject = nil) Or (aObject.ID = -1) Then
    Raise Exception(STR_ORM_ERROR_BUILD);
  If Not(bModified) Then Exit;

  aBufferObject := FindByID(bDeleted, aObject.ID);
  If Not(aBufferObject = nil) Then aObject := nil;
  If aObject = nil Then Exit;
  aBufferObject := FindByID(bNonCommited, aObject.ID);
  If Not(aBufferObject = nil) Then aObject := aBufferObject
End;

Procedure BManagerClass.PurgeList(Const aList: TThreadList);
Var
  i: Integer;
Begin
  With aList.LockList Do
    For i := 0 To Count - 1 Do
      BObjectClass(Items[i]).Burn;
  aList.UnlockList;
  aList.Free;
End;

Function BManagerClass.RequestQueue(Const aObject: BObjectClass): Boolean;
Begin
  // Check for nil/ID and is the object requested for deleted
  If (aObject = nil) Or Not(aObject.ID = -1) Or
    Not(FindByID(bDeleted, aObject.ID) = nil) Then
    Raise Exception(STR_ORM_ERROR_BUILD);

  Dec(bNonCommitedIndex);
  aObject.bID := bNonCommitedIndex;
  aObject.bORMState := ormAdded;
  bNonCommited.Add(aObject);
  bModified := TRUE;
End;

Function BManagerClass.RequestChange(Const aObject: BObjectClass): BObjectClass;
Begin
  // Check for nil/ID and is the object requested for change/deleted
  If (aObject = nil) Or (aObject.ID = -1) Or
    Not(FindByID(bDeleted, aObject.ID) = nil) Then
    Raise Exception(STR_ORM_ERROR_CHANGE);

  Result := FindByID(bNonCommited, aObject.ID);
  If Result = nil Then
    Begin
      Result := aObject.BuildClone;
      Result.bORMState := ormChanged;
      bNonCommited.Add(aObject);
      bModified := TRUE;
    End;
End;

Procedure BManagerClass.RequestDelete(Const aObject: BObjectClass);
Var
  aClone: BObjectClass;
Begin
  // Check for nil/ID and is the object requested for change/deleted
  If (aObject = nil) Or (aObject.ID = -1) Or
    Not(FindByID(bDeleted, aObject.ID) = nil) Then
    Raise Exception(STR_ORM_ERROR_CHANGE);
  If FindByID(bDeleted, aObject.ID) = nil Then
    Begin
      aClone := aObject.BuildClone;
      aClone.bORMState := ormDeleted;
      bDeleted.Add(aClone);
      bModified := TRUE;
    End;
End;

Function BManagerClass.GetObject(Const aID: Integer): BObjectClass;
Begin
  Result := nil;
  If bModified Then
    Begin
      If Not(FindByID(bDeleted, aID) = nil) Then Exit;
      Result := FindByID(bNonCommited, aID);
    End;
  If Result = nil Then Result := FindByID(bManaged, aID);
End;

Function BManagerClass.GetJSON: TStringList;
Var
  i: Integer;
  aManaged, aNonCommited, aDeleted: TList;
  aObject, aNonCommitedObject: BObjectClass;
Begin
  Result := TStringList.Create;
  aManaged := bManaged.LockList;
  aNonCommited := bNonCommited.LockList;
  aDeleted := bDeleted.LockList;
  For i := 0 To aManaged.Count - 1 Do
    Begin
      aObject := BObjectClass(aManaged[i]);
      If bModified Then
        Begin
          If Not(FindByID(aDeleted, aObject.ID) = nil) Then Continue;
          aNonCommitedObject := FindByID(aNonCommited, aObject.ID);
          If Not(aNonCommitedObject = nil) Then aObject := aNonCommitedObject;
        End;
      Result.Add(aObject.JSON);
    End;
  bManaged.UnlockList;
  bDeleted.UnlockList;
  bNonCommited.UnlockList;
End;

Function BManagerClass.GetNodeJSON(Const aParentObject:BTreeObjectClass):String;
Var
  i: Integer;
  aObject: BTreeObjectClass;
  aChildren, aManaged: TList;
Begin
  Result := '';
  aChildren := TList.Create;
  If aParentObject = nil Then
    Begin
      aManaged := bManaged.LockList;
      For i := 0 To aManaged.Count - 1 Do
        If BTreeObjectClass(aManaged[i]).bParent = nil Then
          aChildren.Add(aManaged[i]);
      bManaged.UnlockList;
    End
  Else
    Begin
      SwapLists(aParentObject.bChildren.LockList, aChildren);
      aParentObject.bChildren.UnlockList;
    End;
  For i := aChildren.Count - 1 DownTo 0 Do
    Begin
      aObject := BTreeObjectClass(aChildren[i]);
      CheckObject(aObject);
      If aObject = nil Then aChildren.Delete(i)
      Else aChildren[i] := aObject;
    End;

  Result := '';
  For i := 0 To aChildren.Count - 1 Do
    Begin
      If Not(Result = '') Then Result += ',';
      Result += Format('{%s}', [BTreeObjectClass(aChildren[i]).NodeJSON]);
    End;
  Result := Format('[%s]', [Result]);
End;

Procedure BManagerClass.Commit;
Var
  i, aIndex: Integer;
  aAllRight: Boolean;
  aQuery: BQueryClass;
  aDeleted, aNonComitted, aManaged: TList;
  aObject, aDeletedObject, aManagedObject: BObjectClass;
Begin
  If Not(bModified) Then Exit;
  aQuery := BQueryClass.Build(bDBIndex);
  aDeleted := bDeleted.LockList;
  aNonComitted := bNonCommited.LockList;
  aManaged := bManaged.LockList;
  // Attempt to process all deletions
  For i := 0 To aDeleted.Count - 1 Do
    Begin
      aAllRight :=  BObjectClass(aDeleted[i]).Delete(aQuery);
      If Not(aAllRight) Then Break;
    End;
  For i := 0 To aNonComitted.Count - 1 Do
    If FindByID(bDeleted, BObjectClass(aNonComitted[i]).ID) = nil Then
      Begin
        aAllRight := BObjectClass(aNonComitted[i]).Save(aQuery);
        If Not(aAllRight) Then Break;
      End;
  aQuery.Go;
  aQuery.Burn;
  // Clean up NonCommited and Managed Lists for Deleted Items
  For i := 0 To aDeleted.Count - 1 Do
    Begin
      aDeletedObject := BObjectClass(aDeleted[i]);
      aNonComitted.Remove(aObject);
      aObject := FindByID(aNonComitted, aDeletedObject.ID);
      If Not(aObject = nil) Then aNonComitted.Remove(aObject);
    End;
  For i := 0 To aNonComitted.Count - 1 Do
    Begin
      aObject := BObjectClass(aNonComitted[i]);
      Case aObject.ORMState Of
        ormChanged:
          Begin
            aManagedObject := FindByID(aManaged, aObject.ID);
            If Not(aManagedObject = nil) Then aManagedObject.Load(aObject);
          End;
        ormAdded:
          Begin
            aManaged.Add(aObject);
          End;
      End;
    End;

  For i := 0 To aDeleted.Count - 1 Do
    BObjectClass(aDeleted[i]).Burn;

  aDeleted.Clear;
  aNonComitted.Clear;

  bManaged.UnlockList;
  bDeleted.UnlockList;
  bNonCommited.UnlockList;
  aQuery.Burn;
  bModified := FALSE;
End;

Constructor BManagerClass.Build(Const aManagedList: TThreadList;
  Const aDBIndex: Integer);
Begin
  bModified := FALSE;
  bDBIndex := aDBIndex;
  bManaged := aManagedList;
  bDeleted := TThreadList.Create;
  bNonCommited := TThreadList.Create;
  bNonCommitedIndex := -1;
End;

Destructor BManagerClass.Burn;
Begin
  PurgeList(bNonCommited);
  PurgeList(bDeleted);
End;

End.

vada · Сообщение **vada** » 17.05.2011 14:09:41

1) Я так понял что у Вас COMMIT выполняет сразу пачку транзакций, а если SQLсервер вам EXCEPTION вернет, вы куда откатываться будете?
2) Похоже, Вы совсем забыли про реляции.

Brainenjii · Сообщение **Brainenjii** » 17.05.2011 15:15:42

1. нет, объект класса BQueryClass все запросы выполняет в рамках одной транзакции:

Код: Выделить всё

Unit BQueryUnit;

{$mode objfpc}{$H+}

Interface

Uses
  {$IFDEF TDS}
    TDSCTDataBase,
  {$ENDIF}
  {$IFDEF UIB}
    uib, uiblib,
  {$ENDIF}
  {$IFDEF IBX}
    IBDatabase, IBSQL,
  {$ENDIF}
  Classes, SysUtils, BCommonUnit, BSQLUnit, LiteLCLProc;

Const
  STEP_MAX = 3;

  DB_FB = 1;
  DB_MS = 2;

Type

{ BQueryClass }

BQueryClass = Class
  Private
    bID, bKind: Integer;
    {$IFDEF UIB}
    bUIBQuery: TUIBQuery;
    bUIBDatabase: TUIBDataBase;
    bUIBWrite, bUIBRead: TUIBTransaction;
    {$ENDIF}
    {$IFDEF TDS}
    bTDSQuery: TTDSCTQuery;
    bTDSDatabase: TTDSCTDataBase;
    bTDSWrite, bTDSRead: TTDSCTTransaction;
    {$ENDIF}
    {$IFDEF IBX}
    bIBXQuery: TIBSQL;
    bIBXDatabase: TIBDataBase;
    bIBXWrite, bIBXRead: TIBTransaction;
    {$ENDIF}
    {$IFDEF UIB}
    Function GetUIB(Const aSQL: BSQLClass): Boolean;
    Function PostUIB(Const aSQL: BSQLClass): Boolean;
    {$ENDIF}
    {$IFDEF TDS}
    Function GetTDS(Const aSQL: BSQLClass): Boolean;
    Function PostTDS(Const aSQL: BSQLClass): Boolean;
    {$ENDIF}
    {$IFDEF IBX}
    Function GetIBX(Const aSQL: BSQLClass): Boolean;
    Function PostIBX(Const aSQL: BSQLClass): Boolean;
    {$ENDIF}
  Public
    Function ByString(Const aString: String): String;
    Function ByDouble(Const aString: String): Double;
    Function ByInteger(Const aString: String): Integer;
    Function ByInt64(Const aString: String): Int64;
    Function ByBoolean(Const aString: String): Boolean;
    Function ByDate(Const aString: String): TDateTime;
    Function ByDateTime(Const aString: String): TDateTime;
    Function Get(Const aSQL: BSQLClass): Boolean;
    Function Get(Const aString: String;
      Const ForExecute: Boolean = FALSE): Boolean;
    Function Post(Const aSQL: BSQLClass): Boolean;
    Function Post(Const aString: String;
      Const ForExecute: Boolean = FALSE): Boolean;
    Function EOF: Boolean;
    Procedure Go;
    Procedure Next;
    Procedure First;
    Constructor Build(Const aID: Integer = 0);
    Destructor Burn;
End;

Type

{ BDBManagerClass }

BDBManagerClass = Class
  Strict Private
    bPools: TThreadList;
  Public
    Procedure AddDatabase(Const aKind: Integer;
      Const aServer, aBase, aUser, aPassword: String; Const aLib:String='');
    Procedure RemoveDatabase(Const aIndex: Integer);
    Function GetKind(Const aIndex: Integer): Integer;
    Procedure Connect(Const aIndex: Integer = 0; Const aPoolSize: Integer = 1);
    {$IFDEF UIB}
    Procedure HoldUIBConnection(Const aIndex: Integer;
      Out aDatabase: TUIBDataBase; Out aRead, aWrite: TUIBTransaction);
    Procedure FreeUIBConnection(Const aIndex: Integer;
      Const aDatabase: TUIBDataBase);
    {$ENDIF}
    {$IFDEF TDS}
    Procedure HoldTDSConnection(Const aIndex: Integer;
      Out aDatabase: TTDSCTDataBase; Out aRead, aWrite: TTDSCTTransaction);
    Procedure FreeTDSConnection(Const aIndex: Integer;
      Const aDatabase: TTDSCTDataBase);
    {$ENDIF}
    {$IFDEF IBX}
    Procedure HoldIBXConnection(Const aIndex: Integer;
      Out aDatabase: TIBDataBase; Out aRead, aWrite: TIBTransaction);
    Procedure FreeIBXConnection(Const aIndex: Integer;
      Const aDatabase: TIBDataBase);
    {$ENDIF}
    Procedure Disconnect(Const aIndex: Integer = 0);
    Constructor Build;
    Destructor Burn;
End;

Var
  DBManager: BDBManagerClass;

Implementation

Const
  STR_MSSQL = '/usr/lib/libct.so';

Type

{ BConnectionClass }

BConnectionClass = Class
  Strict Private
    bBusy: Boolean;
    bKind: Integer;
    {$IFDEF UIB}
    bUIBDatabase: TUIBDataBase;
    bReadUIBTransaction: TUIBTransaction;
    bWriteUIBTransaction: TUIBTransaction;
    {$ENDIF}
    {$IFDEF TDS}
    bTDSDatabase: TTDSCTDataBase;
    bReadTDSTransaction: TTDSCTTransaction;
    bWriteTDSTransaction: TTDSCTTransaction;
    {$ENDIF}
    {$IFDEF IBX}
    bIBXDatabase: TIBDataBase;
    bReadIBXTransaction: TIBTransaction;
    bWriteIBXTransaction: TIBTransaction;
    {$ENDIF}
    Function GetConnected: Boolean;
  Public
    Property Kind: Integer Read bKind;
    Property Busy: Boolean Read bBusy;
    Property Connected: Boolean Read GetConnected;
    {$IFDEF UIB}
    Property UIBDatabase: TUIBDataBase Read bUIBDatabase;
    Procedure HoldUIBConnection(Out aDatabase: TUIBDataBase;
      Out aRead, aWrite: TUIBTransaction);
    Procedure FreeUIBConnection;
    {$ENDIF}
    {$IFDEF TDS}
    Property TDSDatabase: TTDSCTDataBase Read bTDSDatabase;
    Procedure HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
      Out aRead, aWrite: TTDSCTTransaction);
    Procedure FreeTDSConnection;
    {$ENDIF}
    {$IFDEF IBX}
    Property IBXDatabase: TIBDataBase Read bIBXDatabase;
    Procedure HoldIBXConnection(Out aDatabase: TIBDataBase;
      Out aRead, aWrite: TIBTransaction);
    Procedure FreeIBXConnection;
    {$ENDIF}
    Constructor Build(Const aKind: Integer;
      Const aServer, aBase, aUser, aPassword, aLib: String);
    Destructor Burn;
End;

Type

{ BConnectionsPoolClass }

BConnectionsPoolClass = Class
  Strict Private
    bConnected: Boolean;
    bPool: TThreadList;
    bBase: String;
    bKind: Integer;
    bLib: String;
    bPassword: String;
    bServer: String;
    bUser: String;
    bPoolDepth: Integer;
    {$IFDEF UIB}
    bUIBDatabase: TUIBDataBase;
    bReadUIBTransaction: TUIBTransaction;
    bWriteUIBTransaction: TUIBTransaction;
    {$ENDIF}
    {$IFDEF TDS}
    bTDSDatabase: TTDSCTDataBase;
    bReadTDSTransaction: TTDSCTTransaction;
    bWriteTDSTransaction: TTDSCTTransaction;
    {$ENDIF}
    {$IFDEF IBX}
    bIBXDatabase: TIBDataBase;
    bReadIBXTransaction: TIBTransaction;
    bWriteIBXTransaction: TIBTransaction;
    {$ENDIF}
  Public
    Property Kind: Integer Read bKind;
    Property Server: String Read bServer;
    Property Base: String Read bBase;
    Property User: String Read bUser;
    Property Password: String Read bPassword;
    Property Lib: String Read bLib;
    Property Connected: Boolean Read bConnected;
    Property PoolDepth: Integer Read bPoolDepth;
    {$IFDEF UIB}
    Property ReadUIBTransaction: TUIBTransaction Read bReadUIBTransaction;
    Property WriteUIBTransaction: TUIBTransaction Read bWriteUIBTransaction;
    Property UIBDatabase: TUIBDataBase Read bUIBDatabase;
    Procedure HoldUIBConnection(Out aDatabase: TUIBDataBase;
      Out aRead, aWrite: TUIBTransaction);
    Procedure FreeUIBConnection(Const aDatabase: TUIBDataBase);
    {$ENDIF}
    {$IFDEF TDS}
    Property ReadTDSTransaction: TTDSCTTransaction Read bReadTDSTransaction;
    Property WriteTDSTransaction: TTDSCTTransaction Read bWriteTDSTransaction;
    Property TDSDatabase: TTDSCTDataBase Read bTDSDatabase;
    Procedure HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
      Out aRead, aWrite: TTDSCTTransaction);
    Procedure FreeTDSConnection(Const aDatabase: TTDSCTDataBase);
    {$ENDIF}
    {$IFDEF IBX}
    Property ReadIBXTransaction: TIBTransaction Read bReadIBXTransaction;
    Property WriteIBXTransaction: TIBTransaction Read bWriteIBXTransaction;
    Property IBXDatabase: TIBDataBase Read bIBXDatabase;
    Procedure HoldIBXConnection(Out aDatabase: TIBDataBase;
      Out aRead, aWrite: TIBTransaction);
    Procedure FreeIBXConnection(Const aDatabase: TIBDataBase);
    {$ENDIF}
    Procedure Connect(Const aPoolDepth: Integer);
    Procedure Disconnect;
    Constructor Build(Const aKind: Integer;
      Const aServer, aBase, aUser, aPassword, aLib: String);
    Destructor Burn;
End;

{ BConnectionClass }

Function BConnectionClass.GetConnected: Boolean;
Begin
  Result := FALSE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}
      Result := Assigned(bUIBDatabase) And bUIBDatabase.Connected
      {$ENDIF}
      {$IFDEF IBX}
      Result := Assigned(bIBXDatabase) And bIBXDatabase.Connected
      {$ENDIF};
    DB_MS:
      {$IFDEF TDS}
      Result := Assigned(bTDSDatabase) And bTDSDatabase.Connected
      {$ENDIF};
  End;
End;

{$IFDEF IBX}
Procedure BConnectionClass.HoldIBXConnection(Out aDatabase: TIBDataBase; Out
  aRead, aWrite: TIBTransaction);
Begin
  aDatabase := bIBXDatabase;
  aRead := bReadIBXTransaction;
  aWrite := bWriteIBXTransaction;
  bBusy := TRUE;
End;

Procedure BConnectionClass.FreeIBXConnection;
Begin
  If bReadIBXTransaction.InTransaction Then bReadIBXTransaction.Commit;
  If bWriteIBXTransaction.InTransaction Then bWriteIBXTransaction.RollBack;
  bBusy := FALSE;
End;
{$ENDIF}

{$IFDEF UIB}
Procedure BConnectionClass.HoldUIBConnection(Out aDatabase: TUIBDataBase;
  Out aRead, aWrite: TUIBTransaction);
Begin
  aDatabase := bUIBDatabase;
  aRead := bReadUIBTransaction;
  aWrite := bWriteUIBTransaction;
  bBusy := TRUE;
End;

Procedure BConnectionClass.FreeUIBConnection;
Begin
  If bReadUIBTransaction.InTransaction Then bReadUIBTransaction.Commit;
  If bWriteUIBTransaction.InTransaction Then bWriteUIBTransaction.RollBack;
  bBusy := FALSE;
End;

{$ENDIF}

{$IFDEF TDS}
Procedure BConnectionClass.HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
  Out aRead, aWrite: TTDSCTTransaction);
Begin
  aDatabase := bTDSDatabase;
  aRead := bReadTDSTransaction;
  aWrite := bWriteTDSTransaction;
  bBusy := TRUE;
End;

Procedure BConnectionClass.FreeTDSConnection;
Begin
  If bReadTDSTransaction.Active Then bReadTDSTransaction.Commit;
  If bWriteTDSTransaction.Active Then bWriteTDSTransaction.Rollback;
  bBusy := FALSE;
End;

{$ENDIF}

Constructor BConnectionClass.Build(Const aKind: Integer; Const aServer, aBase,
  aUser, aPassword, aLib: String);
Begin
  bKind := aKind;
  Case Kind Of
    DB_FB:
      Begin
        {$IFDEF UIB}
        bUIBDatabase := TUIBDataBase.Create(nil);
        bUIBDatabase.DatabaseName := Format('%s:%s', [aServer, aBase]);
        bUIBDatabase.UserName := aUser;
        bUIBDatabase.PassWord := aPassword;
        bUIBDatabase.CharacterSet := csUTF8;
        If Not(aLib = '') Then bUIBDatabase.LibraryName := aLib;

        bReadUIBTransaction := TUIBTransaction.Create(nil);
        bReadUIBTransaction.DataBase := bUIBDatabase;
        bReadUIBTransaction.Options :=
          [tpRead, tpReadCommitted, tpNowait, tpRecVersion];

        bWriteUIBTransaction := TUIBTransaction.Create(nil);
        bWriteUIBTransaction.DataBase := bUIBDatabase;
        bWriteUIBTransaction.Options := [tpWrite, tpNowait];
        Try
          bUIBDatabase.Connected := TRUE;
        Except On E: Exception Do
          SafeLog(E.Message);
        End;
        {$ENDIF};
        {$IFDEF IBX}
        bIBXDatabase := TIBDataBase.Create(nil);
        bIBXDatabase.DatabaseName := Format('%s:%s', [aServer, aBase]);
        bIBXDatabase.Params.Add(Format('user_name=%s', [aUser]));
        bIBXDatabase.Params.Add(Format('password=%s', [aPassword]));
        bIBXDatabase.Params.Add('lc_ctype=UTF-8');
        bIBXDatabase.LoginPrompt := FALSE;

        bReadIBXTransaction := TIBTransaction.Create(nil);
        bReadIBXTransaction.DefaultDatabase := bIBXDatabase;
        bReadIBXTransaction.DefaultAction := TACommit;
        bReadIBXTransaction.Params.Add('read_committed');
        bReadIBXTransaction.Params.Add('rec_version');
        bReadIBXTransaction.Params.Add('nowait');

        bWriteIBXTransaction := TIBTransaction.Create(nil);
        bWriteIBXTransaction.DefaultDatabase := bIBXDatabase;
        bWriteIBXTransaction.DefaultAction := TARollback;
        bWriteIBXTransaction.Params.Add('write');
        bWriteIBXTransaction.Params.Add('consistency');

        Try
          bIBXDatabase.Connected := TRUE;
        Except On E: Exception Do
          SafeLog(E.Message);
        End;
        {$ENDIF}
      End;
    DB_MS:
      Begin
        {$IFDEF TDS}
        bTDSDatabase := TTDSCTDataBase.Create(nil);
        bTDSDatabase.ServerVersion := svMSSQL2008;
        bTDSDatabase.ServerName := aServer;
        bTDSDatabase.Database := aBase;
        bTDSDatabase.UserName := aUser;
        bTDSDatabase.Password := aPassword;
        bTDSDatabase.LibraryName := aLib;

        bReadTDSTransaction := TTDSCTTransaction.Create(nil);
        bReadTDSTransaction.DataBase := bTDSDatabase;

        bWriteTDSTransaction := TTDSCTTransaction.Create(nil);
        bWriteTDSTransaction.DataBase := bTDSDatabase;

        Try
          bTDSDatabase.Connected := TRUE;
        Except On E: Exception Do
          SafeLog(E.Message);
        End;
        {$ENDIF};
      End;
  End;
End;

Destructor BConnectionClass.Burn;
Begin
  Case bKind Of
    DB_FB:
      Begin
        {$IFDEF UIB}
        If bReadUIBTransaction.InTransaction Then bReadUIBTransaction.Commit;
        If bWriteUIBTransaction.InTransaction Then
          bWriteUIBTransaction.Rollback;
        bReadUIBTransaction.Free;
        bWriteUIBTransaction.Free;
        bUIBDatabase.Free;
        {$ENDIF};
        {$IFDEF IBX}
        If bReadIBXTransaction.InTransaction Then bReadIBXTransaction.Commit;
        If bWriteIBXTransaction.InTransaction THen
          bWriteIBXTransaction.Rollback;
        bReadIBXTransaction.Free;
        bWriteIBXTransaction.Free;
        bIBXDatabase.Free;
        {$ENDIF}
      End;
    DB_MS:
      Begin
        {$IFDEF TDS}
        If bReadTDSTransaction.Active Then bReadTDSTransaction.Commit;
        If bWriteTDSTransaction.Active Then bWriteTDSTransaction.Rollback;
        bReadTDSTransaction.Free;
        bWriteTDSTransaction.Free;
        bTDSDatabase.Free;
        {$ENDIF};
      End;
  End;
End;

{ BConnectionPoolClass }

{$IFDEF UIB}
Procedure BConnectionsPoolClass.HoldUIBConnection(Out aDatabase: TUIBDataBase;
  Out aRead, aWrite: TUIBTransaction);
Var
  i, aStep: Integer;
  aWasFound: Boolean;
  aConnection: BConnectionClass;
Begin
  aStep := 0;
  aWasFound := FALSE;
  With bPool.LockList Do
    Repeat
      For i := 0 To Count - 1 Do
        Begin
          aConnection := BConnectionClass(Items[i]);
          If Not(aConnection.Busy) Then
            Begin
              aConnection.HoldUIBConnection(aDatabase, aRead, aWrite);
              aWasFound := TRUE;
              Break;
            End;
          Inc(aStep);
          Sleep(20);
        End;
    Until aWasFound Or (aStep < STEP_MAX);
  bPool.UnlockList;
End;

Procedure BConnectionsPoolClass.FreeUIBConnection(
  Const aDatabase: TUIBDataBase);
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      If BConnectionClass(Items[i]).UIBDatabase = aDatabase Then
        Begin
          BConnectionClass(Items[i]).FreeUIBConnection;
          Break;
        End;
  bPool.UnlockList;
End;
{$ENDIF}

{$IFDEF TDS}
Procedure BConnectionsPoolClass.HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
  Out aRead, aWrite: TTDSCTTransaction);
Var
  i, aStep: Integer;
  aWasFound: Boolean;
  aConnection: BConnectionClass;
Begin
  aWasFound := FALSE;
  aStep := 0;
  With bPool.LockList Do
    Repeat
      For i := 0 To Count - 1 Do
        Begin
          aConnection := BConnectionClass(Items[i]);
          If Not(aConnection.Busy) Then
            Begin
              aConnection.HoldTDSConnection(aDatabase, aRead, aWrite);
              aWasFound := TRUE;
              Break;
            End;
          Inc(aStep);
          Sleep(20);
        End;
    Until aWasFound Or (aStep < STEP_MAX);
  bPool.UnlockList;
End;

Procedure BConnectionsPoolClass.FreeTDSConnection(
  Const aDatabase: TTDSCTDataBase);
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      If BConnectionClass(Items[i]).TDSDatabase = aDatabase Then
        Begin
          BConnectionClass(Items[i]).FreeTDSConnection;
          Break;
        End;
  bPool.UnlockList;
End;
{$ENDIF}

{$IFDEF IBX}
Procedure BConnectionsPoolClass.HoldIBXConnection(Out aDatabase: TIBDataBase;
  Out aRead, aWrite: TIBTransaction);
Var
  i, aStep: Integer;
  aWasFound: Boolean;
  aConnection: BConnectionClass;
Begin
  aWasFound := FALSE;
  aStep := 0;
  With bPool.LockList Do
    Repeat
      For i := 0 To Count - 1 Do
        Begin
          aConnection := BConnectionClass(Items[i]);
          If Not(aConnection.Busy) Then
            Begin
              aConnection.HoldIBXConnection(aDatabase, aRead, aWrite);
              aWasFound := TRUE;
              Break;
            End;
          Inc(aStep);
          Sleep(20);
        End;
    Until aWasFound Or (aStep < STEP_MAX);
  bPool.UnlockList;
End;

Procedure BConnectionsPoolClass.FreeIBXConnection(
  Const aDatabase: TIBDataBase);
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      If BConnectionClass(Items[i]).IBXDatabase = aDatabase Then
        Begin
          BConnectionClass(Items[i]).FreeIBXConnection;
          Break;
        End;
  bPool.UnlockList;
End;
{$ENDIF}

Procedure BConnectionsPoolClass.Connect(Const aPoolDepth: Integer);
Var
  i: Integer;
  aConnection: BConnectionClass;
Begin
  If Connected Then
    Begin
      Raise Exception.Create('Already Connected');
      Exit;
    End;
  If Not(PoolDepth = 0) Then SafeLog('Pool not empty on connect');
  bPoolDepth := 0;
  For i := 1 To aPoolDepth Do
    Begin
      aConnection := BConnectionClass.Build(Kind,Server,Base,User,Password,Lib);
      If aConnection.Connected Then
        Begin
          bPool.Add(aConnection);
          Inc(bPoolDepth);
        End;
    End;
  If Not(aPoolDepth=PoolDepth) Then SafeLog('Not all connections established');
  bConnected := TRUE;
End;

Procedure BConnectionsPoolClass.Disconnect;
Var
  i: Integer;
Begin
  With bPool.LockList Do
    Begin
      For i := 0 To Count - 1 Do
        BConnectionClass(Items[i]).Burn;
      bPoolDepth := 0;
      bConnected := FALSE;
      Clear;
    End;
  bPool.UnlockList
End;

Constructor BConnectionsPoolClass.Build(Const aKind: Integer; Const aServer, aBase,
  aUser, aPassword, aLib: String);
Begin
  bKind := aKind;
  bServer := aServer;
  bBase := aBase;
  bUser := aUser;
  bPassword := aPassword;
  bLib := aLib;
  bPool := TThreadList.Create;
End;

Destructor BConnectionsPoolClass.Burn;
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      BConnectionClass(Items[i]).Burn;
  bPool.UnlockList;
  bPool.Free;
End;

{  BQueryClass  }

Constructor BQueryClass.Build(Const aID: Integer);
Begin
  {$IFDEF UIB}
    bUIBQuery := TUIBQuery.Create(nil);
  {$ENDIF}
  {$IFDEF TDS}
    bTDSQuery := TTDSCTQuery.Create(nil);
  {$ENDIF}
  {$IFDEF IBX}
    bIBXQuery := TIBSQL.Create(nil);
  {$ENDIF}
  bID := aID;
  bKind := DBManager.GetKind(aID);
  Case bKind Of
    DB_FB:
      Begin
      {$IFDEF UIB}
        DBManager.HoldUIBConnection(aID, bUIBDatabase, bUIBRead,
          bUIBWrite);
        bUIBQuery.DataBase := bUIBDatabase;
      {$ENDIF}
      {$IFDEF IBX}
        DBManager.HoldIBXConnection(aID, bIBXDatabase, bIBXRead, bIBXWrite);
        bIBXQuery.Database := bIBXDatabase;
      {$ENDIF}
      End;

    DB_MS:
      Begin
      {$IFDEF TDS}
        DBManager.HoldTDSConnection(aID, bTDSDatabase, bTDSRead,
          bTDSWrite);
        bTDSQuery.DataBase := bTDSDatabase;
      {$ENDIF}
      End;
  End;
End;

Destructor BQueryClass.Burn;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}
      DBManager.FreeUIBConnection(bID, bUIBQuery.DataBase)
      {$ENDIF}
      {$IFDEF IBX}
      DBManager.FreeIBXConnection(bID, bIBXQuery.Database)
      {$ENDIF};
    DB_MS:
      {$IFDEF TDS}
      DBManager.FreeTDSConnection(bID, bTDSQuery.DataBase)
      {$ENDIF};
  End;
End;

{$IFDEF UIB}
Function BQueryClass.GetUIB(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
Begin
  Result := FALSE;
  With bUIBQuery Do
    Begin
      Transaction := bUIBRead;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      Params.Clear;
      SQL.Clear;
      SQL.Add(aSQL.SQL);
      For i := 0 To aSQL.Params.Count - 1 Do
        Params.ByNameAsString[BSQLParamClass(aSQL.Params[i]).Iterator] :=
          BSQLParamClass(aSQL.Params[i]).Value;
      Try
        If aSQL.IsProcedure Then Execute
        Else Open;
      Except On E: Exception Do
        Begin
          Log(SQL.Text);
          Log(E.Message);
        End;
      End;
    End;
  Result := TRUE;
End;

Function BQueryClass.PostUIB(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
  aParam: BSQLParamClass;
Begin
  Result := FALSE;
  With bUIBQuery Do
    Begin
      Transaction := bUIBWrite;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      Try
        Params.Clear;
        SQL.Text := aSQL.SQL;
        For i := 0 To aSQL.Params.Count - 1 Do
          Begin
            aParam := BSQLParamClass(aSQL.Params[i]);
            If aParam.Stream = nil Then
              Params.ByNameAsString[aParam.Iterator] :=  aParam.Value
            Else
              ParamsSetBlob(aParam.Iterator, aParam.Stream);
          End;
        If aSQL.IsProcedure Then Execute
        Else ExecSQL;
      Except On E: Exception Do
        Begin
          Log(SQL.Text);
          Log(E.Message);
          Transaction.Rollback;
          Exit;
        End;
      End;
    End;
  Result := TRUE;
End;
{$ENDIF}

{$IFDEF TDS}
Function BQueryClass.GetTDS(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
Begin
  Result := FALSE;
  With bTDSQuery Do
    Begin
      Transaction := bTDSRead;
      Params.Clear;
      SQL.Text := aSQL.SQL;
      For i := 0 To aSQL.Params.Count - 1 Do
        Params.ParamByName(BSQLParamClass(aSQL.Params[i]).Iterator).AsString :=
          BSQLParamClass(aSQL.Params[i]).Value;
      Try
        If aSQL.IsProcedure Then ExecSQL
        Else Open;
      Except On E: Exception Do
        Begin
          DirectLog(SQL.Text);
          Log(E.Message);
        End;
      End;
    End;
  Result := TRUE;
End;

Function BQueryClass.PostTDS(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
  aParam: BSQLParamClass;
Begin
  Result := FALSE;
  With bTDSQuery Do
    Begin
      Transaction := bTDSWrite;
      If Not(Transaction.Active) Then Transaction.StartTransaction;
      Try
        Params.Clear;
        SQL.Text := aSQL.SQL;
        For i := 0 To aSQL.Params.Count - 1 Do
          Begin
            aParam := BSQLParamClass(aSQL.Params[i]);
            // TODO: no blob support
            If aParam.Stream = nil Then
              ParamByName(aParam.Iterator).Value :=  aParam.Value;
          End;
        ExecSQL;
      Except On E: Exception Do
        Begin
          Log(SQL.Text);
          Log(E.Message);
          Transaction.Rollback;
          Exit;
        End;
      End;
    End;
  Result := TRUE;
End;
{$ENDIF}

{$IFDEF IBX}
Function BQueryClass.GetIBX(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
Begin
  Result := FALSE;
  With bIBXQuery Do
    Begin
      If Open Then Close;
      Database := bIBXDatabase;
      Transaction := bIBXRead;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      SQL.Text := aSQL.SQL;
      For i := 0 To aSQL.Params.Count - 1 Do
        Params.ByName(BSQLParamClass(aSQL.Params[i]).Iterator).AsString :=
          BSQLParamClass(aSQL.Params[i]).Value;
      Try
        ExecQuery;
      Except On E: Exception Do
        Begin
          SafeLog(SQL.Text);
          SafeLog(E.Message);
        End;
      End;
    End;
  Result := TRUE;
End;

Function BQueryClass.PostIBX(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
  aParam: BSQLParamClass;
Begin
  Result := FALSE;
  With bIBXQuery Do
    Begin
      Transaction := bIBXWrite;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      Try
        SQL.Text := aSQL.SQL;
        For i := 0 To aSQL.Params.Count - 1 Do
          Begin
            aParam := BSQLParamClass(aSQL.Params[i]);
            // TODO: no blob support
            If aParam.Stream = nil Then
              ParamByName(aParam.Iterator).Value :=  aParam.Value;
          End;
        ExecQuery;
      Except On E: Exception Do
        Begin
          SafeLog(SQL.Text);
          SafeLog(E.Message);
          Transaction.Rollback;
          Exit;
        End;
      End;
    End;
  Result := TRUE;
End;
{$ENDIF}

Function BQueryClass.ByString(Const aString: String): String;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsString[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsString{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsString[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByDouble(Const aString: String): Double;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsDouble[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsFloat{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsFloat[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByInteger(Const aString: String): Integer;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsInteger[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsInteger{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsInteger[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByInt64(Const aString: String): Int64;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsInt64[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsInt64{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsInt64[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByBoolean(Const aString: String): Boolean;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result:=bUIBQuery.Fields.ByNameAsBoolean[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsInteger=1{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsInteger[aString] = 1{$ENDIF};
  End;
End;

Function BQueryClass.ByDate(Const aString: String): TDateTime;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsDate[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsDateTime{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsDate[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByDateTime(Const aString: String): TDateTime;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsDateTime[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsDateTime{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsDateTime[aString]{$ENDIF};
  End;
End;

Function BQueryClass.Get(Const aSQL: BSQLClass): Boolean;
Begin
  Result := FALSE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := GetUIB(aSQL){$ENDIF}
      {$IFDEF IBX}Result := GetIBX(aSQL){$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := GetTDS(aSQL){$ENDIF};

  End;
End;

Function BQueryClass.Get(Const aString: String;
  Const ForExecute: Boolean = FALSE): Boolean;
Var
  aSQL: BSQLClass;
Begin
  aSQL := BSQLClass.Build(aString, ForExecute);
  Result := Get(aSQL);
  aSQL.Burn;
End;

Function BQueryClass.Post(Const aSQL: BSQLClass): Boolean;
Begin
  Result := FALSE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := PostUIB(aSQL){$ENDIF}
      {$IFDEF IBX}Result := PostIBX(aSQL){$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := PostTDS(aSQL){$ENDIF};
  End;
End;

Function BQueryClass.Post(Const aString: String;
  Const ForExecute: Boolean): Boolean;
Var
  aSQL: BSQLClass;
Begin
  aSQL := BSQLClass.Build(aString, ForExecute);
  Result := Post(aSQL);
  aSQL.Burn;
End;

Function BQueryClass.EOF: Boolean;
Begin
  Result := TRUE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Eof{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.EOF{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.Eof{$ENDIF};
  End;
End;

Procedure BQueryClass.Go;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}
        With bUIBQuery Do
          Begin
            Transaction := bUIBWrite;
            If Transaction.InTransaction Then Transaction.Commit;
          End{$ENDIF}
      {$IFDEF IBX}
        With bIBXQuery Do
          Begin
            Transaction := bIBXWrite;
            If Transaction.InTransaction Then Transaction.Commit;
          End{$ENDIF};
    DB_MS:
      {$IFDEF TDS}
        With bTDSQuery Do
          Begin
            Transaction := bTDSWrite;
            If Transaction.Active Then Transaction.Commit;
          End{$ENDIF};

  End;
End;

Procedure BQueryClass.Next;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}bUIBQuery.Next{$ENDIF}
      {$IFDEF IBX}bIBXQuery.Next{$ENDIF};
    DB_MS:
      {$IFDEF TDS}bTDSQuery.Next{$ENDIF};
  End;
End;

Procedure BQueryClass.First;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}bUIBQuery.First{$ENDIF}
      {$IFDEF IBX}Raise Exception.Create('Not implemented'){$ENDIF};
    DB_MS:
      {$IFDEF TDS}Raise Exception.Create('Not implemented'){$ENDIF};
  End;
End;

{ BDBManagerClass }

Constructor BDBManagerClass.Build;
Begin
  bPools := TThreadList.Create;
End;

Destructor BDBManagerClass.Burn;
Var
  i: Integer;
Begin
  With bPools.LockList Do
    For i := 0 To Count - 1 Do
      BConnectionsPoolClass(Items[i]).Burn;
  bPools.UnlockList;
  bPools.Free;
End;

Procedure BDBManagerClass.AddDatabase(Const aKind: Integer;
  Const aServer, aBase, aUser, aPassword: String; Const aLib: String);
Begin
  bPools.Add(
    BConnectionsPoolClass.Build(aKind, aServer, aBase, aUser, aPassword, aLib));
End;

Procedure BDBManagerClass.RemoveDatabase(Const aIndex: Integer);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  With bPools.LockList Do
    Begin
      aConnectionPool := BConnectionsPoolClass(Items[aIndex]);
      aConnectionPool.Burn;
      Delete(aIndex);
    End;
  bPools.UnlockList;
End;

Function BDBManagerClass.GetKind(Const aIndex: Integer): Integer;
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  Result := aConnectionPool.Kind;
End;

Procedure BDBManagerClass.Connect(Const aIndex: Integer;
  Const aPoolSize: Integer);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.Connect(aPoolSize);
End;

{$IFDEF IBX}
Procedure BDBManagerClass.HoldIBXConnection(Const aIndex: Integer;
  Out aDatabase: TIBDataBase; Out aRead, aWrite: TIBTransaction);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.HoldIBXConnection(aDatabase, aRead, aWrite);
End;

Procedure BDBManagerClass.FreeIBXConnection(Const aIndex: Integer;
  Const aDatabase: TIBDataBase);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.FreeIBXConnection(aDatabase);
End;
{$ENDIF}

{$IFDEF UIB}
Procedure BDBManagerClass.HoldUIBConnection(Const aIndex: Integer;
  Out aDatabase: TUIBDataBase; Out aRead, aWrite: TUIBTransaction);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.HoldUIBConnection(aDatabase, aRead, aWrite);
End;

Procedure BDBManagerClass.FreeUIBConnection(Const aIndex: Integer;
  Const aDatabase: TUIBDataBase);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.FreeUIBConnection(aDatabase);
End;

{$ENDIF}

{$IFDEF TDS}
Procedure BDBManagerClass.HoldTDSConnection(Const aIndex: Integer;
  Out aDatabase: TTDSCTDataBase; Out aRead, aWrite: TTDSCTTransaction);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.HoldTDSConnection(aDatabase, aRead, aWrite);
End;

Procedure BDBManagerClass.FreeTDSConnection(Const aIndex: Integer;
  Const aDatabase: TTDSCTDataBase);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.FreeTDSConnection(aDatabase);
End;
{$ENDIF}

Procedure BDBManagerClass.Disconnect(Const aIndex: Integer);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.Disconnect;
End;

Initialization
Begin
  DBManager := BDBManagerClass.Build;
End;

Finalization
Begin
  DBManager.Burn;
End;

End.

это моя обёртка над UIB, FreeTDS и, теперь, IBX, позволяющая в некотором смысле забыть о транзакциях/соединениях/библиотеках доступа (в мечтах приделать в неё бекэнд для PostgreSQL и SQLite). Пока далёк от идеала, но если пользоваться зная опасные места - то работает ^_^ Уже довольно успешно во всех моих проектах с БД. На каких-нибудь праздниках соберусь и избавлюсь от глобальных переменных, откорректирую реализацию "ConnectionPool'a" и т.д. Но и сейчас оно работает и уже дважды мне позволила без переписывания проектов поменять библиотеку общения с базой ^_^
2. Под "реляциями" понимаются ссылки между объектами? Если да, то не забыл и именно их имел в виду под "...как быть, если Object является полем совсем другого объекта...". Пока решил волевым решением - одновременно должна меняться только одна сущность (объекты одного управляемого класса). Все остальные части программы должны видеть только то, что было "закоммичено". Если же вдруг потребуется доступ к информации об изменениях, сделанных до вызова Commit, то нужно пересмотреть логику программы - нельзя ли каким-то образом избежать этого требования, затем

либо всеми правдами и неправдами добираться до Manager'а, производящего изменения и все обращения к "реляциям" (если я не ошибся выше ^_^) прогонять через CheckObject;
либо добавить ещё глобальную надстройку, в которой буду регистрировать все изменения, вместе с изменяющими менеджерами и прогонять все те же "реляции" через эту надстройку, по возможности наименее заметно;
либо рвать себе все волосы на всех местах и отказываться от чуда объектов и мечт о лёгкой и ненапряжной ORM системе ^_^

Как-то так... Сейчас вроде как закончил тестирование на одной паре унаследованных от этих базовых классов объектах - пока они работают ^_^ Перехожу к классам с ссылкой на уже обновленное ^_^ Сейчас базовый класс выглядит так -

Код: Выделить всё

Unit BObjectUnit;

{$mode objfpc}{$H+}

Interface

Uses
  Classes, SysUtils, BQueryUnit, BCommonUnit;

Const
  DEFAULT_ID = -1;

Type BORMStateKind = (ormUnknow, ormCommited, ormChanged, ormAdded, ormDeleted);

Type

{ BObjectClass }

BObjectClass = Class
  Private
    bORMState: BORMStateKind;
  Protected
    bID: Integer;
    Procedure Load(Const aObject: BObjectClass); Virtual; Abstract;
    Function BuildClone: BObjectClass; Virtual; Abstract;
    Function GetJSON: String; Virtual; Abstract;
  Public
    Property ID: Integer Read bID;
    Property ORMState: BORMStateKind Read bORMState;
    Property JSON: String Read GetJSON;
    Function Save(aQuery: BQueryClass = nil): Boolean; Virtual; Abstract;
    Function Delete(aQuery: BQueryClass = nil): Boolean; Virtual; Abstract;
    Constructor Build; Virtual;
    Destructor Burn; Virtual; Abstract;
End;

Type

{ BTreeObjectClass }

BTreeObjectClass = Class(BObjectClass)
Private
  Procedure SetParent(Const aValue: BTreeObjectClass);
  Protected
    bParent: BTreeObjectClass;
    bChildren: TThreadList;
    Function GetNodeJSON: String; Virtual; Abstract;
  Public
    Property Parent: BTreeObjectClass Read bParent Write SetParent;
    Property NodeJSON: String Read GetNodeJSON;
End;

Type

{ BManagerClass }

BManagerClass = Class
  Private
    bModified: Boolean;
    Function FindByID(Const aList: TList; Const aID: Integer): BObjectClass;
    Function FindByID(Const aList: TThreadList;
      Const aID: Integer): BObjectClass;
    Procedure PurgeList(Const aList: TThreadList);
  Protected
    bDeleted: TThreadList;
    bManaged: TThreadList;
    bNonCommited: TThreadList;
    bDBIndex, bNonCommitedIndex: Integer;
    Procedure AfterLoad;
    Procedure CheckObject(Var aObject: BObjectClass);
    Function RequestQueue(Const aObject: BObjectClass): Boolean; Virtual;
    Function RequestChange(Const aObject: BObjectClass): BObjectClass;
    Procedure RequestDelete(Const aObject: BObjectClass);
    Function RequestObject(Const aID: Integer): BObjectClass;
    Procedure ProcessCommit(Const aObject: BObjectClass;
      Const aORMState: BORMStateKind); Virtual; Abstract;
  Public
    Function GetJSON: TStringList; Virtual;
    Function Extract(aCommaSeparatedObjects: String): TList;
    Function GetNodeJSON(Const aParentObject:BTreeObjectClass): String; Virtual;
    Procedure Commit; Virtual;
    Constructor Build(Const aManagedList: TThreadList;
      Const aDBIndex: Integer); Virtual;
    Destructor Burn; Virtual;
End;

Implementation

ResourceString
  STR_ORM_ERROR_GET = 'ORM object request error occurred. ID can''t be "-1"';
  STR_ORM_ERROR_BUILD = 'ORM queue build error occurred. ID should be "-1"';
  STR_ORM_ERROR_CHANGE = 'ORM change request error occurred. ID can''t be "-1"';
  STR_ORM_ERROR_DELETE = 'ORM delete request error occurred. ID can''t be "-1"';

{ BObjectClass }

Constructor BObjectClass.Build;
Begin
  bORMState := ormCommited;
End;

{ BTreeObjectClass }

Procedure BTreeObjectClass.SetParent(Const aValue: BTreeObjectClass);
Begin
  If bORMState = ormCommited Then
    If Not(bParent = nil) Then bParent.bChildren.Remove(Self);
  bParent:=aValue;
  If bORMState = ormCommited Then
    If Not(bParent = nil) Then bParent.bChildren.Add(Self);
End;

{ BManagerClass }

Function BManagerClass.FindByID(Const aList: TList;
  Const aID: Integer): BObjectClass;
Var
  i: Integer;
Begin
  Result := nil;
  For i := 0 To aList.Count - 1 Do
    If BObjectClass(aList[i]).ID = aID Then
      Begin
        Result := BObjectClass(aList[i]);
        Exit;
      End;
End;

Function BManagerClass.FindByID(Const aList: TThreadList;
  Const aID: Integer): BObjectClass;
Var
  i: Integer;
Begin
  Result := nil;
  If aID = -1 Then Exit;
  Result := FindByID(aList.LockList, aID);
  aList.UnlockList;
End;

Procedure BManagerClass.CheckObject(Var aObject: BObjectClass);
Var
  aBufferObject: BObjectClass;
Begin
  // check for nil/ID
  If (aObject = nil) Or (aObject.ID = -1) Then
    Raise Exception(STR_ORM_ERROR_BUILD);
  If Not(bModified) Then Exit;

  aBufferObject := FindByID(bDeleted, aObject.ID);
  If Not(aBufferObject = nil) Then aObject := nil;
  If aObject = nil Then Exit;
  aBufferObject := FindByID(bNonCommited, aObject.ID);
  If Not(aBufferObject = nil) Then aObject := aBufferObject
End;

Procedure BManagerClass.PurgeList(Const aList: TThreadList);
Var
  i: Integer;
Begin
  With aList.LockList Do
    For i := 0 To Count - 1 Do
      BObjectClass(Items[i]).Burn;
  aList.UnlockList;
  aList.Free;
End;

Procedure BManagerClass.AfterLoad;
Var
  i: Integer;
Begin
  With bManaged.LockList Do
    For i := 0 To Count - 1 Do
      BObjectClass(Items[i]).bORMState := ormCommited;
  bManaged.UnlockList;
End;

Function BManagerClass.RequestQueue(Const aObject: BObjectClass): Boolean;
Begin
   //Check for nil/ID and is the object requested for deleted
  If (aObject = nil) Or Not(aObject.ID = -1) Or
    Not(FindByID(bDeleted, aObject.ID) = nil) Then
    Raise Exception(STR_ORM_ERROR_BUILD);

  Dec(bNonCommitedIndex);
  aObject.bID := bNonCommitedIndex;
  aObject.bORMState := ormAdded;
  bNonCommited.Add(aObject);
  bModified := TRUE;
End;

Function BManagerClass.RequestChange(Const aObject: BObjectClass): BObjectClass;
Begin
  // Check for nil/ID and is the object requested for change/deleted
  If (aObject=nil) Or (aObject.ID = -1) Or
    Not(FindByID(bDeleted, aObject.ID) = nil) Then
    Raise Exception(STR_ORM_ERROR_CHANGE);

  Result := FindByID(bNonCommited, aObject.ID);
  If Result = nil Then
    Begin
      If Not(aObject.ORMState = ormCommited) Then
        Begin
          Raise Exception(STR_ORM_ERROR_CHANGE);
          Exit;
        End;
      Result := aObject.BuildClone;
      Result.bORMState := ormChanged;
      bNonCommited.Add(Result);
      bModified := TRUE;
    End;
End;

Procedure BManagerClass.RequestDelete(Const aObject: BObjectClass);
Var
  aClone: BObjectClass;
Begin
  // Check for nil/ID and is the object requested for change/deleted
  If (aObject = nil) Or (aObject.ID = -1) Or
    Not(FindByID(bDeleted, aObject.ID) = nil) Then
    Raise Exception(STR_ORM_ERROR_CHANGE);
  If FindByID(bDeleted, aObject.ID) = nil Then
    Begin
      aClone := aObject.BuildClone;
      aClone.bORMState := ormDeleted;
      bDeleted.Add(aClone);
      bModified := TRUE;
    End;
End;

Function BManagerClass.RequestObject(Const aID: Integer): BObjectClass;
Begin
  Result := nil;
  If bModified Then
    Begin
      If Not(FindByID(bDeleted, aID) = nil) Then Exit;
      Result := FindByID(bNonCommited, aID);
    End;
  If Result = nil Then Result := FindByID(bManaged, aID);
End;

Function BManagerClass.GetJSON: TStringList;
Var
  i: Integer;
  aManaged, aNonCommited, aDeleted: TList;
  aObject, aNonCommitedObject: BObjectClass;
Begin
  Result := TStringList.Create;
  aManaged := bManaged.LockList;
  aNonCommited := bNonCommited.LockList;
  aDeleted := bDeleted.LockList;
  For i := 0 To aManaged.Count - 1 Do
    Begin
      aObject := BObjectClass(aManaged[i]);
      If bModified Then
        Begin
          If Not(FindByID(aDeleted, aObject.ID) = nil) Then Continue;
          aNonCommitedObject := FindByID(aNonCommited, aObject.ID);
          If Not(aNonCommitedObject = nil) Then aObject := aNonCommitedObject;
        End;
      Result.Add(aObject.JSON);
    End;
  bManaged.UnlockList;
  bDeleted.UnlockList;
  bNonCommited.UnlockList;
End;

Function BManagerClass.Extract(aCommaSeparatedObjects: String): TList;
Var
  lol: String;
  aID, aIndex: Integer;
  aObject: BObjectClass;
Begin
  Result := TList.Create;
  While Not(aCommaSeparatedObjects = '') Do
    Begin
      aIndex := Pos(',', aCommaSeparatedObjects);
      If aIndex = 0 Then
        Begin
          lol := aCommaSeparatedObjects;
          aCommaSeparatedObjects := '';
        End
      Else
        Begin
          lol := Copy(aCommaSeparatedObjects, 1, aIndex - 1);
          Delete(aCommaSeparatedObjects,1, Pos(',', aIndex));
        End;
      aID := StrToIntDef(lol, -1);
      If aID = -1 Then Continue;
      aObject := RequestObject(aID);
      If Not(aObject = nil) Then Result.Add(aObject);
    End;
End;

Function BManagerClass.GetNodeJSON(Const aParentObject:BTreeObjectClass):String;
Var
  i: Integer;
  aObject: BTreeObjectClass;
  aChildren, aManaged: TList;
Begin
  Result := '';
  aChildren := TList.Create;
  If aParentObject = nil Then
    Begin
      aManaged := bManaged.LockList;
      For i := 0 To aManaged.Count - 1 Do
        If BTreeObjectClass(aManaged[i]).bParent = nil Then
          aChildren.Add(aManaged[i]);
      bManaged.UnlockList;
    End
  Else
    Begin
      SwapLists(aParentObject.bChildren.LockList, aChildren);
      aParentObject.bChildren.UnlockList;
    End;
  For i := aChildren.Count - 1 DownTo 0 Do
    Begin
      aObject := BTreeObjectClass(aChildren[i]);
      CheckObject(aObject);
      If aObject = nil Then aChildren.Delete(i)
      Else aChildren[i] := aObject;
    End;

  Result := '';
  For i := 0 To aChildren.Count - 1 Do
    Begin
      If Not(Result = '') Then Result += ',';
      Result += Format('{%s}', [BTreeObjectClass(aChildren[i]).NodeJSON]);
    End;
  Result := Format('[%s]', [Result]);
End;

Procedure BManagerClass.Commit;
Var
  i, aIndex: Integer;
  aAllRight: Boolean;
  aQuery: BQueryClass;
  aDeleted, aNonComitted, aManaged: TList;
  aObject, aDeletedObject, aManagedObject: BObjectClass;
Begin
  If Not(bModified) Then Exit;
  aQuery := BQueryClass.Build(bDBIndex);
  aDeleted := bDeleted.LockList;
  aNonComitted := bNonCommited.LockList;
  aManaged := bManaged.LockList;

  // Attempt to process all deletions
  For i := 0 To aDeleted.Count - 1 Do
    Begin
      // If ID negative then skip - it should me remove at NonCommited check
      If BObjectClass(aDeleted[i]).ID > DEFAULT_ID Then
        aAllRight :=  BObjectClass(aDeleted[i]).Delete(aQuery);
      If Not(aAllRight) Then Break;
    End;
  // Attempt to process all NonCommited Objects
  For i := 0 To aNonComitted.Count - 1 Do
    If FindByID(bDeleted, BObjectClass(aNonComitted[i]).ID) = nil Then
      Begin
        aAllRight := BObjectClass(aNonComitted[i]).Save(aQuery);
        If Not(aAllRight) Then Break;
      End;
  aQuery.Go;
  aQuery.Burn;

  // Clean up NonCommited and Managed Lists for Deleted Items
  For i := 0 To aDeleted.Count - 1 Do
    Begin
      aDeletedObject := BObjectClass(aDeleted[i]);
      aNonComitted.Remove(aDeletedObject);
      aObject := FindByID(aNonComitted, aDeletedObject.ID);
      If Not(aObject = nil) Then
        Begin
          aNonComitted.Remove(aObject);
          aObject.Burn;
        End;
      aManaged.Remove(aDeletedObject);
      aObject := FindByID(aManaged, aDeletedObject.ID);
      If Not(aObject = nil) Then
        Begin
          aManaged.Remove(aObject);
          aObject.Burn;
        End;
    End;
  // Apply changes of NonCommited Items to Managed Items
  For i := 0 To aNonComitted.Count - 1 Do
    Begin
      aObject := BObjectClass(aNonComitted[i]);
      Case aObject.ORMState Of
        ormChanged:
          Begin
            aManagedObject := FindByID(aManaged, aObject.ID);
            If Not(aManagedObject = nil) Then aManagedObject.Load(aObject);
            aObject.Burn;
            ProcessCommit(aManagedObject, ormChanged);
          End;
        ormAdded:
          Begin
            aObject.bORMState := ormCommited;
            aManaged.Add(aObject);
            ProcessCommit(aObject, ormAdded);
          End;
      End;
    End;

  For i := 0 To aDeleted.Count - 1 Do
    BObjectClass(aDeleted[i]).Burn;

  aDeleted.Clear;
  aNonComitted.Clear;

  bManaged.UnlockList;
  bDeleted.UnlockList;
  bNonCommited.UnlockList;
  bModified := FALSE;
End;

Constructor BManagerClass.Build(Const aManagedList: TThreadList;
  Const aDBIndex: Integer);
Begin
  bModified := FALSE;
  bDBIndex := aDBIndex;
  bManaged := aManagedList;
  bDeleted := TThreadList.Create;
  bNonCommited := TThreadList.Create;
  bNonCommitedIndex := -1;
End;

Destructor BManagerClass.Burn;
Begin
  PurgeList(bNonCommited);
  PurgeList(bDeleted);
End;

End.

vada · Сообщение **vada** » 18.05.2011 09:48:55

Я вот не пойму, это вы пишите для сервера приложений, или для клиента? Как-то в кучу кони/люди...

Brainenjii · Сообщение **Brainenjii** » 18.05.2011 09:57:36

Это ближе к серверу приложений - веб-сервер. Клиенты - браузеры, в них только вывод

vada · Сообщение **vada** » 18.05.2011 12:56:57

Посмотрите концепцию MVC (Model View Control), полегче будет.

Brainenjii · Сообщение **Brainenjii** » 18.05.2011 16:17:56

Вообще-то, эти два класса и создавались, чтобы систематизировать M из MVC (по-крайней мере в моей реализации этой концепции)...

Шурик Сетевой · 18.05.2011 17:23:25

Прочел, но многого не понял. Вы изобретаете ORM с кешированием? Вам требуется совместить кэширование сущностей в сервере приложений с разруливанием конфликтов при обновлении записей в БД?

vada · Сообщение **vada** » 19.05.2011 09:54:07

2 Шурик Сетевой
Просто Божественному Убийце лень читать книжки. Да и понятно. Книжка по EJB толстенная, страниц 600 с описанием классов. А свой шестиколесный велик с квадратными колесами хочется

Да и пусть себе. Это нормально.

Brainenjii · Сообщение **Brainenjii** » 19.05.2011 10:31:15

Я люблю читать книжки ^_^ Правда 600 страниц описания классов книжкой назвать сложно и читать такое действительно лень. Но по общим описаниям - да, нечто подобное я и хочу сделать, но основная моя цель - не добиться максимальной надёжности через строгую систему классов (причём достаточно сложных), а напротив - добиться того, чтобы мне потребовалось как можно меньше кода для реализации нужной мне логики ^_^ Как, например, сейчас - мне достаточно перекрыть 6 методов (2 управляемого и 4 управляющего) - и я получаю работающий механизм Commit'а изменений в базу (правда пока при использовании в голове крутится что-то вроде "как на соплях" ^_^) Притом, перекрытие нужно в основном для удобства и приведения типов.
2Шурик Сетевой: да, я действительно хочу (в конечном итоге) построить ORM с кешированием. Правда о разруливании конфликтов речи ещё нет ^_^

vada · Сообщение **vada** » 19.05.2011 13:22:38

Ассинхронные запросы вас доконают

Правда о разруливании конфликтов речи ещё нет ^_^

Непродуманная архитектура, обычно, приводит к полной переработке всего кода.

У меня довно бродит мысль реализовать на паскале EJB3. Все для этого в языке есть. Ну пусть не EJB, хотябы JPA2 для начала.
Увидив Ваш первый пост, думал: - Ну вот! Единомышленника нашел. Вдвоем легче поднять...
Не удалось обратить в истинную веру

Ну да ладно. Буду дальше мечтать. Мне одному такую махину не поднять

FreePascal.ru

Commit для изменений свойств объектов

Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов

Re: Commit для изменений свойств объектов