stringstream.pas

{$MODE OBJFPC} { -*- delphi -*- }
{$INCLUDE settings.inc}
unit stringstream;

// This is for reading null-separated UTF-8-encoded data consisting of
// just integers, floating-point numbers, booleans, or strings.

interface

type
   TStringStreamReader = class
    // this class can never fail. invalid input will just start returning empty strings and 0s.
    private
      FInput: UTF8String;
      FPosition: Cardinal; // last character to have been read
      FEnded: Boolean;
      function ReadUntilNull(const Terminal: Char = #0): UTF8String;
      procedure Close();
    public
      constructor Create(const Input: UTF8String);
      function ReadLongint(): Longint;
      function ReadCardinal(): Cardinal; // only supports values up to High(Longint)
      function ReadDouble(): Double;
      function ReadString(): UTF8String;
      function ReadString(const MaxLength: Cardinal): UTF8String;
      function ReadBoolean(): Boolean;
      procedure ReadEnd();
      procedure Bail(); // call this when you can't be bothered to check if the rest of the data is valid and you just want to stop reading
      property Ended: Boolean read FEnded;
   end;

   TStringStreamWriter = class
    private
      FValue: UTF8String;
      FClosed: Boolean;
    protected
      {$IFOPT C+} function GetDebugStarted(): Boolean; {$ENDIF}
    public
      constructor Create();
      procedure WriteLongint(const Value: Longint);
      procedure WriteCardinal(const Value: Cardinal);
      procedure WriteDouble(const Value: Double);
      procedure WriteString(const Value: UTF8String);
      procedure WriteBoolean(const Value: Boolean);
      procedure Reset();
      procedure Close();
      function Serialize(): UTF8String;
      property Closed: Boolean read FClosed;
      {$IFOPT C+} property DebugStarted: Boolean read GetDebugStarted; {$ENDIF}
   end;

implementation

uses
   sysutils, intutils, exceptions, utf8 {$IFOPT C+}, math {$ENDIF};

const FloatFormat: TFormatSettings = (
   CurrencyFormat: 1;
   NegCurrFormat: 1;
   ThousandSeparator: ',';
   DecimalSeparator: '.';
   CurrencyDecimals: 2;
   DateSeparator: '-';
   TimeSeparator: ':';
   ListSeparator: ',';
   CurrencyString: '$';
   ShortDateFormat: 'yyyy-mm-dd';
   LongDateFormat: 'dd" "mmmm" "yyyy';
   TimeAMString: 'AM';
   TimePMString: 'PM';
   ShortTimeFormat: 'hh:nn';
   LongTimeFormat: 'hh:nn:ss';
   ShortMonthNames: ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
   LongMonthNames: ('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December');
   ShortDayNames: ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
   LongDayNames: ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday');
   TwoDigitYearCenturyWindow: 50
);


constructor TStringStreamReader.Create(const Input: UTF8String);
begin
   Assert(Length(Input) < High(Cardinal));
   FInput := Input;
end;

function TStringStreamReader.ReadUntilNull(const Terminal: Char): UTF8String;
var
   Start: Cardinal;
begin
   Start := FPosition+1; // $R-
   repeat
      Inc(FPosition);
      if (FPosition > Length(FInput)) then
      begin
         Result := '';
         Close();
         exit;
      end;
   until (FInput[FPosition] = Terminal);
   Result := Copy(FInput, Start, FPosition - Start);
end;

procedure TStringStreamReader.Close();
begin
   // move pointer to past the end
   FPosition := Length(FInput)+1; // $R-
end;

function TStringStreamReader.ReadCardinal(): Cardinal;
var
   Value: Int64;
begin
   Value := ParseInt64(ReadUntilNull(), Low(Int64));
   if ((Value < Low(Cardinal)) or (Value > High(Cardinal))) then
   begin
      Value := 0;
      Close();
   end;
   Result := Value; // $R-
end;

function TStringStreamReader.ReadLongint(): Longint;
var
   Value: Int64;
begin
   Value := ParseInt64(ReadUntilNull(), Low(Int64));
   if ((Value < Low(Longint)) or (Value > High(Longint))) then
   begin
      Value := 0;
      Close();
   end;
   Result := Value; // $R-
end;

function TStringStreamReader.ReadDouble(): Double;
begin
   Result := StrToFloatDef(ReadUntilNull(), 0.0, FloatFormat); // $R-
end;

function TStringStreamReader.ReadString(): UTF8String;
begin
   Result := ReadUntilNull();
   if (not IsValidUTF8(Result)) then
   begin
      Result := '';
      Close();
   end;
end;

function TStringStreamReader.ReadString(const MaxLength: Cardinal): UTF8String;
begin
   Result := ReadString();
   if (Length(Result) > MaxLength) then
   begin
      Result := '';
      Close();
   end;
end;

function TStringStreamReader.ReadBoolean(): Boolean;
var
   Buffer: UTF8String;
begin
   Buffer := ReadUntilNull();
   if (Buffer = 'T') then
   begin
      Result := True;
   end
   else
   if (Buffer = 'F') then
   begin
      Result := False;
   end
   else
   begin
      Result := False;
      Close();
   end;
end;

procedure TStringStreamReader.ReadEnd();
begin
   if (FPosition = Length(FInput)) then // pointer just reached past the end of the input string
      FEnded := True;
   Close();
end;

procedure TStringStreamReader.Bail();
begin
   FEnded := True;
   Close();
end;


constructor TStringStreamWriter.Create();
begin
end;

{$IFOPT C+}
function TStringStreamWriter.GetDebugStarted(): Boolean;
begin
   Result := FValue <> '';
end;
{$ENDIF}

// TODO: this should not keep copying the string around

procedure TStringStreamWriter.WriteCardinal(const Value: Cardinal);
begin
   FValue := FValue + IntToStr(Value) + #0;
end;

procedure TStringStreamWriter.WriteLongint(const Value: Longint);
begin
   FValue := FValue + IntToStr(Value) + #0;
end;

procedure TStringStreamWriter.WriteDouble(const Value: Double);
begin
   Assert(not IsInfinite(Value));
   Assert(not IsNaN(Value));
   FValue := FValue + FloatToStrF(Value, ffExponent, 15, 0, FloatFormat) + #0;
end;

procedure TStringStreamWriter.WriteString(const Value: UTF8String);
begin
   Assert(IsValidUTF8(Value));
   Assert(Pos(#0, Value) = 0);
   FValue := FValue + Value + #0;
end;

procedure TStringStreamWriter.WriteBoolean(const Value: Boolean);
begin
   if (Value) then
      FValue := FValue + 'T' + #0
   else
      FValue := FValue + 'F' + #0;
end;

procedure TStringStreamWriter.Reset();
begin
   Assert(not FClosed);
   FValue := '';
end;

procedure TStringStreamWriter.Close();
begin
   Assert(not FClosed);
   FClosed := True;
end;

function TStringStreamWriter.Serialize(): UTF8String;
begin
   Assert(FClosed);
   Result := FValue;
end;
   
end.