Gedcom-Datei parsen

[Sir Rufo]

Zitat von hansklok:

Zitat von Sir Rufo:

Also das hier lädt mir eine komplette StressTest-Demo-Datei ein

Kannst Du den Quellcode bitte bisschen kommentieren? Was ist bei Dir TDataRecord?

Was macht LValue.DataIsReference?

Eigentlich habe ich doch recht sprechenden Quelltext:

Delphi-Quellcode:

// Wenn der Data-String mit einem @ startet, dann ist es eine Referenz
Result.DataIsReference := Result.Data.StartsWith( '@' );

Wenn man sich die Sätze anschaut, dann sind die alle nach dem gleichen Muster gestrickt

Code:

<LEVEL>[<sep>@<REFERENCE>@]<sep><TYPE>[<sep><DATA>]

<LEVEL> = numerisch
<sep> = SPACE
<TYPE> = alphanumerisch ohne <sep>
<DATA> = alles bis zum Ende der Zeile

Das war es schon.

In den Record TDataRecord fülle ich einfach die Werte aus der Zeile ein.

Hier der gesamte Code:

Delphi-Quellcode:

program dp_183093;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.Generics.Collections,
  System.IOUtils,
  System.Classes,
  System.SysUtils;

type
  TDataRecord = record
    Level: Integer;
    Reference: string;
    NodeTypeStr: string;
    Data: string;
    DataIsReference: Boolean;
  end;

  TNodeType = record
  private
    FTypeName: string;

  public
    constructor Create( const ATypeName: string );
    function ToString: string;
    property TypeName: string read FTypeName;
  end;

  TNode = class
  private
    FNodeType: TNodeType;
    FParent: TNode;
  protected
    function GetData: string; virtual;
    function GetLastChild: TNode; virtual; abstract;
    function GetChildCount: Integer; virtual; abstract;
    function GetChild( Index: Integer ): TNode; virtual; abstract;
  public
    constructor Create( AParent: TNode; ANodeType: TNodeType );

    procedure AddChild( ANode: TNode ); virtual; abstract;
    function ToString: string; override;

    property Data: string read GetData;
    property ChildCount: Integer read GetChildCount;
    property Children[Index: Integer]: TNode read GetChild;

    property Parent: TNode read FParent;
    property LastChild: TNode read GetLastChild;
  end;

  TParentNode = class( TNode )
  private
    FChildren: TList<TNode>;
  protected
    function GetLastChild: TNode; override;
    function GetChildCount: Integer; override;
    function GetChild( Index: Integer ): TNode; override;
  public
    constructor Create( AParent: TNode; ANodeType: TNodeType );
    destructor Destroy; override;

    procedure AddChild( ANode: TNode ); override;
  end;

  TRefNode = class( TParentNode )
  private
    FDataReference: string;
    FReferenceDict: TDictionary<string, TNode>;
  protected
    function GetChildCount: Integer; override;
    function GetChild( Index: Integer ): TNode; override;
    function GetData: string; override;
  public
    constructor Create( AParent: TNode; ANodeType: TNodeType; const ADataReference: string; AReferenceDict: TDictionary<string, TNode> );
  end;

  TDataNode = class( TParentNode )
  private
    FData: string;
  protected
    function GetData: string; override;
  public
    constructor Create( AParent: TNode; ANodeType: TNodeType; const AData: string );

  end;

  TGedFile = class( TParentNode )
  private
    FReferenceDict: TDictionary<string, TNode>;
    function GetParent( Index: Integer ): TNode;
    function ParseLine( const ALine: string ): TDataRecord;
  public
    constructor Create( );
    destructor Destroy; override;

    procedure LoadFromFile( const Filename: string );
  end;

  { TNode }

constructor TNode.Create( AParent: TNode; ANodeType: TNodeType );
begin
  inherited Create;
  FNodeType := ANodeType;
  if Assigned( AParent )
  then
    AParent.AddChild( Self );
end;

function TNode.GetData: string;
begin
  Result := '';
end;

function TNode.ToString: string;
begin
  if Data.IsEmpty
  then
    Result := FNodeType.ToString
  else
    Result := FNodeType.ToString + ' ' + Data.QuotedString;
end;

{ TGedFile }

constructor TGedFile.Create( );
begin
  inherited Create( nil, TNodeType.Create( 'FILE' ) );
  FReferenceDict := TDictionary<string, TNode>.Create;
end;

destructor TGedFile.Destroy;
begin
  FReferenceDict.Free;
  inherited;
end;

function TGedFile.GetParent( Index: Integer ): TNode;
begin
  Result := Self;
  while Index > 0 do
    begin
      if not Assigned( Result )
      then
        raise Exception.Create( 'Fehlermeldung' );
      Result := Result.LastChild;
      Dec( Index );
    end;
end;

procedure TGedFile.LoadFromFile( const Filename: string );
var
  LValue: TDataRecord;
  LCurrent: TNode;
  LCurrentIdx: Integer;
  LLines: TStringList;
  LLine: string;
