Changeset 169 for trunk

Timestamp:

Jul 2, 2023, 3:05:45 PM (17 months ago)

Author:

chronos

Message:

• Added: JSON data export and import.

Location:

trunk

Files:

• Packages/Common/Table.pas (modified) (14 diffs)
• TestCases.pas (modified) (1 diff)

trunk/Packages/Common/Table.pas

@@ -7 +7 @@
 
 type
-  TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki, tfXml);
+  TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki,
+    tfXml, tfJson);
 
   { TRow }
@@ -22 +23 @@
   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 +39 @@
     function GetOutputHtml: string;
     function GetOutputMediaWiki: string;
+    function GetOutputJson: string;
     procedure GetOutputListView(ListView: TListView);
     function GetOutput(OutputFormat: TTableFormat): string;
@@ -45 +48 @@
     procedure SetInputHtml(Text: string);
     procedure SetInputMediaWiki(Text: string);
+    procedure SetInputJson(Text: string);
     procedure SetInput(OutputFormat: TTableFormat; Text: string);
     constructor Create;
@@ -52 +56 @@
 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');
 
 
@@ -67 +71 @@
 { 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;
 
@@ -98 +109 @@
   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;
@@ -127 +138 @@
     if J > 0 then Result := Result + ',';
     if Columns[J] <> '' then
-      Result := Result + QuoteCsvString(Columns[J]);
+      Result := Result + QuoteString(Columns[J], '"');
   end;
   Result := Result + LineEnding;
@@ -137 +148 @@
       if J > 0 then Result := Result + ',';
       if Cells[J] <> '' then
-        Result := Result + QuoteCsvString(Cells[J]);
+        Result := Result + QuoteString(Cells[J], '"');
     end;
     Result := Result + LineEnding;
@@ -149 +160 @@
 begin
   Result := '<?xml version="1.0" encoding="UTF-8"?>' + LineEnding +
-    '<table>' + LineEnding +
-    '  <title>' + Title + '</title>' + LineEnding +
-    '  <rows>' + 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;
@@ -218 +230 @@
 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
@@ -266 +300 @@
     tfMediaWiki: Result := GetOutputMediaWiki;
     tfXml: Result := GetOutputXml;
+    tfJson: Result := GetOutputJson;
     else raise Exception.Create(SUnsupportedFormat);
   end;
@@ -384 +419 @@
 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.SetInput(OutputFormat: TTableFormat; Text: string);
 begin
@@ -393 +488 @@
     tfMediaWiki: SetInputMediaWiki(Text);
     tfXml: SetInputXml(Text);
+    tfJson: SetInputJson(Text);
     else raise Exception.Create(SUnsupportedFormat);
   end;

trunk/TestCases.pas

@@ -308 +308 @@
       Output := Input;
     end;
+    with TTestCaseVCardExportImport(AddNew('Export/Import XML', TTestCaseVCardExportImport)) do begin
+      Format := tfXml;
+      HumanReadableHeader := False;
+      Input := BeginEnd(
+        'N:Surname;Name' + VCardLineEnding +
+        'FN:Name Surname' + VCardLineEnding) +
+        BeginEnd(
+        'N:Surname2;Name2' + VCardLineEnding +
+        'FN:Name2 Surname2' + VCardLineEnding);
+      Output := Input;
+    end;
+    with TTestCaseVCardExportImport(AddNew('Export/Import JSON', TTestCaseVCardExportImport)) do begin
+      Format := tfJSON;
+      HumanReadableHeader := False;
+      Input := BeginEnd(
+        'N:Surname;Name' + VCardLineEnding +
+        'FN:Name Surname' + VCardLineEnding) +
+        BeginEnd(
+        'N:Surname2;Name2' + VCardLineEnding +
+        'FN:Name2 Surname2' + VCardLineEnding);
+      Output := Input;
+    end;
 
     with TTestCaseLoadSave(AddNew('Merge same cell phone', TTestCaseLoadSave)) do begin