{$MODE OBJFPC}
{$MODESWITCH result}
{$MODESWITCH autoderef}
{$MODESWITCH duplicatelocals}
unit dstreamfile;

interface

uses
  {$IF Defined(UNIX)}
  BaseUnix,
  {$ELSEIF Defined(WINDOWS)}
  windows,
  {$ENDIF}
  derror,
  dtypes,
  dstrnum,
  dstrings,
  dexception,
  dstream;

{$IFDEF UNIX} // rtl/inc/filerec.inc
type
  TFileTextRecChar    = {$if defined(FPC_ANSI_TEXTFILEREC) or not(defined(FPC_HAS_FEATURE_WIDESTRINGS))}AnsiChar{$else}UnicodeChar{$endif};
const
{$ifdef CPUAVR}
  filerecnamelength = 15;
{$else CPUAVR}
  filerecnamelength = 255;
{$endif CPUAVR}
type
 { using packed makes the compiler to generate ugly code on some CPUs, further
    using packed causes the compiler to handle arrays of text wrongly, see  see tw0754 e.g. on arm  }
  FileRec = {$ifdef VER2_6} packed {$endif} Record
    Handle    : THandle;
    Mode      : longint;
    RecSize   : SizeInt;
    _private  : array[1..3 * SizeOf(SizeInt) + 5 * SizeOf (pointer)] of byte;
    UserData  : array[1..32] of byte;
    name      : array[0..filerecnamelength] of TFileTextRecChar;
  End;
{$ENDIF}

type
TFileMode = (FM_READ, FM_WRITE);

{$IF Defined(UNIX)}
  TFileHolder = BaseUnix.cint;
{$ELSEIF Defined(WINDOWS)}
  TFileHolder = windows.HANDLE;
{$ELSE}
  TFileHolder = file of byte;
{$ENDIF}

PStreamFile = ^TStreamFile;
TStreamFile = object(TStream)
private
  F: TFileHolder;
public
  constructor Init(const FileName: AnsiString; Mode: TFileMode = FM_READ; BufSize: Int64 = TStream.DEFAULT_BUFFER_SIZE); overload;
  constructor Init(var OpenedFile: TFileHolder); overload;
  destructor Done; virtual;
  function Create(const FileName: AnsiString; Mode: TFileMode = FM_READ; BufSize: Int64 = TStream.DEFAULT_BUFFER_SIZE): PStreamFile; static; inline; overload;
  function Create(var OpenedFile: TFileHolder): PStreamFile; static; inline; overload;
protected
  function DoRead(P: Pointer; Size: LongInt): LongInt; virtual;
  function DoWrite(P: Pointer; Size: LongInt): LongInt; virtual;
  function DoSeek(Offset: TInt64; Origin: TSeekOrigin): TInt64; virtual;
  function DoGetPosition: Int64; virtual;
  function DoEof: Boolean; virtual;
  function DoGetSize: Int64; virtual;
end;

// cannot open stdin as TFileHolder...
PStreamStdin = ^TStreamStdin;
TStreamStdin = object(TStream)
public
  constructor Init;
  function Create: PStreamStdin; static; inline;
  function DoRead(P: Pointer; Size: LongInt): LongInt; virtual;
  function DoWrite(P: Pointer; Size: LongInt): LongInt; virtual;
  function DoEof: Boolean; virtual;
end;

function OutFile(const FileName: TString): PStreamFile; inline;
function InFile(const FileName: TString; BufSize: Int64 = TStream.DEFAULT_BUFFER_SIZE): PStreamFile; inline;
function InOutFile(const FileName: TString): PStreamFile; inline;

// need to copy this here because of conflict in dstream
function Data(Stream: PStream; NeedFree: Boolean = True): TData; inline; overload;
function Data(const FileName: TString): TData; inline; overload;
function Data(const FileName: TAnsiView): TData; inline; overload;

operator := (Stream: PStream): TData;
operator := (const FileName: TString): TData;
operator := (const FileName: TAnsiView): TData;

implementation

function IOResultToStr(R: LongInt): PAnsiChar;
begin
{$IFDEF DEVELOPMENT}
  if R = 2 then begin
    Result := 'File not found.';
  end else if R = 3 then begin
    Result := 'Path not found.';
  end else if R = 5 then begin
    Result := 'Access denied.';
  end else if R = 6 then begin
    Result := 'Invalid file handle.';
  end else if R = 12 then begin
    Result := 'Invalid file-access mode.';
  end else if R = 15 then begin
    Result := 'Invalid disk number.';
  end else if R = 16 then begin
    Result := 'Cannot remove current directory.';
  end else if R = 17 then begin
    Result := 'Cannot rename across volumes.';
  end else if R = 100 then begin
    Result := 'Error when reading from disk.';
  end else if R = 101 then begin
    Result := 'Error when writing to disk.';
  end else if R = 102 then begin
    Result := 'File not assigned.';
  end else if R = 103 then begin
    Result := 'File not open.';
  end else if R = 104 then begin
    Result := 'File not opened for input.';
  end else if R = 105 then begin
    Result := 'File not opened for output.';
  end else if R = 106 then begin
    Result := 'Invalid number.';
  end else
    Result := 'Unknown error code';
{$ELSE}
  Result := '';
{$ENDIF}
end;