begin
  LCurrent := Self;
  LCurrentIdx := 0;

  LLines := TStringList.Create;
  try

    LLines.LoadFromFile( Filename );

    for LLine in LLines do
      begin

        LValue := ParseLine( LLine );

        while LCurrentIdx <> LValue.Level do
          begin
            if LCurrentIdx < LValue.Level
            then
              begin
                LCurrent := LCurrent.LastChild;
                Inc( LCurrentIdx );
              end
            else
              begin
                LCurrent := LCurrent.Parent;
                Dec( LCurrentIdx );
              end;
          end;

        if LValue.DataIsReference
        then
          LCurrent := TRefNode.Create( LCurrent, TNodeType.Create( LValue.NodeTypeStr ), LValue.Data, FReferenceDict )
        else
          LCurrent := TDataNode.Create( LCurrent, TNodeType.Create( LValue.NodeTypeStr ), LValue.Data );

        Inc( LCurrentIdx );

        if not LValue.Reference.IsEmpty
        then
          FReferenceDict.Add( LValue.Reference, LCurrent );
      end;

  finally
    LLines.Free;
  end;

end;

function TGedFile.ParseLine( const ALine: string ): TDataRecord;
var
  LValues: TArray<string>;
  LPrefix: string;
begin
  LValues := ALine.Split( [' '], 3 );
  Result.Level := LValues[0].ToInteger;

  // Reference gefunden?
  if LValues[1].StartsWith( '@' )
  then
    begin
      Result.Reference := LValues[1];
      Result.NodeTypeStr := LValues[2];
    end
  else
    begin
      Result.Reference := '';
      Result.NodeTypeStr := LValues[1];
      SetLength( LValues, 2 );
    end;

  LPrefix := string.Join( ' ', LValues );

  Result.Data := ALine.Substring( LPrefix.Length + 1 );
  Result.DataIsReference := Result.Data.StartsWith( '@' );
end;

{ TNodeType }

constructor TNodeType.Create( const ATypeName: string );
begin
  FTypeName := ATypeName.ToUpper;
end;

function TNodeType.ToString: string;
begin
  Result := FTypeName;
end;

{ TParentNode }

procedure TParentNode.AddChild( ANode: TNode );
begin
  inherited;
  if Assigned( ANode.Parent ) and ( ANode.Parent <> nil )
  then
    raise Exception.Create( 'Fehlermeldung' );

  ANode.FParent := Self;

  if not FChildren.Contains( ANode )
  then
    FChildren.Add( ANode );
end;

constructor TParentNode.Create( AParent: TNode; ANodeType: TNodeType );
begin
  inherited Create( AParent, ANodeType );
  FChildren := TObjectList<TNode>.Create( );
end;

destructor TParentNode.Destroy;
begin
  FChildren.Free;
  inherited;
end;

function TParentNode.GetChild( Index: Integer ): TNode;
begin
  Result := FChildren[Index];
end;

function TParentNode.GetChildCount: Integer;
begin
  Result := FChildren.Count;
end;

function TParentNode.GetLastChild: TNode;
begin
  Result := FChildren.Last;
end;

{ TRefNode }

constructor TRefNode.Create( AParent: TNode; ANodeType: TNodeType; const ADataReference: string; AReferenceDict: TDictionary<string, TNode> );
begin
  inherited Create( AParent, ANodeType );
  FDataReference := ADataReference;
  FReferenceDict := AReferenceDict;
end;

function TRefNode.GetChild( Index: Integer ): TNode;
var
  LRefNode: TNode;
begin
  LRefNode := FReferenceDict[FDataReference];

  if index < LRefNode.ChildCount
  then
    Result := LRefNode.Children[Index]
  else
    Result := inherited GetChild( Index - LRefNode.ChildCount );
end;

function TRefNode.GetChildCount: Integer;
begin
  Result := inherited GetChildCount + FReferenceDict[FDataReference].ChildCount;;
end;

function TRefNode.GetData: string;
begin
  Result := FDataReference;
end;

{ TDataNode }

constructor TDataNode.Create( AParent: TNode; ANodeType: TNodeType; const AData: string );
begin
  inherited Create( AParent, ANodeType );
  FData := AData;
end;

function TDataNode.GetData: string;
begin
  Result := FData;
end;

function OutputNode( ANode: TNode; ALevel: Integer = 0; AFollowRef: Boolean = True ): string;
var
  LIdx: Integer;
  LSB: TStringBuilder;
begin
  LSB := nil;
  try

    LSB := TStringBuilder.Create;
    LSB.Append( ' ', ALevel );
    LSB.Append( ANode.ToString );
    if ( ANode is TRefNode )
    then
      begin
        LSB.Append( ' (Ref)' );
      end;

    if ( ANode is TRefNode ) and not AFollowRef
    then
      begin
        LSB.Append( ' [NOT FOLLOWED]' );
        LSB.AppendLine;
      end
    else
      begin

        LSB.AppendLine;

        for LIdx := 0 to ANode.ChildCount - 1 do
          LSB.Append(
            {} OutputNode(
              {} ANode.Children[LIdx],
              {} ALevel + 1,
              {} not( ANode is TRefNode )
              {} ) );

      end;

    Result := LSB.ToString;
  finally
    LSB.Free;
  end;
end;

procedure Main;
var
  LFile: TGedFile;
  LFilename: string;
begin
  LFile := TGedFile.Create( );
  try

    LFilename := '..\..\TestGED.ged';

    LFile.LoadFromFile( LFilename );
    TFile.WriteAllText( TPath.ChangeExtension( LFilename, '.txt' ), OutputNode( LFile ) );
  finally
    LFile.Free;
  end;
end;

begin
  try
    Main;
  except
    on E: Exception do
      WriteLn( E.ClassName, ': ', E.Message );
  end;
  ReadLn;

end.