unit dstream;

//
//  Implementation of base TStream object.
//
//  How to write simple in use loader:
//
//    function Load(const Data: TData): Boolean;
//    begin
//      if not Data.Stream^.ReadyReadable then begin
//        // ... we could not init the stream
//        Exit(False);
//      end;
//
//      // Here we can get Data.Stream and read from the stream as usual
//
//      Data.Done;
//    end;
//
//  Now we can easily use the function to load:
//
//    Load('file.ext');    // load from file      (unit dstreamfile)
//    Load(Data(P, 1024)); // load from memory    (unit dstreammem)
//    Load(Resource);      // load from resource  (unit dstreamresource)
//
//  Savers can be written the same way.
//
//  TODO
//  1. TStream при инициализации и при деинициализации не должен падать
//  2. TStream при использоании базовых функций Read и Write не должен падать,
//     на клиентский код возлагается ответственность на проверку успешности.
//

{$MODE FPC}
{$MODESWITCH RESULT}
{$MODESWITCH DEFAULTPARAMETERS}

interface

uses
  derror,
  ddumper,
  dtypes;

type
TSeekOrigin = (SO_BEGINNING, SO_CURRENT, SO_END);

// TODO буферизованный Write
PStream = ^TStream;
TStream = object
public const
  DEFAULT_BUFFER_SIZE = 1 * 1024 * 1024;
protected // Buffered reading/writing
  FBuf: PByte;
  FBufSize: Int64; // actual number of buffered data
  FBufPos: Int64; // pos in buffer
  FBufAllocedSize: Int64; // memory allocated for buffer
  FBufOwner: Boolean; // do we have to FreeMem the buffer
  FBufRequiredSize: Int64; // required size of buffering in next read
  procedure FillReadBuffer;
  procedure Flush;
protected const
  FLAG_READY          = (1 shl 0);
  //
  //  Ready signalize that the stream has been successfully assigned and opened
  //  and ready for operations.
  //
  FLAG_READABLE       = (1 shl 1);
  //
  //  Readable flag allows client to call Read methods.
  //
  FLAG_WRITABLE       = (1 shl 2);
  //
  //  Writable flag allows client to call Write methods.
  //
  FLAG_SEEKABLE       = (1 shl 3);
  //
  //  Seekable allows client to call the Seek methods.
  //
  MASK_READY_READABLE = FLAG_READY or FLAG_READABLE;
  MASK_READY_WRITABLE = FLAG_READY or FLAG_WRITABLE;
protected
  FName: AnsiString;
  FFlags: PtrUInt;
  FError: TError;

  function DoRead(P: Pointer; Size: LongInt): LongInt; virtual;
  function DoWrite(P: Pointer; Size: LongInt): LongInt; virtual;
  function DoEof: Boolean; virtual;
  function DoSeek(Offset: TInt64; Origin: TSeekOrigin): TInt64; virtual;
  function DoGetPosition: Int64; virtual;
  function DoGetSize: Int64; virtual;
  procedure SetReady; inline;
  procedure ClearReady; inline;
  procedure SetReadable; inline;
  procedure ClearReadable; inline;
  procedure SetWritable; inline;
  procedure ClearWritable; inline;
  procedure SetSeekable; inline;
  procedure ClearSeekable; inline;
