Не знаю даже как начать - появилась сегодня идея по изменению свойств объектов во многопользовательском приложении, показалась интересной, но при реализации возникли проблемы.
В общем ^_^ Во всех работающих с БД проектах встречается следующая конструкция: есть объект и отражение его в БД записью в ассоциированой таблице. Что-то вроде недо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, то ему возвращается не оригинальный объект, а копия из списка.
Механизм мне очень понравился, но при реализации выявились проблемы - как подменить оригинальный объект копией для пользователя, производящего измерения? Пока у меня 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;
Буду очень рад другим вариантам, или предложениям - как лучше было бы организовать подобную конструкцию ^_^
Спасибо
// и извините за многословие...
Вечером почитаю посерьёзней
Да и пусть себе. Это нормально.