Dear All.
Currently to implement logger we use the following approach (the code
was implemented for Delphi/Kylix/FPC).
Logger is intended for displaying in the GUI outputs of several threads
and child processes and also for storage into internal bases.
Logic is the following:
Get stdout handle (duplicate it under linux),
create pipe,
replace the stdout (keeping the old stdout) for current process with
write handle of pipe,
There are following problems with FPC
Under Windows: I have to call *rewrite(output) *for every thread which
wants to use new (captured) stdout
So the questions:
How to force all the threads of process and all DLLs write into same
captured stdout?
How to revert stdout back (stop capturing)?
procedure TLogger.Start;
{$IFDEF LINUX}
{$ifdef fpc}
type TPipeDescriptors=TFilDes;
{$endif}
var
pds:TPipeDescriptors;
{$ENDIF}
begin
if fCaptureStdout then
{$IFDEF MSWINDOWS}
hConsole := GetStdHandle(STD_OUTPUT_HANDLE);
{$ELSE}
{$ifdef fpc}
hConsole := fpdup(StdOutputHandle);;//stdout;
{$else}
hConsole := dup(STDOUT_FILENO);;//stdout;
{$endif}
{$ENDIF}
{$IFDEF MSWINDOWS}
CreatePipe(hReadPipe, hWritePipe, nil, 0);
{$ENDIF}
{$IFDEF LINUX}
{$ifdef fpc}
fppipe(pds);
hReadPipe:=pds[0];
hWritePipe:=pds[1];
{$else}
pipe(pds);
hReadPipe:=pds.ReadDes;
hWritePipe:=pds.WriteDes;
{$endif}
{$ENDIF}
if fCaptureStdout then
begin
{$IFDEF MSWINDOWS}
if not SetStdHandle(STD_OUTPUT_HANDLE, hWritePipe)
then MessageBox(0,PChar(Format('Function: SetStdHandle(%x,%x),
Error: %d',[STD_OUTPUT_HANDLE, hWritePipe, GetLastError])),'Failed',0);
{$IFDEF fpc}
* StdOutputHandle:=hWritePipe; // modify global runtime handle*
{$ENDIF}
if GetStdHandle(STD_OUTPUT_HANDLE)<>hWritePipe then
begin
safeputs('Looks like SetStdHandle failed in Windows 7, will try
AllocConsole workaround'#13#10,hWritePipe);
if not fWinConsole then
begin
AllocConsole;
FreeConsole;
SetStdHandle(STD_OUTPUT_HANDLE, hWritePipe);
end;
if GetStdHandle(STD_OUTPUT_HANDLE)<>hWritePipe then
begin
safeputs('AllocConsole workaround failed, will use
GlobalWritePipe workaround'#13#10,hWritePipe);
GlobalWritePipe:=hWritePipe;
TTextRec(output).Handle:=hWritePipe;
end;
end;
*rewrite(output);*
{$ENDIF}
{$IFDEF LINUX}
{$ifdef fpc}
fpdup2(hWritePipe, StdOutputHandle);
{$else}
dup2(hWritePipe, STDOUT_FILENO);
{$endif}
{$ENDIF}
end;
end;
finalizing capture made via
procedure TLogger.Stop;
var dummy:integer;
{$IFDEF LINUX}
p:pointer;
{$ENDIF}
begin
if fExitFlag then Exit;
fExitFlag := True;
// make empty write to wake up the thread sleeping on read operation
dummy:=0;
FileWrite(hWritePipe,dummy,1);
if hThread<>0 then
begin
{$IFDEF MSWINDOWS}
if WaitForSingleObject(hThread,2000)=WAIT_TIMEOUT
then begin
TerminateThread(hThread,0);
MessageBeep(UINT(-1));
writeln('Thread was terminated abnormally');
end;
Closehandle(hThread);
{$ENDIF}
{$IFDEF LINUX}
{$ifndef FPC} // Kylix
pthread_join(hThread,nil); //Unfortunately, will wait INFINITEly
pthread_detach(hThread);
{$else}
WaitForThreadTerminate (hThread, 2000); // implies pthread_join
KillThread(hThread); // implies pthread_detach and pthread_kill
{$endif}
{$ENDIF}
hThread:=0;
end;
if fCaptureStdout then
begin
{$IFDEF MSWINDOWS}
SetStdHandle(STD_OUTPUT_HANDLE, hConsole);
if GlobalWritePipe = hWritePipe then
GlobalWritePipe:=INVALID_HANDLE_VALUE;
{$ENDIF}
{$IFDEF LINUX}
{$ifdef fpc}
fpdup2(hConsole, StdOutputHandle);
{$else}
dup2(hConsole, STDOUT_FILENO);
{$endif}
{$ENDIF}
rewrite(output);
end;
if hReadPipe <> 0 then
begin
FileClose(hReadPipe);
hReadPipe := 0;
end;
if hWritePipe <> 0 then
begin
FileClose(hWritePipe);
hWritePipe := 0;
end;
if IsLogFileOpened then
begin
FileClose(hLogFile);
hLogFile := 0;
end;
end;
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