public
  constructor Init(BufSize: Int64 = DEFAULT_BUFFER_SIZE);
  //function Create: PStream; static;
  destructor Done; virtual;
  procedure Free; inline;
  // Basic stream functions
  function Read(P: Pointer; Size: LongInt): LongInt;
  function Write(P: Pointer; Size: LongInt): LongInt; inline; overload;
  function Write(const S: AnsiString): LongInt; inline; overload;
  function Write(S: PAnsiChar): LongInt; inline; overload;
  // FPC's RTL TStream compatability?
  function ReadVar(var Buffer; Count: LongInt): LongInt; inline;
  function WriteVar(var Buffer; Count: LongInt): LongInt; inline;
  // Returns True if stream is readable/writable
  function IsReadable: Boolean; virtual;
  function IsWritable: Boolean; virtual;
  // Descendent classes may choose not to implement this method for all Origins
  function Seek(Offset: TInt64; Origin: TSeekOrigin): TInt64;
  procedure Skip(Offset: TInt64);
  procedure Rewind;
  // The current position of stream (descendent may not implement it)
  function GetPosition: Int64;
  // A wrapper over Seek
  procedure SetPosition(NewPosition: Int64); inline;
  function Eof: Boolean;
  // The current size of stream (descendent may not implement it)
  function GetSize: Int64;
  // These two methods return False when operation failed
  function ReadBuffer(var Buffer; Size: LongInt): Boolean; inline;
  function WriteBuffer(const Buffer; Size: LongInt): Boolean; inline; overload;
  function WriteBuffer(S: PAnsiChar): Boolean; inline; overload;
  // Copy data from other stream
  function CopyFrom(Source: PStream; Count: Int64): Int64;
  // Read all data to memory
  // You MUST FreeMem P after using
  function ReadToMemory(var P: Pointer; var S: Int64): Boolean; overload; deprecated 'use SizeUInt for Size';
  function ReadToMemory(var P: Pointer; var S: SizeUInt): Boolean; overload;
  // Properies
  function Ready: Boolean; inline;
  function Readable: Boolean; inline;
  function Writable: Boolean; inline;
  function ReadyReadable: Boolean; inline;
  function ReadyWritable: Boolean; inline;
  property Name: AnsiString read FName;
  //
  //  The name can be empty, that means anonymous stream.
  //  For a file and file-like stream Name should be path to the file.
  //
  property Position: Int64 read GetPosition write SetPosition;
  property Size: Int64 read GetSize;
  property Error: TError read FError;
public
  // helpers
  //procedure WriteInt(I: TInt32); inline;
  //  Do not use WriteInt, use WriteInt32 instead
  //procedure WriteUInt(U: TUInt32); inline;
  //  Do not use WriteUInt, use WriteUInt32 instead
  procedure WriteInt32(I: TInt32); inline;
  procedure WriteUInt32(U: TInt32); inline;
  procedure WriteInt64(I: TInt64); inline;
  procedure WriteUInt64(U: TUInt64); inline;
  procedure WriteByte(I: TUInt8); inline;
  procedure WriteFloat(F: Float); inline;
  procedure WriteDouble(D: Double); inline;
  procedure WriteStr(const S: TString); inline;
  procedure WriteData(const S: TString); inline;
  function ReadInt8: TInt8; inline;
  function ReadInt: TInt32; inline;
  function ReadInt16: TInt16; inline;
  function ReadUInt: TUInt32; inline;
  function ReadUInt8: TUInt8; inline;
  function ReadUInt16: TUInt16; inline;
  function ReadUInt32: TUInt32; inline;
  function ReadUInt64: TUInt64; inline;
  function ReadByte: TUInt8; inline;
  function ReadFloat: Float; inline;
  function ReadDouble: Double; inline;
  function ReadStr: TString; inline;
end;

TData = object
private
  FStream: PStream;
  FNeedFree: Boolean;
public
  constructor Init(Stream: PStream; NeedFree: Boolean);
  destructor Done; virtual;
// Deligates to the steam
  function Name: AnsiString; inline;
  function ReadyReadable: Boolean; inline;
  function ReadyWritable: Boolean; inline;
public
  property Stream: PStream read FStream;
  property NeedFree: Boolean read FNeedFree;
end;

function AsData(Stream: PStream; NeedFree: Boolean = True): TData; inline; overload;

operator := (const Data: TData): PStream;
operator := (const Stream: PStream): TData;

procedure Dump(const Data: TData); overload;

implementation