{$IF Defined(WINDOWS)}
type
TUInt64Rec = packed record
  Low, High: windows.DWORD;
end;
{$ENDIF}

constructor TStreamFile.Init(const FileName: AnsiString; Mode: TFileMode; BufSize: Int64 = TStream.DEFAULT_BUFFER_SIZE);
{$IF Defined(UNIX)} // TStreamFile.Init
const
  DEFAULT_MODE = BaseUnix.S_IWUSR or BaseUnix.S_IRUSR or
                 BaseUnix.S_IWGRP or BaseUnix.S_IRGRP or
                 BaseUnix.S_IWOTH or BaseUnix.S_IROTH;
var
  OpenFlags: BaseUnix.cint;
  OpenMode: BaseUnix.mode_t;
begin
  inherited Init(BufSize);
  FName := FileName;
  if Mode = FM_READ then begin
    SetReadable;
    OpenFlags := O_RDONLY;
    OpenMode := 0;
  end else begin
    SetWritable;
    OpenFlags := O_CREAT or O_WRONLY;
    OpenMode := DEFAULT_MODE;
  end;
  repeat
    F := BaseUnix.fpOpen(@FileName[1], OpenFlags, OpenMode);
    if F = -1 then begin
      if BaseUnix.fpGetErrno = BaseUnix.ESysEINTR then
        continue;
      ClearReady;
    end;
  until True;
end;
{$ELSEIF Defined(WINDOWS)} // TStreamFile.Init
var
  DesiredAccess: windows.DWORD;
  ShareMode: windows.DWORD;
  CreationDisposition: windows.DWORD;
  FlagsAndAttributes: windows.DWORD;
begin
  inherited Init(BufSize);
  FName := FileName;
  if Mode = FM_READ then begin
    DesiredAccess := windows.GENERIC_READ;
    ShareMode := windows.FILE_SHARE_READ;
    CreationDisposition := windows.OPEN_EXISTING;
    FlagsAndAttributes := windows.FILE_ATTRIBUTE_NORMAL;
    SetReadable;
  end else begin
    DesiredAccess := windows.GENERIC_WRITE;
    ShareMode := windows.FILE_SHARE_READ;
    CreationDisposition := windows.CREATE_ALWAYS;
    FlagsAndAttributes := windows.FILE_ATTRIBUTE_NORMAL;// or windows.FILE_FLAG_OVERLAPPED;
    SetWritable;
  end;

  // TODO: use utf-8 / wide
  F := windows.CreateFileA(
                @FileName[1],
                DesiredAccess,
                ShareMode,
                nil,
                CreationDisposition,
                FlagsAndAttributes,
                windows.INVALID_HANDLE_VALUE);

  if F <> windows.INVALID_HANDLE_VALUE then begin
    SetReady;
  end else
    ClearReady;
end;
{$ELSE} // TStreamFile.Init
var
  fpError: Word;
begin
  inherited Init(BufSize);
  FName := FileName;
  Assign(F, FileName);
  {$I-}
  case Mode of
    FM_READ:
      begin
        Reset(F);
        SetReadable;
      end;
    FM_WRITE:
      begin
        Rewrite(F);
        SetWritable;
      end;
  end;
  {$I+}
  fpError := IOResult;
  if fpError <> 0 then begin
    SetupError(@FError, 1, 'has not opened');
    ClearReady;
  end;
end;
{$ENDIF} // TStreamFile.Init

constructor TStreamFile.Init(var OpenedFile: TFileHolder);
begin
  inherited Init;
  FName := AnsiString(PAnsiChaR(@FileRec(Pointer(@OpenedFile)^).Name[0]));
  F := OpenedFile;
  // We do not actually know... :(
  SetReadable;
  SetWritable;
end;

destructor TStreamFile.Done;
{$IF Defined(UNIX)} // TStreamFile.Done
begin
  // Result of the system call is ignored because the destructor should not
  // fail on an error. If you want to be sure your data has been written to
  // actual device, call Flush and check returned value before destructor.
  //
  // On some (rare) POSIX systems that may lead to file descriptor leak, see
  //   https://lwn.net/Articles/576478/
  // but it does not seem I can do something with it.
  BaseUnix.fpClose(F);
  inherited Done;
