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

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

Some routines to support writing programs portable between Dos and Unix.
Perhaps it would be a good idea not to put features to make Dos programs
Unix-compatible (shell redirections) and vice versa (reading Dos files
from Unix) together into one unit, but rather into two units, DosCompat
and UnixCompat or so -- let's wait and see, perhaps when more routines
suited for this/these unit(s) will be found, the design will become
clearer...

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., 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA.
}

unit DosUnix;

interface

uses GPC;

{ Translate the following bash style redirections (characters in brackets
  are optional) into a redir call under DJGPP, and leave them unchanged
  under other systems.

  [0]<     file      redirect standard input from file
  [1]>[|]  file      redirect standard output to file
  [1]>>    file      append standard output to file
  [1]>&2             redirect standard output to standard error
  2>[|]    file      redirect standard error to file
  2>>      file      append standard error to file
  2>&1               redirect standard error to standard output
  &> file            redirect both standard output and standard error to file }
function TranslateRedirections (const Command : String) : TString;

{ Under Unix, translates CR/LF pairs to single LF characters when reading
  from f, and back when writing to f. Under Dos, does nothing because the
  run time system alrady does this job. In the result, you can read both
  Dos and Unix files, and files written will be Dos. }
procedure AssignDos (var f : AnyFile; const Name : String);

implementation

(*@@fjf252*)type sizetype=word;

