Forum > General

Polling TProcess whilst running

(1/2) > >>

TheFifth:
Hi all,

First let me say that I'm completely new to Lazarus and Pascal, so please be gentle with me!

I'm currently writing a GUI front end to TZXTools.  It's a CLI tool that allows the playback and manipulation of cassette images from retro 8bit machines.

I'm using a TProcess to start playback and am running it in a thread using the code I found here:  https://www.sigmdel.ca/michel/program/fpl/yweather/process_thread_en.html

All works great and I can playback the TZX file and clicking stop works and gracefully terminates the TProcess and thread.

The problem I have is that I need to poll the output of the TProcess as it is running.  The CLI provides updates on its progress that I need to parse to update my UI.

Having looked at the 'Reading large output' example, I see that reading the process output is blocking.  I was hoping I could read a smaller buffer amount from the buffer within the thread's 'while PlayProc.Running do' loop, however placing any sort or output polling in here only returns content after the process has finished.  Also, putting any sort of output read in the loop prevents the stop button being able to terminate the process early.

I currently have the following code:


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit playunit; {$mode objfpc}{$H+} interface uses  Classes, SysUtils;  var  strOutput: String;  lstStatus: TStringList;    procedure Play(filename: string; PlayDone: TNotifyEvent = nil; TerminateProcess: boolean = true; CommandLineApp: string = ''); procedure StopPlaying; implementation uses  process, TZXTools; var  StopPlay: boolean = false;  AppClosing: boolean = false; type  TPlayThread = class(TThread)  private    procedure Done;    procedure ShowStatus;  protected    procedure Execute; override;  public    FOnPlayDone: TNotifyEvent;    FFilename: string;    FCommandLineApp: string;    FTerminateProcess: boolean;    constructor Create(const filename: string; PlayDone: TNotifyEvent = nil;       TerminateProcess: boolean = true; CommandLineApp: string = '');  end; { TPlayThread } constructor TPlayThread.Create(const filename: string;  PlayDone: TNotifyEvent;   TerminateProcess: boolean; CommandLineApp: string);begin  FOnPlayDone := PlayDone;  FTerminateProcess := TerminateProcess;  FFilename := filename;  FCommandLineApp := CommandLineApp;  inherited create(false);  FreeOnTerminate := true;end; procedure TPlayThread.Done;begin  if assigned(FOnPlayDone) then    FOnPlayDone(self);end; // Will play back the TZX in a thread to not block the UIprocedure TPlayThread.ShowStatus;begin  TZXTools.strLastStatus := strOutput;end; procedure TPlayThread.Execute;var  PlayProc: TProcess;  OutputStream : TStream;  BytesRead    : longint;  Buffer       : array[1..2048] of byte;begin  PlayProc := TProcess.create(nil);  try    PlayProc.executable := FCommandLineApp;    PlayProc.parameters.add('-v');    PlayProc.parameters.add(FFilename);    PlayProc.Options := [poUsePipes, poNoConsole];    PlayProc.execute;      // Create a stream object to store the generated output in    OutputStream := TMemoryStream.Create;    lstStatus := TStringList.Create;            while PlayProc.Running do begin      if StopPlay or AppClosing then begin        if StopPlay or FTerminateProcess then          PlayProc.terminate(1);        exit;      end      else                // Poll the buffer        BytesRead := PlayProc.Output.Read(Buffer, 2048); // Read the buffer            // Add the bytes that were read to the stream for later usage        OutputStream.Write(Buffer, BytesRead);         // Read what's in the buffer        OutputStream.Position := 0;        lstStatus.LoadFromStream(OutputStream);        strOutput := lstStatus.Text;                // Update status        synchronize(@Showstatus);            sleep(1);    end;  finally        // *** Below works fine to get output after playback has finished    // *** However I need to get output as playback proceeds        // Create a stream object to store the generated output in    {*OutputStream := TMemoryStream.Create;    lstStatus := TStringList.Create;    repeat      // Poll the buffer        BytesRead := PlayProc.Output.Read(Buffer, 2048); // Read the buffer         // Add the bytes that were read to the stream for later usage        OutputStream.Write(Buffer, BytesRead);    until BytesRead = 0;        // Read what's in the buffer    OutputStream.Position := 0;    lstStatus.LoadFromStream(OutputStream);    strOutput := lstStatus.Text;        // Update status    synchronize(@Showstatus);*}        // Clean up    PlayProc.free;    OutputStream.Free;    lstStatus.Free;    if assigned(FOnPlayDone) and not AppClosing then      synchronize(@Done);  end;end; procedure Play(filename: string; PlayDone: TNotifyEvent; TerminateProcess: boolean; CommandLineApp: string);begin  StopPlay := false;  TPlayThread.create(filename, PlayDone, TerminateProcess, CommandLineApp);end; procedure StopPlaying;begin  StopPlay := true;end; finalization  AppClosing := true;end.

