Changeset 568 for Common/Table.pas

Timestamp:

Jan 30, 2024, 11:34:58 PM (9 months ago)

Author:

chronos

Message:

• Modified: Update Common package.

File:

• Common/Table.pas (modified) (12 diffs)

Common/Table.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Generics.Collections, ComCtrls;
+  Classes, SysUtils, Generics.Collections, ComCtrls, XMLRead, XMLWrite, DOM;
 
 type
-  TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki, tfXml);
+  TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki,
+    tfXml, tfJson);
+  TTableFormats = set of TTableFormat;
 
   { TRow }
@@ -22 +24 @@
   TTable = class
   private
-    function QuoteCsvString(Text: string): string;
+    function QuoteString(Text: string; Quote: string): string;
+    function UnquoteString(Text: string; Quote: string): string;
     function ReplaceXmlEntities(Text: string): string;
   public
@@ -37 +40 @@
     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;
@@ -45 +55 @@
 const
   TableFormatText: array[TTableFormat] of string = ('Excel paste', 'Plain text', 'CSV',
-    'HTML', 'ListView', 'MediaWiki', 'XML');
+    'HTML', 'ListView', 'MediaWiki', 'XML', 'JSON');
   TableFormatExt: array[TTableFormat] of string = ('.txt', '.txt', '.csv',
-    '.htm', '', '.txt', '.xml');
+    '.htm', '', '.txt', '.xml', '.json');
 
 
@@ -55 +65 @@
   Common;
 
+resourcestring
+  SUnsupportedFormat = 'Unsupported format';
+
 { TTable }
 
-function TTable.QuoteCsvString(Text: string): string;
-begin
-  if Text <> '' then Result := '"' + Text + '"'
+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;
 
@@ -74 +94 @@
 procedure TTable.Clear;
 begin
+  Columns.Clear;
   Rows.Clear;
 end;
@@ -87 +108 @@
   I: Integer;
 begin
-  Result := '';
+  Result := Implode(#9, Columns) + LineEnding;
   for I := 0 to Rows.Count - 1 do
     Result := Result + Implode(#9, Rows[I].Cells) + LineEnding;
@@ -116 +137 @@
     if J > 0 then Result := Result + ',';
     if Columns[J] <> '' then
-      Result := Result + QuoteCsvString(Columns[J]);
+      Result := Result + QuoteString(Columns[J], '"');
   end;
   Result := Result + LineEnding;
@@ -126 +147 @@
       if J > 0 then Result := Result + ',';
       if Cells[J] <> '' then
-        Result := Result + QuoteCsvString(Cells[J]);
+        Result := Result + QuoteString(Cells[J], '"');
     end;
     Result := Result + LineEnding;
@@ -138 +159 @@
 begin
   Result := '<?xml version="1.0" encoding="UTF-8"?>' + LineEnding +
-    '<vcard>' + LineEnding +
-    '  <title>' + Title + '</title>' + LineEnding +
-    '  <contacts>' + 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 + '    <contact>' + LineEnding;
+    Result := Result + '    <row>' + LineEnding;
     for J := 0 to Rows[I].Cells.Count - 1 do
       if Rows[I].Cells[J] <> '' then
-        Result := Result + '      <property name="' + Columns[J] + '">' + ReplaceXmlEntities(Rows[I].Cells[J]) + '</property>' + LineEnding;
-    Result := Result + '    </contact>' + LineEnding;
-  end;
-  Result := Result + '  </contacts>' + LineEnding +
-    '</vcard>';
+        Result := Result + '      <cell name="' + Columns[J] + '">' + ReplaceXmlEntities(Rows[I].Cells[J]) + '</cell>' + LineEnding;
+    Result := Result + '    </row>' + LineEnding;
+  end;
+  Result := Result + '  </rows>' + LineEnding +
+    '</table>';
 end;
 
@@ -207 +229 @@
 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
@@ -255 +299 @@
     tfMediaWiki: Result := GetOutputMediaWiki;
     tfXml: Result := GetOutputXml;
-    else Result := '';
-  end;
+    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;