function TranslateRedirections (const Command : String) = s : TString;
{$ifdef __DJGPP__}
const
  FileNameChars = ['A'..'Z', 'a'..'z', '0'..'9', '_', '/', '\', ':', '.', ',', '+', '-', '=', '!', '$', '?', '*', '[', ']', '~', '^', '%', '"', '''', '`', '#', #128..#255];

var
  i, k : Integer;
  Redir : TString;
  Redirs : (RNone, ROut, RErr, RBoth, ROutErr, RErrOut);
  Append : Boolean;

  procedure GetFileName;
  var j : Integer;
  begin
    j := k;
    while (j <= Length (s)) and (s [j] in [' ', #9]) do Inc (j);
    k := j;
    while (k <= Length (s)) and (s [k] in FileNameChars) do Inc (k);
    Redir := Redir + ' ' + Copy (s, j, k - j) + ' '
  end;

begin
  s := Command;
  Redir := '';
  i := 1;
  while i <= Length (s) do
    begin
      s [Length (s) + 1] := #0;
      while (i <= Length (s)) and not (s [i] in ['<', '>']) do Inc (i);
      if i <= Length (s) then
        begin
          if s [i] = '<'
            then
              begin
                k := i + 1;
                if (i > 1) and (s [i - 1] = '0') then Dec (i);
                Redir := Redir + '-i';
                GetFileName
              end
            else
              begin
                Redirs := ROut;
                Append := False;
                k := i + 1;
                if i > 1 then
                  case s [i - 1] of
                    '1' : Dec (i);
                    '2' : begin
                            Redirs := RErr;
                            Dec (i)
                          end;
                    '&' : begin
                            Redirs := RBoth;
                            Dec (i)
                          end;
                  end;
                if s [k] = '>' then
                  begin
                    Append := True;
                    Inc (k)
                  end;
                if s [k] = '|' then Inc (k);
                if s [k] = '&' then
                  begin
                    Inc (k);
                    case s [k] of
                      '1' : begin
                              if Redirs = RErr
                                then Redirs := RErrOut
                                else Redirs := RNone;
                              Inc (k)
                            end;
                      '2' : begin
                              if Redirs = ROut
                                then Redirs := ROutErr
                                else Redirs := RNone;
                              Inc (k)
                            end;
                      else Redirs := RBoth
                    end
                  end;
                case Redirs of
                  ROut,
                  RErr,
                  RBoth   : begin
                              if Redirs = RErr
                                then Redir := Redir + '-e'
                                else Redir := Redir + '-o';
                              if Append then Redir := Redir + 'a';
                              GetFileName;
                              if Redirs = RBoth then Redir := Redir + '-eo '
                            end;
                  ROutErr : Redir := Redir + '-oe ';
                  RErrOut : Redir := Redir + '-eo ';
                end
              end;
          Delete (s, i + 1, k - i - 1);
          s [i] := ' '
        end
    end;
  if Redir <> '' then s := 'redir ' + Redir + s
end;
{$else}
begin
  s := Command
end;
{$endif}

type
  PAssignDosData = ^TAssignDosData;
  TAssignDosData = record
    f : File;
    PendingChar : Integer
  end;

procedure AssignDosOpen (var PrivateData; Mode : TOpenMode);
var Data : TAssignDosData absolute PrivateData;
begin
  case Mode of
    foRewrite : Rewrite (Data.f, 1);
    foAppend  : Append  (Data.f, 1);
    else        Reset   (Data.f , 1)
  end
end;

function AssignDosRead (var PrivateData; var Buffer; Size : SizeType) = Result : SizeType;
var
  Data : TAssignDosData absolute PrivateData;
  CharBuf : array [1 .. Size] of Char absolute Buffer;
  i, j : SizeType;
  Temp : Char;
begin
  repeat
    BlockRead (Data.f, Buffer, Size - Ord ((Size > 1) and (Data.PendingChar >= 0)), Result);
    if (InOutRes <> 0) or (Result <= 0) then Exit;
    if Data.PendingChar >= 0 then
      if Size > 1
        then
          begin
            for i := Result downto 1 do CharBuf [i + 1] := CharBuf [i];
            CharBuf [1] := Chr (Data.PendingChar);
            Data.PendingChar := - 1;
            Inc (Result)
          end
        else
          if (Data.PendingChar = 13) and (CharBuf [1] = #10)
            then Data.PendingChar := - 1
            else
              begin
                Temp := Chr (Data.PendingChar);
                Data.PendingChar := Ord (CharBuf [1]);
                CharBuf [1] := Temp
              end;
    i := 1;
    j := 0;
    while (i < Result) or ((i = Result) and ((CharBuf [i] <> #13) or (Data.PendingChar >= 0))) do
      begin
        if (CharBuf [i] = #13) and (CharBuf [i + 1] = #10) then Inc (i);
        Inc (j);
        CharBuf [j] := CharBuf [i];
        Inc (i)
      end;
    if i = Result then Data.PendingChar := Ord (CharBuf [i]);
    Result := j
  until Result > 0
end;

function AssignDosWrite (var PrivateData; const Buffer; Size : SizeType) = Result : SizeType;
var
  Data : TAssignDosData absolute PrivateData;
  CharBuf : array [1 .. Size] of Char absolute Buffer;
  NewBuf : array [1 .. 2 * Size] of Char;
  i, j : Integer;
begin
  j := 0;
  for i := 1 to Size do
    begin
      if CharBuf [i] = #10 then
        begin
          Inc (j);
          NewBuf [j] := #13
        end;
      Inc (j);
      NewBuf [j] := CharBuf [i]
    end;
  BlockWrite (Data.f, NewBuf, j, Result);
  if (InOutRes = 0) and (Result > 0) then Result := Max (0, Result + Size - j)
end;

procedure AssignDosFlush (var PrivateData);
var Data : TAssignDosData absolute PrivateData;
begin
  Flush (Data.f)
end;

procedure AssignDosClose (var PrivateData);
var Data : TAssignDosData absolute PrivateData;
begin
  Close (Data.f)
end;

procedure AssignDosDone (var PrivateData);
var Data : TAssignDosData absolute PrivateData;
begin
  Dispose (@Data)
end;

procedure AssignDos (var f : AnyFile; const Name : String);
begin
  Assign (f, Name);
  {$ifndef __OS_DOS__}
  var Data : PAssignDosData;
  New (Data);
  Data^.PendingChar := - 1;
  Assign (Data^.f, Name);
  AssignTFDD (f, AssignDosOpen, AssignDosRead, AssignDosWrite, AssignDosFlush, AssignDosClose, AssignDosDone, Data)
  {$endif}
end;

end.