As you can see, I have also added the buffer reading in the 'finally' section (currently commented out), which works perfectly if I want to return all output in one go after the process has run or the stop button has been clicked.

Is it possible to continuously poll a running process, or is it only possible to return the output in one go at the end?

Thanks in advance for any help.

marcov:
Look at the tprocess.RunCommandLoop  (fpc/packages/fcl-process/src/processbody.inc in 3.2.0+) and tprocess.ReadInputStream.

Note how TInputPipeStream.NumBytesAvailable is checked before reading from output.

This is a trick to check how many bytes are available before reading them, so you never read more than there are, and thus don't block.

TheFifth:
Thanks for your reply, but I'm still struggling a little.

Your suggestion has fixed one of my issues, in that the stop button will now terminate the process early.  So that's progress!

I have change my loop in the thread to be:


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---while PlayProc.Running do begin      if StopPlay or AppClosing then begin        if StopPlay or FTerminateProcess then          PlayProc.terminate(1);        exit;      end      else                // Work out if any bytes are available        BytesAvail := PlayProc.Output.NumBytesAvailable;                if BytesAvail > 0 then begin          PrevLen := Length(strOutput);          SetLength(strOutput, PrevLen + BytesAvail);          PlayProc.Output.Read(strOutput[PrevLen + 1], BytesAvail);                    // Update status          synchronize(@Showstatus);                end;              sleep(1);    end;
Unfortunately this still only returns all of the CLI output after the process has finished.

So although I am calling 'synchronize(@Showstatus);' whenever there is data available, it seems to only be running once after the process has finished.

If I run the process manually in Terminal (MacOS), the following is output during playback:

00:00.000   0 Standard Speed Data Block      Program: TEST_PROG  (955 bytes)
00:06.095   1 Standard Speed Data Block      955 bytes of data
00:14.010   2 Standard Speed Data Block      Bytes: o          (start: 27392, 4800 bytes)
00:20.098   3 Standard Speed Data Block      4800 bytes of data
00:48.608     End of Recording

As you can see, the process takes a little over 48 seconds to run and outputs data at the start of each block it is playing.  However, TProcess only seems to be able to return any output after the process has finished.  It does return it all, but it's all in one go after it has finished.  I even added a counter within the 'Showstatus' procedure to check how often it is fired and it's definitely only once, after the process finishes.

Is it possible to grab this output as it happens?

marcov:
I have no idea. I haven't used OS X in years, but it is possible that some programs react to being piped. (e.g. to show colors etc)

Note that under Windows there is sometimes a problem with not polling stderr while polling stdout, though that shouldn't be a problem with such small output.

TheFifth:
Thanks again for your reply.

I tried also polling StdErr just to be sure and it doesn't make any difference.  The pipe definitely only contains data once the process has finished.  I can tell this because if I terminate the process early (and add a final output poll in the clean up code), there is never anything returned.

The interesting things is that StdErr does return data immediately, during the process run, so that is working fine.

I've also tested on Linux (Ubuntu 21.04) and it's the same there.  Data is only ever returned from the output after the process has completely finished.

I've not checked Windows, but I will install Lazarus on my Windows machine and test there too.

I'll also try running some different processes, to see if it's something specific to TZXTools that's causing the issue.

Thanks again for your input.

Navigation

[0] Message Index

[#] Next page

Go to full version