source: branches/xpascal/Generators/GeneratorXml.pas

unit GeneratorXml;

interface

uses
  Classes, SysUtils, Source, SourceNode, Generator;

type
  { TGeneratorXml }

  TGeneratorXml = class(TGenerator)
  private
    procedure GenerateNodes(SourceNodes: TSourceNodeList<TSourceNode>;
      NodeName: string);
    procedure GenerateNode(SourceNode: TSourceNode; NodeName: string);
  public
    procedure Generate; override;
    constructor Create; override;
  end;


implementation

resourcestring
  SUnsupportedNodeType = 'Unsupported node type';

{ TGeneratorXml }

procedure TGeneratorXml.GenerateNodes(SourceNodes: TSourceNodeList<TSourceNode>;
  NodeName: string);
var
  I: Integer;
begin
  for I := 0 to SourceNodes.Count - 1 do begin
    if SourceNodes[I] is TSourceNode then begin
      GenerateNode(TSourceNode(SourceNodes[I]), NodeName);
    end else raise Exception.Create(SUnsupportedNodeType);
  end;
end;

procedure TGeneratorXml.GenerateNode(SourceNode: TSourceNode; NodeName: string);
var
  I: Integer;
  Field: TField;
  Obj: TObject;
  List: TSourceNodeList<TSourceNode>;
begin
  if SourceNode is TSourceNode then begin
    AddTextLine('<' + NodeName + '>');
    Indent := Indent + 1;
    for I := 0 to SourceNode.FieldsCount - 1 do begin
      Field := SourceNode.GetField(I);
      try
        if Field.DataType = dtObject then begin
          Obj := SourceNode.GetValueObject(I);
          if Obj is TSourceNode then
            GenerateNode(TSourceNode(Obj), Field.Name);
        end else
        if Field.DataType = dtList then begin
          SourceNode.GetValue(I, List);
          if List.Count > 0 then
            GenerateNodes(List, Field.Name);
        end else
        if Field.DataType = dtString then begin
          if SourceNode.GetValueString(I) <> '' then
            AddTextLine('<' + Field.Name + '>' + SourceNode.GetValueString(I) +
              '</' + Field.Name + '>');
        end;
      finally
        Field.Free;
      end;
    end;
    Indent := Indent - 1;
    AddTextLine('</' + NodeName + '>');
  end else
    raise Exception.Create(SUnsupportedNodeType);
end;

procedure TGeneratorXml.Generate;
begin
  AddTextLine('<?xml version="1.0" encoding="UTF-8"?>');
  GenerateNode(Prog, 'Program');
end;

constructor TGeneratorXml.Create;
begin
  inherited;
  Name := 'XML';
  FileExt := '.xml';
end;

end.