Unit TwoDArrayWriters;

{ This produces a file compatible with a TTwoDArray, and anyone else who needs
  a CSV file.  This provides functionality which is a subset of TTwoDArray.

  The advantage of this object is that it is streaming.  It writes all of the
  data out immediately, and keeps only a small subset of the data in memory.
  This can save a lot of memory and time for large data sets.
}

Interface

  Uses
    StringObjectHashtables,
    Classes;

  Type
    TTwoDArrayWriter =
      Class(TObject)
      Public
        { We open the file on creation, and close it on destruction. }
        Constructor Create(Filename : String; ColNames : Array Of String);  Overload;
        Constructor Create(Filename : String);  Overload;
        Destructor Destroy; Override;

        { You can add columns explicitly using this and/or the constructor, or
          you can add them implicitly with the add procedure, below.  You can
          add as many columns as you want until the first row of data has been
          written.  Trying to add columns after that is an error. }
        Procedure AddCols(ColNames : Array Of String);

        { No headers have been added yet. }
        Function HeadersEmpty : Boolean;
        { Headers have been sent and cannot be changed. }
        Function HeadersFull : Boolean;

        { This was meant to be as similar as possible to TTwoDArray.  As long
          as you output fields for one row at a time, and never go back, these
          calls should still work. }
        Procedure Add(ColHeader, RowHeader, Value : String);
      Private
        Stream : TFileStream;
        FColsByName : THashTable;
        FRowNamesInUse : THashTable;
        FCurrentRow : TStringList;
        FHeaderRow : TStringList;  { If this is assigned, then the head can still be changed. }
        FRowInUse : Boolean;
        Function AddCol(ColName : String) : Integer;
        Procedure FlushRow;
      End;

Implementation

  Uses
    SysUtils;

  { Having one basic function for this is less effecient.  We can optimize some
    things in the constructor, because we know the initial state, and in the
    add item function, we've already checked for certain things before we call
    this.  But this is not called that often, so we don't need to optimize this.
    This is only called before we write the initial header.  And the whole
    point of TTwoDArryWriter is that the body may be huge.  So don't worry too
    much about the header.  Of course, the advantage of doing things this way
    is simpler code.

    This returns the position where it was added.  0 is reserved for the unnamed
    column, and will never be returned.  1 is the first named column, which is
    the second column.  -1 means that the column already exists, so we didn't
    add anything.  This function is used in one of two ways.  In setup, we don't
    actually add any data, we only verify that the column exists, so we ignore
    the return value.  When adding data to the body, we call this only if we
    don't think the column exists.  So it would be an error if the column did
    exist.  When we try to insert the data at location -1, that will cause an
    exception. }
  Function TTwoDArrayWriter.AddCol(ColName : String) : Integer;
    Begin
      Assert(Assigned(FHeaderRow), 'Can''t add column "' + ColName + '".  Headers already sent.');
      If FColsByName.containsKey(ColName) Then
        Result := -1
      Else
        Begin
          Result := FHeaderRow.Add(ColName);
          FCurrentRow.Add('');
          FColsByName[ColName] := TObject(Result)
        End
    End;

  Procedure TTwoDArrayWriter.AddCols(ColNames : Array Of String);
    Var
      I : Integer;
    Begin
      For I := Low(ColNames) To High(ColNames) Do
        AddCol(ColNames[I])
    End;

  Constructor TTwoDArrayWriter.Create(Filename : String; ColNames : Array Of String);
    Begin
      Create(FileName);
      AddCols(ColNames)
    End;

  Constructor TTwoDArrayWriter.Create(Filename : String);
    Begin
      { Neighter of these sharing flags works as expected.
        I cannot open the file in notepad!
        See DebugOutput.pas for the workaround. }
      Stream := TFileStream.Create(Filename, fmCreate Or fmOpenWrite {Or fmShareDenyWrite fmShareDenyNone});
      Stream.Size := 0;
      FColsByName := tHashTable.create;
      FRowNamesInUse := tHashTable.create;
      FCurrentRow := TStringList.Create;
      FHeaderRow := TStringList.Create;
      AddCol('')  // Reserve space, and make sure no one adds '' later.
    End;

  Destructor TTwoDArrayWriter.Destroy;
    Begin
      FlushRow;
      Stream.Free;
      FColsByName.Free;
      FRowNamesInUse.Free;
      FCurrentRow.Free;
      FHeaderRow.Free
    End;

  Procedure TTwoDArrayWriter.Add(ColHeader, RowHeader, Value : String);
    Var
      Column : Integer;
      NewRow : Boolean;
    Begin
      Column := Integer(FColsByName[ColHeader]);
      If Column = 0 Then
        Column := AddCol(ColHeader);
      If (Not FRowInUse) Or (RowHeader <> FCurrentRow[0]) Then
        Begin
          { We are starting a new row. }
          If FRowInUse Then
            { Don't do this for the first row.  We don't want to send the
              header row before we have to . }
            FlushRow;
          FCurrentRow[0] := RowHeader;
          NewRow := FRowNamesInUse.setValue(RowHeader, Nil);
          If Not NewRow Then
            Raise Exception.Create('Duplicate row header: "' + RowHeader + '"; Col="' + ColHeader + '", Value="' + Value + '"');
          FRowInUse := True
        End;
      FCurrentRow[Column] := Value
    End;

  Procedure TTwoDArrayWriter.FlushRow;
    Procedure WriteLine(S : TStrings);
      Var
        Buffer : String;
      Begin  { WriteLine }
        Buffer := S.DelimitedText + #13#10;
        Stream.WriteBuffer(Buffer[1], Length(Buffer))
      End;  { WriteLine }
    Var
      I : Integer;
    Begin  { TTwoDArrayWriter.FlushRow }
      If Assigned(FHeaderRow) Then
        Begin
          WriteLine(FHeaderRow);
          FHeaderRow.Free;
          FHeaderRow := Nil
        End;
      If FRowInUse Then
        Begin
          WriteLine(FCurrentRow);
          For I := 0 To Pred(FCurrentRow.Count) Do
            FCurrentRow[I] := '';
          FRowInUse := False
        End
    End;  { TTwoDArrayWriter.FlushRow }

  Function TTwoDArrayWriter.HeadersEmpty : Boolean;
    Begin
      Result := FCurrentRow.Count = 1
    End;

  Function TTwoDArrayWriter.HeadersFull : Boolean;
    Begin
      Result := Not Assigned(FHeaderRow)
    End;

End.