procedure TStream.FillReadBuffer;
begin
  // Realloc buffer if needed
  if FBufRequiredSize <> FBufAllocedSize then begin
    if FBufOwner and (FBufAllocedSize > 0) then begin
      FreeMem(FBuf); // TODO use ReallocMem
    end;
    if FBufRequiredSize > 0 then begin
      FBuf := GetMem(FBufRequiredSize);
      FBufAllocedSize := FBufRequiredSize;
    end else begin
      FBuf := nil;
      FBufAllocedSize := 0;
      FBufRequiredSize := 0;
    end;
  end;
  // Fill buffer with data and set cursor
  FBufSize := DoRead(FBuf, FBufAllocedSize);
  FBufPos := 0;
end;

procedure TStream.Flush;
begin
  //if FBufPos > 0 then
  //  DoWrite(FBuf, FBufPos);
  FBufPos := 0;
  // TODO make buffer size of FBufRequiredSize
end;

function TStream.DoRead(P: Pointer; Size: LongInt): LongInt;
begin
  Result := 0;
end;

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

function TStream.DoEof: Boolean;
begin
  Result := True;
end;

function TStream.DoSeek(Offset: TInt64; Origin: TSeekOrigin): TInt64;
begin
  Result := 0;
end;

function TStream.DoGetPosition: Int64;
begin
  Result := 0;
end;

function TStream.DoGetSize: Int64;
begin
  Result := 0;
end;

procedure TStream.SetReady;
begin
  FFlags := FFlags or FLAG_READY;
end;

procedure TStream.ClearReady;
begin
  FFlags := FFlags and not FLAG_READY;
end;

procedure TStream.SetReadable;
begin
  FFlags := FFlags or FLAG_READABLE;
end;

procedure TStream.ClearReadable;
begin
  FFlags := FFlags and not FLAG_READABLE;
end;

procedure TStream.SetWritable;
begin
  FFlags := FFlags or FLAG_WRITABLE;
end;

procedure TStream.ClearWritable;
begin
  FFlags := FFlags and not FLAG_WRITABLE;
end;

procedure TStream.SetSeekable;
begin
  FFlags := FFlags or FLAG_SEEKABLE;
end;

procedure TStream.ClearSeekable;
begin
  FFlags := FFlags and not FLAG_SEEKABLE;
end;

constructor TStream.Init(BufSize: Int64 = DEFAULT_BUFFER_SIZE);
begin
  FBufAllocedSize := 0;
  FBufRequiredSize := BufSize;
  FBufSize := 0;
  FBufPos := 0;
  FBuf := nil;
  FBufOwner := True;
  FFlags := FLAG_READY;
end;

//function TStream.Create: PStream;
//begin
//  Result := New(PStream, Init);
//end;

destructor TStream.Done;
begin
  if FBufOwner then
    FreeMem(FBuf);
end;

procedure TStream.Free; inline;
begin
  if @Self <> nil then begin
    // Done;
    Dispose(PStream(@Self), Done);
  end;
end;

function TStream.Read(P: Pointer; Size: LongInt): LongInt;
var
  I: LongInt;
begin
  //System.Write('Reading ', GetPosition, ' + ', Size, ' -> ');
  // Fill buffer if it is empty
  if FBufPos >= FBufSize then begin
    if Size > FBufRequiredSize then begin
      // It's better to read large amount of data direct to user space
      Exit(DoRead(P, Size));
      //Result := DoRead(P, Size);
      //System.Writeln(GetPosition, ' (readed ', Result, ')');
    end;
    FillReadBuffer;
  end;
  // Try to read all data from buffer
  Result := FBufSize - FBufPos;
  if Result >= Size then begin
    // all data is available in the buffer
    Result := Size;
    Move(FBuf[FBufPos], P^, Size);
    //for I := 0 to Size - 1 do
    //  System.Write(stderr, AnsiChar(FBuf[I]));
    Inc(FBufPos, Size);
  end else begin
    // not enough data, try to get other with DoRead
    Move(FBuf[FBufPos], P^, Result);
    FBufPos := FBufSize;
    Result := Result + DoRead(PByte(P) + Result, Size - Result);
  end;
