{$MODE OBJFPC}
unit dminiproto;

interface

type
TFastTag = type Integer;

const
  WIRE_VARINT           = 0;
  WIRE_64BIT            = 1;
  WIRE_LENGTH_DELIMITED = 2;
  WIRE_START_GROUP      = 3; // deprecated
  WIRE_END_GROUP        = 4; // deprecated
  WIRE_32BIT            = 5;

  FastTag1  =  1 shl 3;
  FastTag2  =  2 shl 3;
  FastTag3  =  3 shl 3;
  FastTag4  =  4 shl 3;
  FastTag5  =  5 shl 3;
  FastTag6  =  6 shl 3;
  FastTag7  =  7 shl 3;
  FastTag8  =  8 shl 3;
  FastTag9  =  9 shl 3;
  FastTag10 = 10 shl 3;
  FastTag11 = 11 shl 3;
  FastTag12 = 12 shl 3;
  FastTag13 = 13 shl 3;
  FastTag14 = 14 shl 3;
  FastTag15 = 15 shl 3;

  Tag1:  TFastTag =  1 shl 3;
  Tag2:  TFastTag =  2 shl 3;
  Tag3:  TFastTag =  3 shl 3;
  Tag4:  TFastTag =  4 shl 3;
  Tag5:  TFastTag =  5 shl 3;
  Tag6:  TFastTag =  6 shl 3;
  Tag7:  TFastTag =  7 shl 3;
  Tag8:  TFastTag =  8 shl 3;
  Tag9:  TFastTag =  9 shl 3;
  Tag10: TFastTag = 10 shl 3;
  Tag11: TFastTag = 11 shl 3;
  Tag12: TFastTag = 12 shl 3;
  Tag13: TFastTag = 13 shl 3;
  Tag14: TFastTag = 14 shl 3;
  Tag15: TFastTag = 15 shl 3;

type
TBuffer = object
  Arr: array of Byte;
  Size: Integer;
  constructor Init;
  destructor Done;
  procedure Write(P: Pointer; S: Integer);
  function Data: Pointer;
  procedure FlushToStdout;
end;

TMiniprotoBuilder = object
  Buffer: TBuffer;
  constructor Init;
  destructor Done;

  procedure WriteVarint(Value: Integer); inline; overload;

  procedure Write(Tag: TFastTag; Value: Integer); inline; overload;
  procedure Write(Tag: Integer; Value: Integer); inline; overload;

  procedure Write(Tag: Integer; const Value: AnsiString); inline; overload;

  procedure Write(Tag: Integer; const Builder: TMiniprotoBuilder); overload;
end;

TBufferedStream = object
  Buffer: PByte;
  Size: Integer;
  Cursor: Integer;
  IAmOwner: Boolean;
  // as stdin
  constructor Init;
  // read/map from another buffer
  constructor Init(_Size: Integer; const Stream: TBufferedStream);
  destructor Done;
  procedure Skip(Count: Integer);
  function ReadByte: Byte;
  function EndOfBuffer: Boolean;
  function Data: PByte;
end;

TMiniprotoParser = object
  Buffer: TBufferedStream;

  constructor Init(const FileName: String = '');
  constructor Init(Size: Integer; const Stream: TBufferedStream);
  destructor Done;

  // Each field reading cycle
  // 1. Reading header
  //    Index  - field index
  //    Wire   - wyre_type
  //    Result - not Eof?
  function ReadHeader(out Index, Wire: Integer): Boolean;
  // 2. Read or skip data
  function ReadVarint: Integer;
  function DebugReadVarint: Integer;
  function ReadString: AnsiString;
  procedure Skip(Wire: Integer);
  // 3. If you need, check for the ending
  function EndOfMessage: Boolean;
end;

function MkFirst(const Tag, Wire: Byte): Byte; inline;

implementation

constructor TBuffer.Init;
begin
  Size := 0;
end;

destructor TBuffer.Done;
begin
  SetLength(Arr, 0);
end;

procedure TBuffer.Write(P: Pointer; S: Integer);
begin
  while Size + S > Length(Arr) do
    SetLength(Arr, Length(Arr) + 1024);
  Move(P^, Arr[Size], S);
  Inc(Size, S);
end;

function TBuffer.Data: Pointer;
begin
  Result := @Arr[0];
end;

procedure TBuffer.FlushToStdout;
var
  F: file of Byte;
begin
  Assign(F, '');
  Rewrite(F);
  BlockWrite(F, Data^, Size);
  Close(F);
end;

function MkFirst(const Tag, Wire: Byte): Byte;
begin
  Result := Tag or Wire;
end;

constructor TMiniprotoBuilder.Init;
begin
  Buffer.Init;
end;

destructor TMiniprotoBuilder.Done;
begin
  Buffer.Done;
end;

procedure TMiniprotoBuilder.WriteVarint(Value: Integer);
var
  B: Byte;
begin
  while Value <> 0 do begin
    B := Value and 127;
    Value := Value shr 7;
    if Value <> 0 then
      B := B or 128;
    Buffer.Write(@B, 1);
  end;
end;

procedure TMiniprotoBuilder.Write(Tag: TFastTag; Value: Integer);
var
  B: Byte;
begin
  B := Tag;
  Buffer.Write(@B, 1);
  WriteVarint(Value);
end;

procedure TMiniprotoBuilder.Write(Tag: Integer; Value: Integer);
begin
  Buffer.Write(@Tag, 1);
end;

procedure TMiniprotoBuilder.Write(Tag: Integer; const Value: AnsiString);
var
  B: Byte;
begin
  B := Tag or 2;
  Buffer.Write(@B, 1);
  WriteVarint(Length(Value));
  Buffer.Write(@Value[1], Length(Value));