end;
{$ELSEIF Defined(WINDOWS)} // TStreamFile.Done
begin
  windows.CloseHandle(F);
  inherited Done;
end;
{$ELSE} // TStreamFile.Done
begin
  if Ready then
    Close(F);
  inherited Done;
end;
{$ENDIF}

function TStreamFile.Create(const FileName: AnsiString; Mode: TFileMode = FM_READ; BufSize: Int64 = TStream.DEFAULT_BUFFER_SIZE): PStreamFile;
begin
  Result := New(PStreamFile, Init(FileName, Mode));
end;

function TStreamFile.Create(var OpenedFile: TFileHolder): PStreamFile;
begin
  Result := New(PStreamFile, Init(OpenedFile));
end;

function TStreamFile.DoRead(P: Pointer; Size: LongInt): LongInt;
{$IF Defined(UNIX)} // TStreamFile.DoRead
begin
  repeat
    Result := BaseUnix.fpRead(F, P^, Size);
    if Result = -1 then begin
      // a signal occurred while the system call, retry
      if BaseUnix.fpGetErrno = BaseUnix.ESysEINTR then
        continue;
      // TODO: save error state
      Exit(0);
    end;
  until True;
end;
{$ELSEIF Defined(WINDOWS)} // TStreamFile.DoRead
var
  ActualRead: windows.DWORD;
begin
  if windows.ReadFile(F, P^, Size, ActualRead, nil) then begin
    Exit(ActualRead);
  end else begin
    // TODO: check GetLastError and save error state
    Exit(0);
  end;
end;
{$ELSE} // TStreamFile.DoRead
begin
  if Size > FileSize(F) - FilePos(F) then
    Size := FileSize(F) - FilePos(F);
  {$I-}
  BlockRead(F, P^, Size, Result);
  {$I+}
  if IOResult <> 0 then
    {Result := 0};
end;
{$ENDIF}

function TStreamFile.DoWrite(P: Pointer; Size: LongInt): LongInt;
{$IF Defined(UNIX)} // TStreamFile.DoWrite
begin
  repeat
    Result := BaseUnix.fpWrite(F, P^, Size);
    if Result = -1 then begin
      // a signal occurred while the system call, retry
      if BaseUnix.fpGetErrno = BaseUnix.ESysEINTR then
        continue;
      // TODO: save error state
      Exit(0);
    end;
  until True;
end;
{$ELSEIF Defined(WINDOWS)} // TStreamFile.DoWrite
var
  ActualRead: windows.DWORD;
begin
  if windows.WriteFile(F, P^, Size, ActualRead, nil) then begin
    Exit(ActualRead);
  end else begin
    // TODO: check GetLastError and save error state
    Exit(0);
  end;
end;
{$ELSE} // TStreamFile.DoWrite
begin
  {$I-}
  BlockWrite(F, P^, Size, Result);
  {$I+}
  if IOResult <> 0 then
    {Result := 0};
end;
{$ENDIF} // TStreamFile.DoWrite

function TStreamFile.DoSeek(Offset: TInt64; Origin: TSeekOrigin): TInt64;
{$IF Defined(UNIX)} // TStreamFile.DoSeek
var
  whence: BaseUnix.cint;
begin
  case Origin of
    SO_BEGINNING: whence := BaseUnix.SEEK_SET;
    SO_CURRENT: whence := BaseUnix.SEEK_CUR;
    SO_END: whence := BaseUnix.SEEK_CUR;
  else
    // This should not happened in correct program
    Exit(0);
  end;
  Result := BaseUnix.fpLSeek(F, Offset, whence);
  if Result = -1 then begin
    Result := 0;
    // TODO: save error state
  end;
end;
{$ELSEIF Defined(WINDOWS)} // TStreamFile.DoSeek
const
  INVALID_SET_FILE_POINTER = windows.DWORD($FFFFFFFF);
var
  Res: UInt64;
  dwMoveMethod: windows.DWORD;
begin
  case Origin of
    SO_BEGINNING: dwMoveMethod := windows.FILE_BEGIN;
    SO_CURRENT: dwMoveMethod := windows.FILE_CURRENT;
    SO_END: dwMoveMethod := windows.FILE_END;
  else
    // This should not happened in correct program
    Exit(0);
  end;
  Res := Offset;
  TUInt64Rec(Res).Low := windows.SetFilePointer(
        F,
        TUInt64Rec(Res).Low,
        @TUInt64Rec(Res).High,
        dwMoveMethod);
  if TUInt64Rec(Res).Low = INVALID_SET_FILE_POINTER then begin
    // TODO: save error state
    Exit(0);
  end else
    Result := Res;