end;

function TStream.Write(P: Pointer; Size: LongInt): LongInt;
begin
  Result := Self.DoWrite(P, Size);
end;

function TStream.Write(const S: AnsiString): LongInt;
begin
  Result := Self.Write(@S[1], Length(S));
end;

function TStream.Write(S: PAnsiChar): LongInt;
begin
  Result := Self.Write(S, StrLen(S));
end;

function TStream.ReadVar(var Buffer; Count: LongInt): LongInt;
begin
  Result := Self.Read(@Buffer, Count);
end;

function TStream.WriteVar(var Buffer; Count: LongInt): LongInt;
begin
  Result := Self.Write(@Buffer, Count);
end;

function TStream.IsReadable: Boolean;
begin
  Result := Readable;
end;

function TStream.IsWritable: Boolean;
begin
  Result := Writable;
end;

function TStream.Seek(Offset: TInt64; Origin: TSeekOrigin): TInt64;
begin
  case Origin of
    SO_BEGINNING: begin
      FBufPos := 0;
      FBufSize := 0;
      Result := DoSeek(Offset, Origin);
    end;
    SO_CURRENT: begin
      Inc(FBufPos, Offset);
      if FBufPos < FBufSize then begin
        Result := GetPosition;
        Exit;
      end;
      Result := DoSeek(FBufPos - FBufSize, Origin);
      FBufPos := 0;
      FBufSize := 0;
    end;
    SO_END: begin
      FBufPos := 0;
      FBufSize := 0;
      Result := DoSeek(Offset, Origin);
    end;
  else
    Result := GetPosition;
  end;
end;

procedure TStream.Skip(Offset: TInt64);
begin
  Seek(Offset, SO_CURRENT);
end;

procedure TStream.Rewind;
begin
  Seek(0, SO_BEGINNING);
end;

function TStream.GetPosition: Int64;
begin
  Result := DoGetPosition - FBufSize + FBufPos;
end;

procedure TStream.SetPosition(NewPosition: Int64);
begin
  Seek(NewPosition, SO_BEGINNING);
end;

function TStream.Eof: Boolean;
begin
  if FBufPos < FBufSize then begin
    Exit(False);
  end else
    Exit(DoEof);
end;

function TStream.GetSize: Int64;
begin
  Result := DoGetSize;
end;

function TStream.ReadBuffer(var Buffer; Size: LongInt): Boolean; inline;
begin
  Result := Self.Read(@Buffer, Size) = Size;
end;

function TStream.WriteBuffer(const Buffer; Size: LongInt): Boolean; inline;
begin
  Result := Self.Write(@Buffer, Size) = Size;
end;

function TStream.WriteBuffer(S: PAnsiChar): Boolean; inline;
begin
  Result := Write(S, StrLen(S)) = StrLen(S);
end;

function TStream.CopyFrom(Source: PStream; Count: Int64): Int64;
var
  Buffer: PByte;
begin
  GetMem(Buffer, Count);
  Result := Source^.Read(Buffer, Count);
  Self.Write(Buffer, Result);
  FreeMem(Buffer);
end;

function TStream.ReadToMemory(var P: Pointer; var S: Int64): Boolean;
const
  Batch = 1024 * 1024;
var
  B: LongInt;
begin
  S := 0;
  GetMem(P, Batch);
  repeat
    B := Read(@PArrayOfByte(P)^[S], Batch);
    Inc(S, B);
    P := ReAllocMem(P, S + Batch);
  until B < Batch;
  Exit(True);
end;

function TStream.ReadToMemory(var P: Pointer; var S: SizeUInt): Boolean; overload;
const
  Batch = 1024 * 1024;
var
  B: LongInt;
