unit Table;

interface

uses
  Classes, SysUtils, Generics.Collections, ComCtrls, XMLRead, DOM;

type
  TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki,
    tfXml, tfJson);
  TTableFormats = set of TTableFormat;

  { TRow }

  TRow = class
    Cells: TStringList;
    procedure AddCell(Text: string);
    constructor Create;
    destructor Destroy; override;
  end;

  { TTable }

  TTable = class
  private
    function QuoteString(Text: string; Quote: string): string;
    function UnquoteString(Text: string; Quote: string): string;
    function ReplaceXmlEntities(Text: string): string;
  public
    Title: string;
    Columns: TStringList;
    Rows: TObjectList<TRow>;
    FirstRowIsHeader: Boolean;
    procedure Clear;
    function AddRow: TRow;
    function GetOutputTabs: string;
    function GetOutputPlain: string;
    function GetOutputCsv: string;
    function GetOutputXml: string;
    function GetOutputHtml: string;
    function GetOutputMediaWiki: string;
    function GetOutputJson: string;
    procedure GetOutputListView(ListView: TListView);
    function GetOutput(OutputFormat: TTableFormat): string;
    procedure SetInputCsv(Text: string);
    procedure SetInputMediaWiki(Text: string);
    procedure SetInputJson(Text: string);
    procedure SetInputXml(Text: string);
    procedure SetInput(OutputFormat: TTableFormat; Text: string);
    function GetInputFormats: TTableFormats;
    constructor Create;
    destructor Destroy; override;
  end;

const
  TableFormatText: array[TTableFormat] of string = ('Excel paste', 'Plain text', 'CSV',
    'HTML', 'ListView', 'MediaWiki', 'XML', 'JSON');
  TableFormatExt: array[TTableFormat] of string = ('.txt', '.txt', '.csv',
    '.htm', '', '.txt', '.xml', '.json');


implementation

uses
  Common;

resourcestring
  SUnsupportedFormat = 'Unsupported format';

{ TTable }

function TTable.QuoteString(Text: string; Quote: string): string;
begin
  if Text <> '' then Result := Quote + Text + Quote
    else Result := Text;
end;

function TTable.UnquoteString(Text: string; Quote: string): string;
begin
  Text := Trim(Text);
  if Text.StartsWith(Quote) and Text.EndsWith(Quote) then
    Result := Copy(Text, Length(Quote) + 1, Length(Text) - 2 * Length(Quote));
end;