end;
{$ELSE} // TStreamFile.DoSeek
begin
  case Origin of
    SO_BEGINNING: begin
      System.Seek(F, Offset);
      Result := Offset;
    end;
    SO_CURRENT: begin
      System.Seek(F, FilePos(F) + Offset);
      Result := FilePos(F);
    end;
    SO_END: begin
      System.Seek(F, FileSize(F) - Offset);
      Result := FilePos(F);
    end;
  else
    Result := FilePos(F);
  end;
end;
{$ENDIF} // TStreamFile.DoSeek

function TStreamFile.DoGetPosition: Int64;
{$IF Defined(UNIX)} // TStreamFile.DoGetPosition
begin
  Result := BaseUnix.fpLSeek(F, 0, BaseUnix.SEEK_SET);
  if Result = -1 then begin
    Result := 0;
    // TODO: save error state
  end;
end;
{$ELSEIF Defined(WINDOWS)} // TStreamFile.DoGetPosition
begin
  Result := DoSeek(0, SO_CURRENT);
end;
{$ELSE} // TStreamFile.DoGetPosition
begin
  Result := FilePos(F);
end;
{$ENDIF}

function TStreamFile.DoEof: Boolean;
{$IF Defined(UNIX)} // TStreamFile.DoEof
begin
  Result := DoGetSize <= DoGetPosition;
end;
{$ELSEIF Defined(WINDOWS)} // TStreamFile.DoEof
begin
  Result := DoGetSize <= DoGetPosition;
end;
{$ELSE} // TStreamFile.DoEof
begin
  Result := System.Eof(F);
end;
{$ENDIF}

function TStreamFile.DoGetSize: Int64;
{$IF Defined(UNIX)} // TStreamFile.DoGetSize
var
  ret: BaseUnix.cint;
  st: BaseUnix.Stat;
begin
  ret := BaseUnix.fpFStat(F, st);
  if ret <= 0 then begin
    Result := 0;
    // TODO: save error state
  end else
    Result := st.st_size;
end;
{$ELSEIF Defined(WINDOWS)} // TStreamFile.DoGetSize
var
  Res: UInt64;
begin
  TUInt64Rec(Res).Low := windows.GetFileSize(F, @TUInt64Rec(Res).High);
  if TUInt64Rec(Res).Low = windows.INVALID_FILE_SIZE then begin
    // TODO: save error state
    Exit(0);
  end else
    Result := Res;
end;
{$ELSE} // TStreamFile.DoGetSize
begin
  Result := FileSize(F);
end;
{$ENDIF}

constructor TStreamStdin.Init;
begin
  inherited Init;
  SetReadable;
end;

function TStreamStdin.Create: PStreamStdin;
begin
  New(Result, Init);
end;

function TStreamStdin.DoRead(P: Pointer; Size: LongInt): LongInt;
var
  B: PByte;
  C: AnsiChar;
begin
  B := P;
  Result := 0;
  while Result < Size do begin
    System.Read(C);
    AnsiChar(B^) := C;
    Inc(B);
    Inc(Result);
  end;
end;

function TStreamStdin.DoWrite(P: Pointer; Size: LongInt): LongInt;
begin
  Result := 0;
end;

function TStreamStdin.DoEof: Boolean;
begin
  Result := System.Eof(input);
end;

function OutFile(const FileName: TString): PStreamFile;
begin
  Result := TStreamFile.Create(FileName, FM_WRITE);
end;

function InFile(const FileName: TString; BufSize: Int64 = TStream.DEFAULT_BUFFER_SIZE): PStreamFile;
begin
{$IFDEF WINDOWS}
  // Magic, see fmShareDenyNone in fpc/svn/trunk/rtl/win/sysos.inc
  if (FileMode and $40) = 0 then
    FileMode := FileMode or $40;
{$ENDIF}
  Result := TStreamFile.Create(FileName, FM_READ, 0);
end;

function InOutFile(const FileName: TString): PStreamFile; inline;
begin
{$IFDEF WINDOWS}
  // Magic, see fmShareDenyNone in fpc/svn/trunk/rtl/win/sysos.inc
  if (FileMode and $40) = 0 then
    FileMode := FileMode or $40;
{$ENDIF}
  Result := TStreamFile.Create(FileName, FM_READ);
end;

function Data(Stream: PStream; NeedFree: Boolean = True): TData;
begin
  Result.Init(Stream, NeedFree);
end;

function Data(const FileName: TString): TData;
begin
  Result.Init(InFile(FileName), True);
end;

function Data(const FileName: TAnsiView): TData;
begin
  Result.Init(InFile(FileName.ToString), True); // TODO ansibuf instead of str
end;

operator := (Stream: PStream): TData;
begin
  Result := Data(Stream, False);
end;

operator := (const FileName: TString): TData;
begin
  Result := Data(FileName);
end;

operator := (const FileName: TAnsiView): TData;
begin
  Result := Data(FileName);
end;

end.