begin
  S := 0;
  GetMem(P, Batch);
  repeat
    B := Read(@PArrayOfByte(P)^[S], Batch);
    Inc(S, B);
    P := ReAllocMem(P, S + Batch);
  until B < Batch;
  Exit(True);
end;

function TStream.Ready: Boolean;
begin
  Exit(FFlags and FLAG_READY <> 0);
end;

function TStream.Readable: Boolean;
begin
  Exit(FFlags and FLAG_READABLE <> 0);
end;

function TStream.Writable: Boolean;
begin
  Exit(FFlags and FLAG_WRITABLE <> 0);
end;

function TStream.ReadyReadable: Boolean;
begin
  Exit((FFlags and (MASK_READY_READABLE)) = MASK_READY_READABLE);
end;

function TStream.ReadyWritable: Boolean;
begin
  Exit((FFlags and (MASK_READY_WRITABLE)) = MASK_READY_WRITABLE);
end;

procedure TStream.WriteInt32(I: TInt32); inline;
begin
  WriteBuffer(I, SizeOf(I));
end;

procedure TStream.WriteUInt32(U: TInt32); inline;
begin
  WriteBuffer(U, SizeOf(U));
end;

procedure TStream.WriteInt64(I: TInt64); inline;
begin
  WriteBuffer(I, SizeOf(I));
end;

procedure TStream.WriteUInt64(U: TUInt64); inline;
begin
  WriteBuffer(U, SizeOf(U));
end;

procedure TStream.WriteByte(I: TUInt8); inline;
begin
  WriteBuffer(I, SizeOf(I));
end;

procedure TStream.WriteFloat(F: Float); inline;
begin
  WriteBuffer(F, SizeOf(F));
end;

procedure TStream.WriteDouble(D: Double); inline;
begin
  WriteBuffer(D, SizeOf(D));
end;

procedure TStream.WriteStr(const S: TString); inline;
begin
  WriteUInt32(Length(S));
  WriteBuffer(S[1], Length(S));
end;

procedure TStream.WriteData(const S: TString); inline;
begin
  WriteBuffer(S[1], Length(S));
end;

function TStream.ReadInt8: TInt8; inline;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

function TStream.ReadInt: TInt32; inline;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

function TStream.ReadInt16: TInt16; inline;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

function TStream.ReadUInt: TUInt32; inline;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

function TStream.ReadUInt8: TUInt8; inline;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

function TStream.ReadUInt16: TUInt16; inline;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

function TStream.ReadUInt32: TUInt32; inline;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

function TStream.ReadUInt64: TUInt64; inline;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

function TStream.ReadByte: TUInt8; inline;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

function TStream.ReadFloat: Float; inline;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

function TStream.ReadDouble: Double; inline;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

function TStream.ReadStr: TString; inline;
begin
  SetLength(Result, ReadUInt);
  ReadBuffer(Result[1], Length(Result));
end;

constructor TData.Init(Stream: PStream; NeedFree: Boolean);
begin
  FStream := Stream;
  FNeedFree := NeedFree;
end;

destructor TData.Done;
begin
  if FNeedFree then begin
    if FStream <> nil then
      FStream^.Free;
  end;
  FStream := nil;
end;

function TData.Name: AnsiString; inline;
begin
  Exit(FStream^.Name);
end;

function TData.ReadyReadable: Boolean; inline;
begin
  Exit(FStream^.ReadyReadable);
end;

function TData.ReadyWritable: Boolean; inline;
begin
  Exit(FStream^.ReadyWritable);
end;

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

operator := (const Data: TData): PStream;
begin
  Result := Data.Stream;
end;

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

procedure Dump(const Data: TData);
var
  B: array[0..15] of Byte;
  S: LongInt;
begin
  S := Data.Stream^.Read(@B[0], 16);
  while S > 0 do begin
    Dump(@B[0], S);
    S := Data.Stream^.Read(@B[0], 16);
  end;
  Data.Done;
end;

end.
