Всем привет.
Хочу поделиться небольшой задачкой, которую пришлось выполнить по одному из проектов.
Заказчик просит добавить в достаточно сложную настройку (Параметры запаса) дополнительно два аналитических поля. По сути, это количество SKU, которые затрагивает строчка настройки. Слева у пользователя расположено дерево товарной иерархии, где на любом уровне можно на вкладе «Поставщик->Точки снабжения» для определенного поставщика - выставить нужные параметры, которые потом влияют на финальные результаты. Такого рода иерархичные настройки достаточно сложны, поэтому есть ряд функциональных примочек, которые помогают сделать навигацию по товарным уровням удобным и интуитивным понятным. Например, помечаются на каких уровнях сделаны настройки или что внутри узла есть нижестоящий узел, где это уже сделано и т.п. Да и получения данных достаточно нетривиально, потому что на каждом товарном уровне есть еще возможность установки настроек перекрытия, которые аффектят все нижестоящие уровни и также в каждом блоке настроек по поставщикам есть значение по-умолчанию, которые становятся применимыми, если не включены настройки конкретного поставщика. В итоге для всех строчек все равно указываются финальные данные, которые могут получаться и путем ввода начальных данных по самой активной строке или к ней применяются финальные данные исходя из всех возможных перекрытий выше или значения по-умолчанию.
Поэтому добавление дополнительных расчетных параметров в запросы на визуализацию уже текущего представления в мои планы не входило, не хотелось портить время отклика, когда пользователь выбирает нужный ему товарный уровень, да и время выполнения новых запросов было весьма эмпирическим. Возможность получения этих аналитик по какой-либо кнопке Заказчик отверг. В голову пришла достаточно простая вещь, сделать механизм для асинхронного добавления этих данных, как в браузерах, когда появляется основной контент, потом по мере прогрузки детали. При чем сделать механизм универсальным, чтобы при возможности использовать и в других интерфейсах и задать базу для дальнейшего развития этого механизма в будущем и выполнить это все в самые короткие сроки, Заказчик дал на эту задачу лишь три часа трудозатрат. Процессы обновления данных на визуалке асинхронными потоками уже был достаточно развит в проекте и применялся, а такой фишки пока не было. И так, поехали, схема MVP…
Все формы в проекте наследованы от общих классов, у меня есть иерархия этих классов, от базовых к более универсальным и функциональным. На текущий момент она такая:
Реализацию делаю на уровне TSpicaApplWindow, любая форма проекта наследована как минимум от нее. Механизм рождается в голове быстро. Формируем две очереди (контейнеры):
· FAsRequestCont для регистрации сообщений на асинхронное выполнение в БД;
· FAsResponCont для хранения полученных данных из БД.
Основной поток будет регистрировать в FAsRequestCont запрос с новым ID и нужными параметрами для выполнения SQL, служебный процесс (исполнитель) будет выбирать из FAsRequestCont запросы, причем самый последний, удаляя остальные (ведь только последний является актуальным). С контейнером FAsResponCont все ровно наоборот, служебный процесс (исполнитель) будет «писать» результаты выполненного SQL, а приложение его «читать». Опять же можно было обойтись и одной очередью, но так, мне кажется, все же архитектурно более верно. Для синхронизации очередей буду использовать две критические секции (можно и одной обойтись, но мало ли, может в дальнейшем я трансформирую это в что-то более сложное), сообщение в двух очередях будет оформлено одним новым классом.
Алгоритм. Пользователь осуществляет навигацию по контролам или нажимает кнопку «Обновить», в методе на получение и обновления данных для грида я добавляю регистрацию нового запроса на получение данных в асинхронном режиме. Причем для приложения актуален самый последний запрос, все что было до этого уже не нужно. Служебный поток просматривает постоянно очередь запросов и видя, что там появился новый запрос, начинает его выполнять. По окончанию результаты запроса (dataset) кладутся в очередь на ответы и служебный процесс уведомляет приложение об этом посредством асинхронной передачи оконного сообщения. Приложение, получив оконное сообщение, сравнивает его со своим актуальным ID запроса и, если оно еще «не протухло», обновляет контейнер данных для грида этими данными.
Код. Новый класс TSpicaAsyncReadTh, наследован от TThread, который будет выполнять роль служебного процесса исполнителя. Добавляю в него ссылку на владельца – окно TSpicaApplWindow. В конструктор передается сразу ссылку на владельца, метод Execute пока пустой.
TSpicaAsyncReadTh = class(TThread)
protected
FOwner: TSpicaApplWindow; //Ссылка на владельца
public
procedure Execute; override;
constructor Create(Owner: TSpicaApplWindow);
end;
constructor TSpicaAsyncReadTh.Create(Owner: TSpicaApplWindow);
begin
FOwner := Owner;
inherited Create(true);
enКласс TSpicaApplWindow новые атрибуты:
FAsRequestCS, FAsResponCS: TCriticalSection; //Критические секции
FAsRequestId: TAsRequestId; // Актуальный номер запроса
FAsRequestCont, FAsResponCont: TMyObjectList; // Контейнеры очередей
FAsyncReadTh: TSpicaAsyncReadTh; //Служебный процессКлассы TMyObjectList наследованы от TList, главная их задача хранение экземпляров классов и их освобождение при удалении или очистке и кое какой иной функционал, который к данной теме отношения не имеет. Обратите внимание, что для ID запроса использую кастомный тип TAsRequestId, хотя его тип простой TAsRequestId = integer, но считаю это признаком хорошего кода, приходилось обжигаться в прошлом, когда приходилось менять типизацию по бизнес атрибутам с целочисленного на строки (как пример) и ловил на этом кучу потраченных ресурсов в пустую.
Новый метод TSpicaApplWindow для инициализации процесса:
procedure TSpicaApplWindow.InitAsyncReadMode;
begin
FAsRequestCS := TCriticalSection.Create; //Критическая секция для очереди запросов
FAsResponCS := TCriticalSection.Create; //Критическая секция для очереди ответов
FAsRequestCont := TMyObjectList.Create; //Контейнер очереди запросов
FAsResponCont := TMyObjectList.Create; //Контейнер очереди ответов
FAsyncReadTh := TSpicaAsyncReadTh.Create(Self); //Поток исполнитель
FAsyncReadTh.Start;
end;
Проверку на существование объектов не делаю, в случае ошибки повторного вызова, менеджер памяти все равно укажет на утечку в этом случае при отладке проекта. Сразу в методе деструктора класса:
if FAsyncReadTh<>nil then
begin
FAsyncReadTh.Terminate;
WaitForSingleObject(FAsyncReadTh.Handle, INFINITE);
FreeAndNil(FAsyncReadTh);
end;
FreeMyObject(FAsRequestCS);
FreeMyObject(FAsResponCS);
FreeMyObject(FAsRequestCont);
FreeMyObject(FAsResponCont);если служебный процесс существует, то дождемся его окончания работы, освободим экземпляр класса, указание INFINITE (бесконечное ожидание окончания служебного процесса) в данном случае не признак хорошего кода, но для MVP этим можно пренебречь. Дальше освобождение классов, если они существуют, для этого у меня есть такой простой статический метод, тут все понятно и так:
class procedure TSpicaWindow.FreeMyObject(var _Object);
begin
if TObject(_Object)<>nil then
FreeAndNil(_Object);
end;
Новый метод для получения (генерации) ID запроса:
function TSpicaApplWindow.NextAsReqId: TAsRequestId;
begin
Inc(FAsRequestId);
Result := FAsRequestId;
end;Добавляю новый класс TAsRequestData, который будет хранить информацию о запросе, сам Sql запрос и параметры (при наличии), а также результаты выполненного запроса. У меня все классы наследуются от базового (для управления базисным поведением и стандартизации блоков поведения классов).
TAsRequestData = class(TSpicaBaseClass)
protected
procedure InitClass; override;
procedure DestroyClass; override;
public
AsReqId: TAsRequestId; // id запроса
SqlText: string; // sql текст
ParamVals: TStringList; // значения параметров запроса
Responce: TMemoryContainer; // Результат выполненнго запроса (аналог DataSet)
procedure Assign(Source: TSpicaBaseClass); override;
end;
{TAsRequestData}
procedure TAsRequestData.InitClass;
begin
inherited;
ParamVals := TStringList.Create;
Responce := TMemoryContainer.Create;
end;
procedure TAsRequestData.DestroyClass;
begin
ParamVals.Free;
Responce.Free;
inherited;
end;
procedure TAsRequestData.Assign(Source: TSpicaBaseClass);
begin
inherited;
AsReqId := TAsRequestData(Source).AsReqId;
SqlText := TAsRequestData(Source).SqlText;
ParamVals.Assign(TAsRequestData(Source).ParamVals);
Responce.Assign(TAsRequestData(Source).Responce);
end;Для чего я сделал Assign? При «мысленном» моделировании процесса я нашел возможность утечки памяти, поэтому пусть основной поток приложения и служебный процесс работают со своим экземплярами класса, а если нужно передать, то создают новый и инициализируют нужными данными. Накладные расходы минимальны.
Далее, возвращаюсь к TSpicaApplWindow метод регистрации (добавления) запроса:
procedure TSpicaApplWindow.AddAsRdRequest(const ReqId: TAsRequestId;
const Sql: string; const ParamVals: array of string);
var
ReqData: TAsRequestData;
i: integer;
begin
ReqData := TAsRequestData.Create;
ReqData.AsReqId := ReqId;
ReqData.SqlText := Sql;
for i := low(ParamVals) to high(ParamVals) do
ReqData.ParamVals.Add(ParamVals[i]);
FAsRequestCS.Enter;
try
FAsRequestCont.Add(ReqData);
finally
FAsRequestCS.Leave;
end;
end;Метод получения последнего запроса (все что было ранее в очереди очищаем):
function TSpicaApplWindow.GetLastRdRequestData: TAsRequestData;
begin
Result := nil;
FAsRequestCS.Enter;
try
if FAsRequestCont.Count>0 then
begin
Result := TAsRequestData.Create;
Result.Assign(TSpicaBaseClass(FAsRequestCont[FAsRequestCont.Count-1]));
FAsRequestCont.Clear;
end;
finally
FAsRequestCS.Leave;
end;
end;Ну и наконец-то пишем обработку служебного процесса:
procedure TSpicaAsyncReadTh.Execute;
var
reqData: TAsRequestData;
i: integer;
fl: boolean;
FDbAccessor: TSpicaDbAccessor;
begin
FDbAccessor := IDDb.CreateCloneDbAccessor('PL', fl); //Инициализация нового подключения
if not fl then
exit;
try
while not Terminated do // "Бесконечный цикл" пока поток не будет оставновлен
begin
Sleep(300);
if Terminated then
exit;
reqData := FOwner.GetLastRdRequestData; // Запрос на последний запрос от приложения
if reqData<>nil then
begin
FDbAccessor.Q_SetSqlText(reqData.SqlText); // Готовим выполнение
for i := 0 to reqData.ParamVals.Count-1 do
FDbAccessor.Q_SetParamAsString(i, reqData.ParamVals[i]); // Заполняем параметры
if FDbAccessor.Q_Open() then
begin
reqData.Responce.Assign(FDbAccessor.stdQ); // Добаляет результат запроса
FDbAccessor.Q_Close();
reqData.Responce.Active := true; // Специфика класса
FOwner.AddAsRdResponce(reqData); // Добавляем в очередь ответов
PostMessage(FOwner.Handle, WM_SPICA_ASYNCREAD, 0, LPARAM(reqData.AsReqId)); // Уведомляем "владельца об окончании"
end
else
begin
//FDbAccessor.ExceptionStr; // Ошибка, но сообщать не кому, просто данные не появятся для MVP достаточно
end;
end;
end;
finally
FDbAccessor.Free;
end;
end;Для доступа к БД я использую специальный класс TSpicaDbAccessor (данный класс имеет универсальные методы для работы с СУБД, чтобы безшовно переходить на другие БД или компоненты доступа, обработку ошибок исходя из контекста запуска: фон или диалог и т.п.).
Сама обработка крутится в цикле, пока не поступит сообщение об окончании процесса, как только появился новый запрос, то выбирает его из очереди и запускает Sql запрос и результаты кладет в очередь ответов. Уведомление о результате работы через PostMessage окну-владельцу.
Какие минусы сразу вижу: при деактивации потока из основного приложения нужно прерывать выполнение запроса (Query break), при заполнении своего контейнера TMemoryContainer тоже нужно синхронизироваться на проверку флага Terminate, но для MVP и в связи с быстротой выполнения данного запроса пока этим можно пренебречь.
Финальный шаг, добавление функционала в классе реализации. Добавляю в метод инициализации InitAsyncReadMode, в метод получения данных грида сформированный запрос (в моем случае он динамически собирается что не важно в данном случае, привожу код как есть)
if group_id=ID_DEFAULT_STR then
str := '1=1'
else
str := Format('it.%s=l.groupid', [IDAppl.SpicaGroups.GetHierIdFieldName(gtype)]);
Sql := Format(IDDb.GetSqlText(66), [str, str]);
AddAsRdRequest(NextAsReqId, Sql, [group_id, gtype.ToString]);И обработку нового оконного сообщения, в нем мы получаем Id запроса, если он соответствует ожидаемому и не пустой, то добавляем эти данные в контейнер грида и рефрешим его. Добавляю код как есть, не думаю, что там что-то сложное.
procedure TfLeadTimes.WMAsyncRead(var Message: TMessage);
var
AsReqId: TAsRequestId;
RequestData: TAsRequestData;
idx: integer;
i: integer;
f_arr: array[0..2] of Container.TField;
begin
inherited;
AsReqId := Message.LParam; // id запроса
RequestData := GetRdRequestData(AsReqId); // Получаем по нему данные
if (RequestData=nil) then // Проверка на нормальность) такой ситуации не может быть, но а вдруг
exit;
mc_items2.DisableControls; // морозим отрисовку
mc_items2.ReleaseRef;
FLock := true;
try
if AsReqId<>FAsRequestId then // Сюда вынес провреку на актуальность, чтобы при выходе освободить класс
exit;
f_arr[0] := mc_items2.FieldbyName(FL_ID_ENT); // Обновление полей
f_arr[1] := mc_items2.FieldbyName('cnt_sku');
f_arr[2] := mc_items2.FieldbyName('cnt_asku');
RequestData.Responce.Active := true;
for i := 0 to RequestData.Responce.RowCount-1 do
begin
idx := mc_items2._Find([f_arr[0]], [RequestData.Responce.Fields[0].AsInteger[i]]);
if idx<>ID_DEFAULT then
begin
f_arr[1]._AsInteger[idx] := RequestData.Responce.Fields[1].AsInteger[i];
f_arr[2]._AsInteger[idx] := RequestData.Responce.Fields[2].AsInteger[i];
end;
end;
finally
FreeMyObject(RequestData);
RequestData.Free;
mc_items2.EnableControls;
mc_items2.AddRef;
FLock := false;
grid_items2.Refresh;
end;
end;
Добавляю два поля в грид с возможностью просмотра списка SKU по нажатию на кнопку (бонусом к задаче).
Все. Смотрится эффектно, время отклика интерфейса не изменилось, данные плавно появляются с задержкой 0.5-1 сек. В завяленные сроки три часа – уложился.
