Ждите выполнения потока внутри обработчика событий OnCommandGet TIdHttpServer

Question

Приложение My Delphi Berlin использует TIdHttpServer для получения некоторых данных от клиента через HTTP GET, обрабатывает его и отправляет обратно.

Вся логика выполняется в рамках одного обработчика событий: OnCommandGet. Идентификатор получен в QueryString, тогда данные будут преобразованы и возвращены обратно клиенту внутри того же обработчика событий OnCommandGet.

Преобразование данных реализовано в отдельном потоке, который использует PostMessage, чтобы сообщить основному потоку, что рабочий поток завершает выполнение, и данные готовы к отправке обратно клиенту.

Данные для отправки в AResponseInfo.ContentText.

Мой вопрос:

Как сделать OnCommandGet обработчик ждать пока рабочий поток не делает свою работу и передает указатель на преобразованных данных, поэтому я могу получить значение и стрелять назад в AResponseInfo.ContentText?

UPDATE Вот псевдо-код, который я хочу, чтобы выполнить:

type 
    TMyResponsesArray = array[0..5] of TMyObjectAttributes; 
    PMyResponsesArray = ^TMyResponsesArray; 

{There will be 6 tasks run in parallel. Tasks' responses 
will be stored in the below declared Responses array.} 

var 
    Responses: TMyResponsesArray; 

{Below is a Server handler, which takes the input parameter and calls 
a proc which runs 6 threads in parallel. The result of each thread is 
stored as an ordered array value. Only when the array is completely 
populated, ServerCommandGet may send the response!} 

procedure TMainForm.ServerCommandGet(AContext: TIdContext; 
    ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 
var 
    ObjectId: string; 
begin 
    ObjectId := ARequestInfo.Params.Values['oid']; 
    RunTasksInParallel(ObjectId); 
end; 

{Below is a procedure invoked by ServerCommandGet. It runs 6 tasks in 
parallel. Each of the thread instantiates an object, sets its basic 
parameter and fires the method. Each task runs queued. When each thread 
completes the job, it sends a WM to the main thread (via ParentHandler 
which must accept and process the response.} 

procedure TMainForm.RunTasksInParallel(const ObjectId: string); 
const 
    c: array[0..5] of Byte = (0, 1, 2, 3, 4, 5); 
var 
    ParentHandle: HWND; 
begin 

    {running 6 tasks in parallel} 
    TTask.Run(
    procedure 
    begin 
     TParallel.For(Low(c), High(c), 
     procedure(index: Integer) 
     var 
      MyObj: TMyObject; 
      i: Byte; 
     begin 
      i := c[index]; 
      MyObj := TMyObject.Create; 

      try 
      MyObj.SetMyParameter := Random(10); 
      Responses[i] := MyObj.CallMyMethd(ObjectId); 

      TThread.Queue(nil, 
       procedure 
       begin 
       SendMessage(ParentHandle, 
        UM_DATAPACKET, i, Integer(@Responses)); 
       end); 

      finally 
      MyObj.Free; 
      end; 

     end); 
    end); 
end; 

{Now the WM handler. It decreases internal task counter and when 
TaskCounter = 0, it means that all tasks finished execution and the 
Responses array is fully populated. Then we somehow need to pass the 
Response array to the ServerCommandGet and send it back to client...} 

procedure TMainForm.OnDataPacket(var Msg: TMessage); 
begin 
    i := Msg.WParam; 
    Responses := PMyResponsesArray(Msg.LParam)^; 

    {Skipped for for brevity: 
    When ALL tasks have finished execution, the Responses array is FULL. 
    Then all array values are wrapped into XML and sent back to initial 
    invoker ** ServerCommandGet ** which must send XML to client.} 
end; 

Answer 1

Использование глобальной Responses массива не является безопасным, если не ограничить TIdHTTPServer, чтобы только 1 подключен клиент одновременно. В противном случае у вас может быть несколько клиентов, отправляющих запросы одновременно, и переписывая значения друг друга в массиве. При каждом вызове ServerCommandGet() следует использовать локальный массив.

TIdHTTPServer не предназначен для типа асинхронной обработки, которую вы пытаетесь выполнить. ServerCommandGet() должен блокировать, так как TIdHTTPServer отправляет ответ клиенту, когда обработчик OnCommandGet завершает работу, если обработчик сначала не отправляет ответ, чего вы не делаете. Таким образом, относительно вашего управления потоками задач, я хотел бы предложить либо:

1. избавления от TTask.Run() и имею RunTasksInParallel() вызов TParallel.For() непосредственно.

2. или по крайней мере созвать TTask.Wait() на объекте TTask, который вызывает TParallel.For().

В любом случае сделает RunTasksInParallel() блок (и, таким образом, сделать ServerCommandGet() блок), пока все задачи не будут выполнены. Затем вы можете отправить ответ клиенту сразу же после выхода RunTasksInParallel(). Вам не нужно ждать выполнения заданий UM_DATAPACKET в основной поток и обратно в TIdHTTPServer. Если вы используете UM_DATAPACKET для других целей, это нормально, но я не рекомендую использовать его для обработки HTTP.

Попробуйте что-то больше, как это вместо:

const 
    MaxResponses = 6; 

type 
    TMyResponsesArray = array[0..MaxResponses-1] of TMyObjectAttributes; 

    {$POINTERMATH ON} 
    PMyResponsesArray = ^TMyResponsesArray; 

{There will be 6 tasks run in parallel. Tasks' responses 
will be stored in the below declared Responses array.} 

procedure TMainForm.ServerCommandGet(AContext: TIdContext; 
    ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 
var 
    ObjectId: string; 
    Responses: TMyResponsesArray; 
begin 
    ObjectId := ARequestInfo.Params.Values['oid']; 
    RunTasksInParallel(ObjectId, @Responses); 
    {ALL tasks have finished execution, the Responses array is FULL. 
    Wrap all array values into XML and send it back to the client.} 
end; 

{Below is a procedure invoked by ServerCommandGet. It runs 6 tasks in 
parallel. Each of the thread instantiates an object, sets its basic 
parameter and fires the method.} 

procedure TMainForm.RunTasksInParallel(const ObjectId: string; Responses: PMyResponsesArray); 
begin 
    {running 6 tasks in parallel} 
    TParallel.For(0, MaxResponses-1, 
    procedure(index: Integer) 
    var 
     MyObj: TMyObject; 
    begin 
     MyObj := TMyObject.Create; 
     try 
     MyObj.SetMyParameter := Random(10); 
     Responses[index] := MyObj.CallMyMethd(ObjectId); 
     finally 
     MyObj.Free; 
     end; 
    end 
); 
end; 

Я бы тоже не рекомендовал делать обновление базы данных в основном потоке, либо. Если вы не можете обновить базу данных непосредственно в ServerCommandGet() или непосредственно в отдельных потоках задач, я бы предложил иметь отдельный поток, выделенный для обновлений баз данных, которые вы отправляете по мере необходимости. Держитесь подальше от основной темы.