end;

procedure TMiniprotoBuilder.Write(Tag: Integer; const Builder: TMiniprotoBuilder);
var
  B: Byte;
begin
  B := Tag or 2;
  Buffer.Write(@B, 1);
  WriteVarint(Builder.Buffer.Size);
  Buffer.Write(Builder.Buffer.Data, Builder.Buffer.Size);
end;

constructor TBufferedStream.Init;
begin
  Buffer := nil;
  Size := 0;
  Cursor := 0;
  IAmOwner := False;
end;

constructor TBufferedStream.Init(_Size: Integer; const Stream: TBufferedStream);
//  constructor Init(_Size: Integer; const Stream: TBufferedStream);
var
  C: AnsiChar;
  I: Integer;
begin
  if Stream.Buffer <> nil then begin
    Buffer := Stream.Data;
    Size := _Size;
    Cursor := 0;
    IAmOwner := False;
    Stream.Skip(_Size);
  end else begin
    Size := _Size;
    GetMem(Buffer, Size);
    Cursor := 0;
    IAmOwner := True;
    for I := 0 to Size - 1 do begin
      Read(C);
      Buffer[I] := Byte(C);
    end;
  end;
end;

destructor TBufferedStream.Done;
begin
  if IAmOwner then
    FreeMem(Buffer);
end;

procedure TBufferedStream.Skip(Count: Integer);
var
  I: Integer;
  C: AnsiChar;
begin
  if Buffer <> nil then begin
    Inc(Cursor, Count);
    if Cursor > Size then
      Cursor := Size;
  end else begin
    for I := 0 to Count - 1 do
      Read(C);
  end;
end;

function TBufferedStream.ReadByte: Byte;
begin
  if Buffer <> nil then begin
    if EndOfBuffer then
      Exit(0);
    Result := Buffer[Cursor];
    Inc(Cursor);
  end else begin
    Read(Char(Result));
  end;
end;

function TBufferedStream.EndOfBuffer: Boolean;
begin
  if Buffer <> nil then begin
    Result := Cursor >= Size;
  end else begin
    Result := Eof;
  end;
end;

function TBufferedStream.Data: PByte;
begin
  if Buffer <> nil then
    Result := @Buffer[Cursor]
  else
    // may be remove this method?
    Result := nil;
end;

constructor TMiniprotoParser.Init(const FileName: String = '');
begin
  //Assign(F, FileName);
  //Reset(F);
  Buffer.Init;
end;

constructor TMiniprotoParser.Init(Size: Integer; const Stream: TBufferedStream);
begin
  Buffer.Init(Size, Stream);
end;

destructor TMiniprotoParser.Done;
begin
  //Close(F);
  Buffer.Done;
end;

function TMiniprotoParser.ReadHeader(out Index, Wire: Integer): Boolean;
var
  //B: Byte;
  I: Integer;
  //Count: Integer;
begin
  //BlockRead(F, B, 1, Count);
  //if Count = 0 then
  //  Exit(False);
  //Writeln(stderr, 'Pos: (', Buffer.Buffer <> nil, ') ', Buffer.Cursor, '/', Buffer.Size);
  if Buffer.EndOfBuffer then
    Exit(False);
  {B := Buffer.ReadByte;
  Wire := B and 7;
  Index := B shr 3;
  // TODO additional code for Index > 15
  if Index = 0 then // experimental, is it correct?
    Index := ReadVarint;}
  I := ReadVarint;
  Wire := I and 7;
  Index := I shr 3;
  Exit(True);
end;

function TMiniprotoParser.ReadVarint: Integer;
var
  P: Integer;
  B: Byte;
begin
  Result := 0;
  P := 0;
  repeat
    B := Buffer.ReadByte;
    //Writeln(stderr, 'Bi = ', B);
    Result := (Result {shl 7}) or ((B and 127) shl P);
    if (B and 128) = 0 then
      Exit;
    Inc(P,  7);
  until Buffer.EndOfBuffer;
end;

function TMiniprotoParser.DebugReadVarint: Integer;
var
  P: Integer;
  B: Byte;
begin
  Result := 0;
  P := 0;
  repeat
    B := Buffer.ReadByte;
    //Writeln(stderr, 'Bi = ', B);
    Result := (Result {shl 7}) or ((B and 127) shl P);
    if (B and 128) = 0 then
      Exit;
    Inc(P,  7);
  until Buffer.EndOfBuffer;
end;

function TMiniprotoParser.ReadString: AnsiString;
var
  I: Integer;
  C: AnsiChar;
begin
  SetLength(Result, ReadVarint);
  if Buffer.EndOfBuffer then
    Exit('');
  for I := 1 to Length(Result) do begin
    C := Char(Buffer.ReadByte);
    Result[I] := C;
  end;
end;

procedure TMiniprotoParser.Skip(Wire: Integer);
begin
  // TODO: not stderr, use exception
  case Wire of
    WIRE_VARINT: ReadVarint;
    WIRE_64BIT: Buffer.Skip(8);
    WIRE_LENGTH_DELIMITED: ReadString;
    WIRE_START_GROUP: Writeln(stderr, 'TMiniprotoParser.Skip: underdeveloped for start group');
    WIRE_END_GROUP: Writeln(stderr, 'TMiniprotoParser.Skip: underdeveloped for end group');
    WIRE_32BIT: Buffer.Skip(4);
  else
    Writeln(stderr, 'TMiniprotoParser.Skip: underdeveloped for wire type ', Wire);
  end;
end;

function TMiniprotoParser.EndOfMessage: Boolean;
begin
  Result := Buffer.EndOfBuffer;
end;

end.
