{
Copyright (C) 1998-99 Free Software Foundation, Inc.

Author: Frank Heckenbach <frank@pascal.gnu.de>

Pipe data from and to processes

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, version 2.

This Library 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; see the file COPYING.LIB.  If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA.
}

unit Pipe;

interface

uses GPC;

type
  TPStrings (Count: Cardinal) = array [1 .. Count] of ^String;

  (*@@*)
  PPStrings = ^TPStrings;
  PAnyFile = ^AnyFile;

const
  EPipe = 600; { cannot create pipe to `%s' }

{ The function Pipe starts a process whose name is given by ProcessName,
  with the given Parameters (can be null if no parameters) and Environment,
  and create pipes from and/or to the process' standard input/output/error.
  ProcessName is searched for in the PATH with FSearchExecutable. Any of
  ToInputFile, FromOutputFile and FromStdErrFile can be null if the
  corresponding pipe is not wanted. FromOutputFile and FromStdErrFile may
  be identical, in which case standard output and standard error are
  redirected to the same pipe. The behaviour of other pairs of files being
  identical is undefined, and useless, anyway. The files are Assigned and
  Reset or Rewritten as appropriate. Errors are shown in IOResult, @@however,
  IOResult is not checked automatically after this function, even in `(*$I+*)'
  mode. The function even works under Dos, but of course, in a limited sense:
  if ToInputFile is used, the process will not actually be started until
  ToInputFile is closed. Therefore, the only portable way to use "pipes"
  in both directions is to call `Pipe', write all the Input data to
  ToInputFile, close ToInputFile, and then read the Output and StdErr data
  from FromOutputFile and FromStdErrFile. However, since the capacity of
  pipes is limited, one should also check for Data from FromOutputFile and
  FromStdErrFile while writing the Input data. Please see pipedemo.pas for
  an example. }
procedure Pipe (var ToInputFile, FromOutputFile, FromStdErrFile : AnyFile; (*@@fjf265 const*) ProcessName : String; protected var Parameters : TPStrings; Environment : PCStrings);

implementation

{$B-,I-}

{$L pipec.c}

{$ifndef MSDOS}

type
  PCFilePtr = ^CFilePtr;

function CPipe (Path : CString; ArgV, Environment : PCStrings; PPipeStdIn, PPipeStdOut, PPipeStdErr : PCFilePtr) : Boolean; asmname '_p_pipe';

procedure Pipe (var ToInputFile, FromOutputFile, FromStdErrFile : AnyFile; (*@@fjf265 const*) ProcessName : String; protected var Parameters : TPStrings; Environment : PCStrings);
var
  ParameterCount, i : Cardinal;
  PipeStdOut, PipeStdErr, PipeStdIn : CFilePtr;
  PPipeStdOut, PPipeStdErr, PPipeStdIn : PCFilePtr;
begin
  if @Parameters = nil then ParameterCount := 0 else ParameterCount := Parameters.Count;
  var CParameters : array [0 .. ParameterCount + 1] of CString;
  CParameters [0] := ProcessName;
  for i := 1 to ParameterCount do CParameters [i] := Parameters [i]^;
  CParameters [ParameterCount + 1] := nil;
  if @ToInputFile = nil then PPipeStdIn := nil else PPipeStdIn := @PipeStdIn;
  if @FromOutputFile = nil then PPipeStdOut := nil else PPipeStdOut := @PipeStdOut;
  if @FromStdErrFile = nil then PPipeStdErr := nil else
    if @FromStdErrFile = @FromOutputFile then PPipeStdErr := @PipeStdOut else PPipeStdErr := @PipeStdErr;
  (*@@fjf302*)var pp:tstring=FSearchExecutable (ProcessName, GetEnv (PathEnvVar));
  if (pp = '') or not CPipe (pp, PCStrings (@CParameters), Environment, PPipeStdIn, PPipeStdOut, PPipeStdErr) then
    begin
      IOErrorCString (EPipe, ProcessName);
      Exit
    end;
  if @ToInputFile <> nil then
    begin
      AssignCFile (ToInputFile, PipeStdIn);
      Rewrite (ToInputFile)
    end;
  if @FromOutputFile <> nil then
    begin
      AssignCFile (FromOutputFile, PipeStdOut);
      Reset (FromOutputFile)
    end;
  if (@FromStdErrFile <> nil) and (@FromStdErrFile <> @FromOutputFile) then
    begin
      AssignCFile (FromStdErrFile, PipeStdErr);
      Reset (FromStdErrFile)
    end
end;

{$else}

function CPipe (Path : CString; ArgV, Environment : PCStrings; NameStdIn, NameStdOut, NameStdErr : CString) : Boolean; asmname '_p_pipe';

type
  TPipeData = record
    ProcName, Path : CString;
    ParameterCount : Cardinal;
    ArgV, EnvP : PCStrings;
    NameStdOut, NameStdErr, NameStdIn : TString;
    CNameStdOut, CNameStdErr, CNameStdIn : CString;
    PToInputFile, PFromOutputFile, PFromStdErrFile : PAnyFile;
    InternalToInputFile : Text
  end;

procedure DoPipe (var PipeData : TPipeData);
var
  i : Cardinal;
  t : Text;
  r : Boolean;
begin
  with PipeData do
    begin
      r := CPipe (Path, ArgV, EnvP, CNameStdIn, CNameStdOut, CNameStdErr);
      if PToInputFile <> nil then
        begin
          Assign (t, NameStdIn);
          Erase (t)
        end;
      if not r then IOErrorCString (EPipe, ProcName);
      Dispose (ProcName);
      Dispose (Path);
      for i := 0 to ParameterCount do Dispose (ArgV^[i]);
      Dispose (ArgV);
      if not r then Exit;
      if PFromOutputFile <> nil then
        begin
          Reset (PFromOutputFile^, NameStdOut);
          Assign (t, NameStdOut);
          Erase (t)
        end;
      if (PFromStdErrFile <> nil) and (PFromStdErrFile <> PFromOutputFile) then
        begin
          Reset (PFromStdErrFile^, NameStdErr);
          Assign (t, NameStdErr);
          Erase (t)
        end
    end
end;

function PipeTFDDWrite (var PrivateData; const Buffer; Size : SizeType) : SizeType;
var
  Data : TPipeData absolute PrivateData;
  CharBuffer : array [1 .. Size] of Char absolute Buffer;
begin
  with Data do
    Write (InternalToInputFile, CharBuffer);
  PipeTFDDWrite := Size
end;

procedure PipeTFDDClose (var PrivateData);
var Data : TPipeData absolute PrivateData;
begin
  with Data do
    begin
      Close (InternalToInputFile);
      if PFromOutputFile <> nil then
        begin
          Close (PFromOutputFile^);
          Erase (PFromOutputFile^)
        end;
      if (PFromStdErrFile <> nil) and (PFromStdErrFile <> PFromOutputFile) then
        begin
          Close (PFromStdErrFile^);
          Erase (PFromStdErrFile^)
        end;
      DoPipe (Data);
      Dispose (@Data)
    end
end;

procedure Pipe (var ToInputFile, FromOutputFile, FromStdErrFile : AnyFile; (*@@fjf265 const*) ProcessName : String; protected var Parameters : TPStrings; Environment : PCStrings);
var
  i : Cardinal;
  PipeData : ^TPipeData;
begin
  (*@@fjf302*)var pp:tstring=FSearchExecutable (ProcessName, GetEnv (PathEnvVar));
  if pp = '' then
    begin
      IOErrorCString (EPipe, ProcessName);
      Exit
    end;
  New (PipeData);
  with PipeData^ do
    begin
      ProcName := NewCString (ProcessName);
      Path := NewCString (pp);
      if @Parameters = nil then ParameterCount := 0 else ParameterCount := Parameters.Count;
      GetMem (ArgV, (ParameterCount + 2) * SizeOf (CString));
      ArgV^[0] := NewCString (ProcessName);
      for i := 1 to ParameterCount do ArgV^[i] := NewCString (Parameters [i]^);
      ArgV^[ParameterCount + 1] := nil;
      EnvP := Environment;
      PToInputFile := @ToInputFile;
      PFromOutputFile := @FromOutputFile;
      PFromStdErrFile := @FromStdErrFile;
      if @FromOutputFile = nil
        then CNameStdOut := nil
        else
          begin
            NameStdOut := GetTempFileName;
            CNameStdOut := NameStdOut;
            { So that trying to read from FromOutputFile will yield EOF until ToInputFile is closed }
            if @ToInputFile <> nil then
              begin
                Rewrite (FromOutputFile, NameStdOut);
                Reset (FromOutputFile)
              end
          end;
      if @FromStdErrFile = nil
        then CNameStdErr := nil
        else
          if @FromStdErrFile = @FromOutputFile
            then CNameStdErr := CNameStdOut
            else
              begin
                NameStdErr := GetTempFileName;
                CNameStdErr := NameStdErr;
                { So that trying to read from FromStdErrFile will yield EOF until ToInputFile is closed }
                if @ToInputFile <> nil then
                  begin
                    Rewrite (FromStdErrFile, NameStdErr);
                    Reset (FromStdErrFile)
                  end
              end;
      if @ToInputFile = nil
        then
          begin
            CNameStdIn := nil;
            DoPipe (PipeData^);
            Dispose (PipeData)
          end
        else
          begin
            NameStdIn := GetTempFileName;
            CNameStdIn := NameStdIn;
            Rewrite (InternalToInputFile, NameStdIn);
            AssignTFDD (ToInputFile, (*@@fjf258*)TOpenProc(nil), TReadFunc(nil), PipeTFDDWrite, TFlushProc(nil), PipeTFDDClose, TDoneProc(nil), PipeData);
            Rewrite (ToInputFile)
          end
    end
end;

{$endif}

end.
