freepascal.compiler/utils/fppkg/lnet/lprocess.pp

{ Asynchronous process support

  Copyright (C) 2006-2008 Micha Nelissen

  This library is Free software; you can redistribute it and/or modify it
  under the terms of the GNU Library General Public License as published by
  the Free Software Foundation; either version 2 of the License, or (at your
  option) any later version.

  This program is diStributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; withOut even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  for more details.

  You should have received a Copy of the GNU Library General Public License
  along with This library; if not, Write to the Free Software Foundation,
  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  
  This license has been modified. See file LICENSE.ADDON for more information.
  Should you find these sources without a LICENSE File, please contact
  me at [email protected]
}

unit lProcess;

{$mode objfpc}{$h+}

interface

uses
  sysutils, classes, process, levents, pipes;

type
  TLInputPipeStream = class(TInputPipeStream)
  protected
    FEvent: TLHandle;
  public
    function Read(var Buffer; Count: longint): longint; override;
  end;

  TLOutputPipeStream = class(TOutputPipeStream)
  protected
    FEvent: TLHandle;
  public
    function Write(const Buffer; Count: longint): longint; override;          
  end;

  TLProcess = class(TProcess)
  protected
    FInputEvent: TLHandle;
    FOutputEvent: TLHandle;
    FStderrEvent: TLHandle;
    FEventer: TLEventer;

    function  GetOnNeedInput: TLHandleEvent;
    function  GetOnHasOutput: TLHandleEvent;
    function  GetOnHasStderr: TLHandleEvent;
    procedure SetOnNeedInput(NewOnInput: TLHandleEvent);
    procedure SetOnHasOutput(NewOnOutput: TLHandleEvent);
    procedure SetOnHasStderr(NewOnStderr: TLHandleEvent);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    
    procedure CloseInput; override;
    procedure CloseOutput; override;
    procedure CloseStderr; override;
    procedure Execute; override;

    property InputEvent: TLHandle read FInputEvent;
    property OutputEvent: TLHandle read FOutputEvent;
    property StderrEvent: TLHandle read FStderrEvent;
    property Eventer: TLEventer read FEventer write FEventer;
    property OnNeedInput: TLHandleEvent read GetOnNeedInput write SetOnNeedInput;
    property OnHasOutput: TLHandleEvent read GetOnHasOutput write SetOnHasOutput;
    property OnHasStderr: TLHandleEvent read GetOnHasStderr write SetOnHasStderr;
  end;

implementation

function TLInputPipeStream.Read(var Buffer; Count: longint): longint;
begin
  Result := inherited;
  FEvent.IgnoreRead := false;
end;

function TLOutputPipeStream.Write(const Buffer; Count: longint): longint;
begin
  Result := inherited;
  FEvent.IgnoreWrite := false;
end;

constructor TLProcess.Create(AOwner: TComponent);
begin
  inherited;

  FInputEvent := TLHandle.Create;
  FOutputEvent := TLHandle.Create;
  FStderrEvent := TLHandle.Create;
end;

destructor TLProcess.Destroy;
begin
  inherited;
  FInputEvent.Free;
  FOutputEvent.Free;
  FStderrEvent.Free;
end;

procedure TLProcess.CloseInput;
begin
  FEventer.UnplugHandle(FInputEvent);
  inherited;
end;

procedure TLProcess.CloseOutput;
begin
  FEventer.UnplugHandle(FOutputEvent);
  inherited;
end;

procedure TLProcess.CloseStderr;
begin
  FEventer.UnplugHandle(FStderrEvent);
  inherited;
end;

procedure TLProcess.Execute;
begin
  inherited;

  if (poUsePipes in Options) and (FEventer <> nil) then
  begin
    if Input <> nil then
    begin
      FInputEvent.Handle := Input.Handle;
      FInputEvent.IgnoreRead := true;
      FEventer.AddHandle(FInputEvent);
    end;
    if Output <> nil then
    begin
      FOutputEvent.Handle := Output.Handle;
      FOutputEvent.IgnoreWrite := true;
      FEventer.AddHandle(FOutputEvent);
    end;
    if Stderr <> nil then
    begin
      FStderrEvent.Handle := Stderr.Handle;
      FStderrEvent.IgnoreWrite := true;
      FEventer.AddHandle(FStderrEvent);
    end;
  end;
end;

function TLProcess.GetOnNeedInput: TLHandleEvent;
begin
  Result := FInputEvent.OnWrite;
end;

function TLProcess.GetOnHasOutput: TLHandleEvent;
begin
  Result := FOutputEvent.OnRead;
end;

function TLProcess.GetOnHasStderr: TLHandleEvent;
begin
  Result := FStderrEvent.OnRead;
end;

procedure TLProcess.SetOnNeedInput(NewOnInput: TLHandleEvent);
begin
  FInputEvent.OnWrite := NewOnInput;
end;

procedure TLProcess.SetOnHasOutput(NewOnOutput: TLHandleEvent);
begin
  FOutputEvent.OnRead := NewOnOutput;
end;

procedure TLProcess.SetOnHasStderr(NewOnStderr: TLHandleEvent);
begin
  FStderrEvent.OnRead := NewOnStderr;
end;

end.