function TTable.ReplaceXmlEntities(Text: string): string;
begin
  Result := StringReplace(Text, '<', '&lt;', [rfReplaceAll]);
  Result := StringReplace(Result, '>', '&gt;', [rfReplaceAll]);
  Result := StringReplace(Result, '&', '&amp;', [rfReplaceAll]);
  Result := StringReplace(Result, '''', '&apos;', [rfReplaceAll]);
  Result := StringReplace(Result, '"', '&quot;', [rfReplaceAll]);
end;

procedure TTable.Clear;
begin
  Columns.Clear;
  Rows.Clear;
end;

function TTable.AddRow: TRow;
begin
  Result := TRow.Create;
  Rows.Add(Result);
end;

function TTable.GetOutputTabs: string;
var
  I: Integer;
begin
  Result := Implode(#9, Columns) + LineEnding;
  for I := 0 to Rows.Count - 1 do
    Result := Result + Implode(#9, Rows[I].Cells) + LineEnding;
end;

function TTable.GetOutputPlain: string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Rows.Count - 1 do begin
    Result := Result + Implode(LineEnding, Rows[I].Cells) + LineEnding;
    Result := Result + LineEnding;
    Result := Result + '===========================' + LineEnding;
    Result := Result + LineEnding;
  end;
end;

function TTable.GetOutputCsv: string;
var
  I: Integer;
  J: Integer;
begin
  Result := '';

  // Show columns
  for J := 0 to Columns.Count - 1 do begin
    if J > 0 then Result := Result + ',';
    if Columns[J] <> '' then
      Result := Result + QuoteString(Columns[J], '"');
  end;
  Result := Result + LineEnding;

  // Show data rows
  for I := 0 to Rows.Count - 1 do
  with Rows[I] do begin
    for J := 0 to Cells.Count - 1 do begin
      if J > 0 then Result := Result + ',';
      if Cells[J] <> '' then
        Result := Result + QuoteString(Cells[J], '"');
    end;
    Result := Result + LineEnding;
  end;
end;

function TTable.GetOutputXml: string;
var
  I: Integer;
  J: Integer;
begin
  Result := '<?xml version="1.0" encoding="UTF-8"?>' + LineEnding +
    '<table>' + LineEnding;
  if Title <> '' then
    Result := Result + '  <title>' + Title + '</title>' + LineEnding;
  Result := Result + '  <rows>' + LineEnding;
  for I := 0 to Rows.Count - 1 do begin
    Result := Result + '    <row>' + LineEnding;
    for J := 0 to Rows[I].Cells.Count - 1 do
      if Rows[I].Cells[J] <> '' then
        Result := Result + '      <cell name="' + Columns[J] + '">' + ReplaceXmlEntities(Rows[I].Cells[J]) + '</cell>' + LineEnding;
    Result := Result + '    </row>' + LineEnding;
  end;
  Result := Result + '  </rows>' + LineEnding +
    '</table>';
end;

function TTable.GetOutputHtml: string;
var
  I: Integer;
  J: Integer;
begin
  Result := '<html>' + LineEnding +
    '  <head>' + LineEnding +
    '    <title>' + Title + '</title>' + LineEnding +
    '  </head>' + LineEnding +
    '  <body>' + LineEnding +
    '    <table border="1">' + LineEnding;
  // Show header
  Result := Result + '      <tr>' + LineEnding;
  for J := 0 to Columns.Count - 1 do
    Result := Result + '        <th>' + StringReplace(Columns[J], LineEnding, '<br/>', [rfReplaceAll]) + '</th>' + LineEnding;
  Result := Result + '      </tr>' + LineEnding;

  // Show data rows
  for I := 0 to Rows.Count - 1 do begin
    Result := Result + '      <tr>' + LineEnding;
    for J := 0 to Rows[I].Cells.Count - 1 do
      Result := Result + '        <td>' + StringReplace(Rows[I].Cells[J], LineEnding, '<br/>', [rfReplaceAll]) + '</td>' + LineEnding;
    Result := Result + '      </tr>' + LineEnding;
  end;
  Result := Result + '    </table>' + LineEnding +
    '  </body>' + LineEnding +
    '</html>';
end;

function TTable.GetOutputMediaWiki: string;
var
  I: Integer;
  J: Integer;
begin
  Result := '{| class="wikitable sortable"' + LineEnding;

  // Show header
  for J := 0 to Columns.Count - 1 do begin
    if J = 0 then Result := Result + '! ' + Columns[J]
      else Result := Result + ' !! ' + Columns[J];
  end;
  Result := Result + LineEnding + '|-' + LineEnding;

  // Show data rows
  for I := 0 to Rows.Count - 1 do begin
    for J := 0 to Rows[I].Cells.Count - 1 do begin
      if J = 0 then Result := Result + '| ' + Rows[I].Cells[J]
        else Result := Result + ' || ' + Rows[I].Cells[J];
    end;
    if I < Rows.Count - 1 then
      Result := Result + LineEnding + '|-' + LineEnding;
  end;
  Result := Result + LineEnding + '|}';
end;

function TTable.GetOutputJson: string;
var
  I: Integer;
  J: Integer;
begin
  Result := '[' + LineEnding;
  for I := 0 to Rows.Count - 1 do begin
    Result := Result + '  {' + LineEnding;
    for J := 0 to Rows[I].Cells.Count - 1 do begin
      if Rows[I].Cells[J] <> '' then begin
        Result := Result + '    "' + Columns[J] + '": "' + Rows[I].Cells[J] + '"';
        if J < Rows[I].Cells.Count - 1 then Result := Result + ',';
        Result := Result + LineEnding;
      end;
    end;
    Result := Result + '  }';
    if I < Rows.Count - 1 then Result := Result + ',';
    Result := Result + LineEnding;
  end;
  Result := Result + ']' + LineEnding;
end;

procedure TTable.GetOutputListView(ListView: TListView);
var
  I: Integer;
  J: Integer;
  ListColumn: TListColumn;
  ListItem: TListItem;
  NewWidth: Integer;
const
  MinWidth = 120;
begin
  ListView.Columns.BeginUpdate;
  try
    ListView.Columns.Clear;
    for I := 0 to Columns.Count - 1 do begin
      ListColumn := ListView.Columns.Add;
      ListColumn.Caption := Columns[I];
      NewWidth := ListView.Width div Columns.Count;
      if NewWidth < MinWidth then NewWidth := MinWidth;
      ListColumn.Width := NewWidth;
    end;
  finally
    ListView.Columns.EndUpdate;
  end;

  ListView.Items.BeginUpdate;
  try
    ListView.Items.Clear;
    for I := 0 to Rows.Count - 1 do begin
      ListItem := ListView.Items.Add;
      for J := 0 to Rows[I].Cells.Count - 1 do begin
        if J = 0 then ListItem.Caption := Rows[I].Cells[J]
          else ListItem.SubItems.Add(Rows[I].Cells[J]);
      end;
    end;
  finally
    ListView.Items.EndUpdate;
  end;
end;

function TTable.GetOutput(OutputFormat: TTableFormat): string;
begin
  case OutputFormat of
    tfExcel: Result := GetOutputTabs;
    tfPlain: Result := GetOutputPlain;
    tfCsv: Result := GetOutputCsv;
    tfHtml: Result := GetOutputHtml;
    tfMediaWiki: Result := GetOutputMediaWiki;
    tfXml: Result := GetOutputXml;
    tfJson: Result := GetOutputJson;
    else raise Exception.Create(SUnsupportedFormat);
  end;
end;

procedure TTable.SetInputCsv(Text: string);
var
  Lines: TStringList;
  I: Integer;
  Row: TRow;
begin
  Clear;
  Lines := TStringList.Create;
  try
    Lines.Text := Text;
    for I := 0 to Lines.Count - 1 do begin
      if I = 0 then begin
        Columns.StrictDelimiter := True;
        Columns.DelimitedText := Trim(Lines[I]);
      end else begin
        Row := TRow.Create;
        Row.Cells.StrictDelimiter := True;
        Row.Cells.DelimitedText := Trim(Lines[I]);
        Rows.Add(Row);
      end;
    end;
  finally
    FreeAndNil(Lines);
  end;
end;

procedure TTable.SetInputMediaWiki(Text: string);
var
  Lines: TStringList;
  I: Integer;
  Line: string;
  InsideTable: Boolean;
  Index: Integer;
  Row: TRow;
begin
  Clear;
  Lines := TStringList.Create;
  try
    Lines.Text := Text;
    Row := nil;
    InsideTable := False;
    for I := 0 to Lines.Count - 1 do begin
      Line := Trim(Lines[I]);
      if not InsideTable then begin
        if Line.StartsWith('{|') then InsideTable := True;
      end else begin
        if Line.StartsWith('|}') then InsideTable := False
        else
        if Line.StartsWith('!') then begin
          Delete(Line, 1, 1);
          Line := Trim(Line);
          repeat
            Index := Pos('!!', Line);
            if Index > 0 then begin
              Columns.Add(Trim(Copy(Line, 1, Index - 1)));
              Delete(Line, 1, Index + 1);
            end else begin
              Columns.Add(Trim(Line));
              Break;
            end;
          until False;
        end else
        if Line.StartsWith('|-') then begin
          if Assigned(Row) then Rows.Add(Row);
          Row := TRow.Create;
        end else
        if Line.StartsWith('|') then begin
          if Assigned(Row) then begin
            Delete(Line, 1, 1);
            Line := Trim(Line);
            repeat
              Index := Pos('||', Line);
              if Index > 0 then begin
                Row.Cells.Add(Trim(Copy(Line, 1, Index - 1)));
                Delete(Line, 1, Index + 1);
              end else begin
                Row.Cells.Add(Trim(Line));
                Break;
              end;
            until False;

            while Row.Cells.Count < Columns.Count do
              Row.Cells.Add('');
          end;
        end;
      end;
    end;
    if Assigned(Row) then
      Rows.Add(Row);
  finally
    FreeAndNil(Lines);
  end;
end;

procedure TTable.SetInputJson(Text: string);
type
  TState = (stOutside, stArray, stItem);
var
  Lines: TStringList;
  I: Integer;
  Line: string;
  State: TState;
  Index: Integer;
  Row: TRow;
  ColumnIndex: Integer;
  ColumnName: string;
  Value: string;
begin
  Clear;
  Lines := TStringList.Create;
  try
    Lines.Text := Text;
    Row := nil;
    State := stOutside;
    for I := 0 to Lines.Count - 1 do begin
      Line := Trim(Lines[I]);
      if State = stOutSide then begin
        if Line.StartsWith('[') then begin
          State := stArray;
        end;
      end else
      if State = stArray then begin
        if Line.StartsWith('{') then begin
          State := stItem;
          Row := TRow.Create;
          Rows.Add(Row);
        end;
      end else
      if State = stItem then begin
        if Line.StartsWith('}') then begin
          State := stArray;
        end else begin
          Index := Pos(':', Line);
          if Index > 0 then begin
            ColumnName := UnquoteString(Trim(Copy(Line, 1, Index - 1)), '"');
            ColumnIndex := Columns.IndexOf(ColumnName);
            if ColumnIndex < 0 then begin
              Columns.Add(ColumnName);
              ColumnIndex := Columns.Count - 1;
            end;
            while Row.Cells.Count < Columns.Count do
              Row.Cells.Add('');
            Value := Trim(Copy(Line, Index + 1, MaxInt));
            if Value.EndsWith(',') then Value := Copy(Value, 1, Length(Value) - 1);
            Row.Cells[ColumnIndex] := UnquoteString(Value, '"');
          end;
        end;
      end;
    end;
  finally
    FreeAndNil(Lines);
  end;
end;

procedure TTable.SetInputXml(Text: string);
var
  Doc: TXMLDocument;
  TextStream: TStringStream;
  TableNode: TDOMNode;
  RowsNode: TDOMNode;
  RowNode: TDOMNode;
  CellNode: TDOMNode;
  NewRow: TRow;
  CellName: string;
  ColumnIndex: Integer;
begin
  Clear;
  TextStream := TStringStream.Create(Text);
  ReadXMLFile(Doc, TextStream);
  TableNode := Doc.DocumentElement;
  if Assigned(TableNode) and (TableNode.NodeName = 'table') then
  with TableNode do begin
    RowsNode := FindNode('rows');
    if Assigned(RowsNode) then begin
      RowNode := RowsNode.FirstChild;
      while Assigned(RowNode) and (RowNode.NodeName = 'row') do begin
        NewRow := TRow.Create;
        CellNode := RowNode.FirstChild;
        while Assigned(CellNode) and (CellNode.NodeName = 'cell') do begin
          CellName := string(TDOMElement(CellNode).GetAttribute('name'));
          ColumnIndex := Columns.IndexOf(CellName);
          if ColumnIndex < 0 then begin
            Columns.Add(CellName);
            ColumnIndex := Columns.Count - 1;
          end;

          while NewRow.Cells.Count <= ColumnIndex do
            NewRow.Cells.Add('');
          NewRow.Cells[ColumnIndex] := string(CellNode.TextContent);
          CellNode := CellNode.NextSibling;
        end;
        Rows.Add(NewRow);
        RowNode := RowNode.NextSibling;
      end;
    end;
  end;
  FreeAndNil(TextStream);
  FreeAndNil(Doc);
end;

procedure TTable.SetInput(OutputFormat: TTableFormat; Text: string);
begin
  case OutputFormat of
    tfCsv: SetInputCsv(Text);
    tfMediaWiki: SetInputMediaWiki(Text);
    tfJson: SetInputJson(Text);
    tfXml: SetInputXml(Text);
    else raise Exception.Create(SUnsupportedFormat);
  end;
end;

function TTable.GetInputFormats: TTableFormats;
begin
  Result := [tfCsv, tfJson, tfMediaWiki, tfXml];
end;

constructor TTable.Create;
begin
  Columns := TStringList.Create;
  Rows := TObjectList<TRow>.Create;
end;

destructor TTable.Destroy;
begin
  FreeAndNil(Rows);
  FreeAndNil(Columns);
  inherited;
end;

procedure TRow.AddCell(Text: string);
begin
  Cells.Add(Text);
end;

constructor TRow.Create;
begin
  Cells := TStringList.Create;
end;

destructor TRow.Destroy;
begin
  FreeAndNil(Cells);
  inherited;
end;

end.