Changeset 169 for trunk


Ignore:
Timestamp:
Jul 2, 2023, 3:05:45 PM (18 months ago)
Author:
chronos
Message:
  • Added: JSON data export and import.
Location:
trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/Packages/Common/Table.pas

    r168 r169  
    77
    88type
    9   TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki, tfXml);
     9  TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki,
     10    tfXml, tfJson);
    1011
    1112  { TRow }
     
    2223  TTable = class
    2324  private
    24     function QuoteCsvString(Text: string): string;
     25    function QuoteString(Text: string; Quote: string): string;
     26    function UnquoteString(Text: string; Quote: string): string;
    2527    function ReplaceXmlEntities(Text: string): string;
    2628  public
     
    3739    function GetOutputHtml: string;
    3840    function GetOutputMediaWiki: string;
     41    function GetOutputJson: string;
    3942    procedure GetOutputListView(ListView: TListView);
    4043    function GetOutput(OutputFormat: TTableFormat): string;
     
    4548    procedure SetInputHtml(Text: string);
    4649    procedure SetInputMediaWiki(Text: string);
     50    procedure SetInputJson(Text: string);
    4751    procedure SetInput(OutputFormat: TTableFormat; Text: string);
    4852    constructor Create;
     
    5256const
    5357  TableFormatText: array[TTableFormat] of string = ('Excel paste', 'Plain text', 'CSV',
    54     'HTML', 'ListView', 'MediaWiki', 'XML');
     58    'HTML', 'ListView', 'MediaWiki', 'XML', 'JSON');
    5559  TableFormatExt: array[TTableFormat] of string = ('.txt', '.txt', '.csv',
    56     '.htm', '', '.txt', '.xml');
     60    '.htm', '', '.txt', '.xml', '.json');
    5761
    5862
     
    6771{ TTable }
    6872
    69 function TTable.QuoteCsvString(Text: string): string;
    70 begin
    71   if Text <> '' then Result := '"' + Text + '"'
     73function TTable.QuoteString(Text: string; Quote: string): string;
     74begin
     75  if Text <> '' then Result := Quote + Text + Quote
    7276    else Result := Text;
     77end;
     78
     79function TTable.UnquoteString(Text: string; Quote: string): string;
     80begin
     81  Text := Trim(Text);
     82  if Text.StartsWith(Quote) and Text.EndsWith(Quote) then
     83    Result := Copy(Text, Length(Quote) + 1, Length(Text) - 2 * Length(Quote));
    7384end;
    7485
     
    98109  I: Integer;
    99110begin
    100   Result := '';
     111  Result := Implode(#9, Columns) + LineEnding;
    101112  for I := 0 to Rows.Count - 1 do
    102113    Result := Result + Implode(#9, Rows[I].Cells) + LineEnding;
     
    127138    if J > 0 then Result := Result + ',';
    128139    if Columns[J] <> '' then
    129       Result := Result + QuoteCsvString(Columns[J]);
     140      Result := Result + QuoteString(Columns[J], '"');
    130141  end;
    131142  Result := Result + LineEnding;
     
    137148      if J > 0 then Result := Result + ',';
    138149      if Cells[J] <> '' then
    139         Result := Result + QuoteCsvString(Cells[J]);
     150        Result := Result + QuoteString(Cells[J], '"');
    140151    end;
    141152    Result := Result + LineEnding;
     
    149160begin
    150161  Result := '<?xml version="1.0" encoding="UTF-8"?>' + LineEnding +
    151     '<table>' + LineEnding +
    152     '  <title>' + Title + '</title>' + LineEnding +
    153     '  <rows>' + LineEnding;
     162    '<table>' + LineEnding;
     163  if Title <> '' then
     164    Result := Result + '  <title>' + Title + '</title>' + LineEnding;
     165  Result := Result + '  <rows>' + LineEnding;
    154166  for I := 0 to Rows.Count - 1 do begin
    155167    Result := Result + '    <row>' + LineEnding;
     
    218230end;
    219231
     232function TTable.GetOutputJson: string;
     233var
     234  I: Integer;
     235  J: Integer;
     236begin
     237  Result := '[' + LineEnding;
     238  for I := 0 to Rows.Count - 1 do begin
     239    Result := Result + '  {' + LineEnding;
     240    for J := 0 to Rows[I].Cells.Count - 1 do begin
     241      if Rows[I].Cells[J] <> '' then begin
     242        Result := Result + '    "' + Columns[J] + '": "' + Rows[I].Cells[J] + '"';
     243        if J < Rows[I].Cells.Count - 1 then Result := Result + ',';
     244        Result := Result + LineEnding;
     245      end;
     246    end;
     247    Result := Result + '  }';
     248    if I < Rows.Count - 1 then Result := Result + ',';
     249    Result := Result + LineEnding;
     250  end;
     251  Result := Result + ']' + LineEnding;
     252end;
     253
    220254procedure TTable.GetOutputListView(ListView: TListView);
    221255var
     
    266300    tfMediaWiki: Result := GetOutputMediaWiki;
    267301    tfXml: Result := GetOutputXml;
     302    tfJson: Result := GetOutputJson;
    268303    else raise Exception.Create(SUnsupportedFormat);
    269304  end;
     
    384419end;
    385420
     421procedure TTable.SetInputJson(Text: string);
     422type
     423  TState = (stOutside, stArray, stItem);
     424var
     425  Lines: TStringList;
     426  I: Integer;
     427  Line: string;
     428  State: TState;
     429  Index: Integer;
     430  Row: TRow;
     431  ColumnIndex: Integer;
     432  ColumnName: string;
     433  Value: string;
     434begin
     435  Clear;
     436  Lines := TStringList.Create;
     437  try
     438    Lines.Text := Text;
     439    Row := nil;
     440    State := stOutside;
     441    for I := 0 to Lines.Count - 1 do begin
     442      Line := Trim(Lines[I]);
     443      if State = stOutSide then begin
     444        if Line.StartsWith('[') then begin
     445          State := stArray;
     446        end;
     447      end else
     448      if State = stArray then begin
     449        if Line.StartsWith('{') then begin
     450          State := stItem;
     451          Row := TRow.Create;
     452          Rows.Add(Row);
     453        end;
     454      end else
     455      if State = stItem then begin
     456        if Line.StartsWith('}') then begin
     457          State := stArray;
     458        end else begin
     459          Index := Pos(':', Line);
     460          if Index > 0 then begin
     461            ColumnName := UnquoteString(Trim(Copy(Line, 1, Index - 1)), '"');
     462            ColumnIndex := Columns.IndexOf(ColumnName);
     463            if ColumnIndex < 0 then begin
     464              Columns.Add(ColumnName);
     465              ColumnIndex := Columns.Count - 1;
     466            end;
     467            while Row.Cells.Count < Columns.Count do
     468              Row.Cells.Add('');
     469            Value := Trim(Copy(Line, Index + 1, MaxInt));
     470            if Value.EndsWith(',') then Value := Copy(Value, 1, Length(Value) - 1);
     471            Row.Cells[ColumnIndex] := UnquoteString(Value, '"');
     472          end;
     473        end;
     474      end;
     475    end;
     476  finally
     477    FreeAndNil(Lines);
     478  end;
     479end;
     480
    386481procedure TTable.SetInput(OutputFormat: TTableFormat; Text: string);
    387482begin
     
    393488    tfMediaWiki: SetInputMediaWiki(Text);
    394489    tfXml: SetInputXml(Text);
     490    tfJson: SetInputJson(Text);
    395491    else raise Exception.Create(SUnsupportedFormat);
    396492  end;
  • trunk/TestCases.pas

    r168 r169  
    308308      Output := Input;
    309309    end;
     310    with TTestCaseVCardExportImport(AddNew('Export/Import XML', TTestCaseVCardExportImport)) do begin
     311      Format := tfXml;
     312      HumanReadableHeader := False;
     313      Input := BeginEnd(
     314        'N:Surname;Name' + VCardLineEnding +
     315        'FN:Name Surname' + VCardLineEnding) +
     316        BeginEnd(
     317        'N:Surname2;Name2' + VCardLineEnding +
     318        'FN:Name2 Surname2' + VCardLineEnding);
     319      Output := Input;
     320    end;
     321    with TTestCaseVCardExportImport(AddNew('Export/Import JSON', TTestCaseVCardExportImport)) do begin
     322      Format := tfJSON;
     323      HumanReadableHeader := False;
     324      Input := BeginEnd(
     325        'N:Surname;Name' + VCardLineEnding +
     326        'FN:Name Surname' + VCardLineEnding) +
     327        BeginEnd(
     328        'N:Surname2;Name2' + VCardLineEnding +
     329        'FN:Name2 Surname2' + VCardLineEnding);
     330      Output := Input;
     331    end;
    310332
    311333    with TTestCaseLoadSave(AddNew('Merge same cell phone', TTestCaseLoadSave)) do begin
Note: See TracChangeset for help on using the changeset viewer.