unit uXMLSAX;

// Note: The project should define the XML parsing backend. The default one
// is based on libxml2. However, note that the libxml2 interfaces for Delphi
// were created for a fairly old and buggy version of libxml2, which might
// be an issue.
// Currently known backends:
// {$DEFINE XMLSAX_BACKEND_LIBXML2}
// {$DEFINE XMLSAX_BACKEND_OXML}

{$UNDEF XMLSAX_BACKEND_FOUND}
{$IFDEF XMLSAX_BACKEND_LIBXML2}
  {$IFDEF XMLSAX_BACKEND_FOUND}
    {$MESSAGE ERROR 'Multiple XML backends found'}
  {$ENDIF}
  {$DEFINE XMLSAX_BACKEND_FOUND}
{$ENDIF}
{$IFDEF XMLSAX_BACKEND_OXML}
  {$IFDEF XMLSAX_BACKEND_FOUND}
    {$MESSAGE ERROR 'Multiple XML backends found'}
  {$ENDIF}
  {$DEFINE XMLSAX_BACKEND_FOUND}
{$ENDIF}

{$IFNDEF XMLSAX_BACKEND_FOUND}
  {$DEFINE XMLSAX_BACKEND_LIBXML2}
{$ENDIF}

{$IFDEF XMLSAX_BACKEND_LIBXML2}
{$DEFINE LIBXML_ENDELEMENT_BUG}
  // libxml2 contains a bug (or a feature) that relates to empty-element tags
  // such as <name ... />: Unlike with all the other elements, it never reports
  // a XML_READER_TYPE_END_ELEMENT and rather behaves as if the element never
  // ended. This define enables a workaround for this issue.
{$ENDIF}

interface

uses
  {$IFDEF XMLSAX_BACKEND_LIBXML2}
  libxml2,
  {$ENDIF}
  {$IFDEF XMLSAX_BACKEND_OXML}
  OXmlSAX, OXmlReadWrite, OWideSupp, OXmlUtils,
  {$ENDIF}
  SysUtils, Classes, Windows;

type
  EXMLSAXError = class(Exception);
  EXMLSAXReaderError = class(EXMLSAXError);
  EXMLSAXWriterError = class(EXMLSAXError);

type
  TXMLSAX = class
  public
    type
      {$IFDEF XMLSAX_BACKEND_LIBXML2}
      TSAXString = xmlCharPtr;
      {$ENDIF}
      TAttribute = record
        Name: string;
        Value: string;
      end;
      TAttributes = array of TAttribute;
      TXmlNodeHandler = reference to procedure (Sender: TObject; const Element: string; const Attributes: TAttributes);
      TXmlDataHandler = reference to procedure (Sender: TObject; const Element: string; const Attributes: TAttributes; const Value: string; const ValueIsCDATA: boolean);
      TXmlProgressHandler = reference to procedure (Sender: TObject; const Position: int64);
  protected
    {$IFDEF XMLSAX_BACKEND_LIBXML2}
    class procedure ParseXmlNode(Sender: TObject; Reader: xmlTextReaderPtr; NodeHandler: TXmlNodeHandler; DataHandler: TXmlDataHandler; ProgressHandler: TXmlProgressHandler; ElementStack: TList; var FilePositionHigh, LastFilePositionLow: DWORD);
    {$ENDIF}
  public
    {$IFDEF XMLSAX_BACKEND_LIBXML2}
    class procedure ParseXml(Sender: TObject; Reader: xmlTextReaderPtr; NodeHandler: TXmlNodeHandler; DataHandler: TXmlDataHandler; ProgressHandler: TXmlProgressHandler = nil);
    class function XmlToStr(const Value: TSAXString; const FreeIt: boolean = True): string;
    {$ENDIF}
    class procedure ParseXmlFile(Sender: TObject; const FileName: string; NodeHandler: TXmlNodeHandler; DataHandler: TXmlDataHandler; ProgressHandler: TXmlProgressHandler = nil);
    class function GetCopyrightAttributionString: string;
  end;

  TXMLSAXWriter = class
  protected
    type
      TXMLSAXWriterElementInfo = class
      public
        Name: string;
        IsClosed: boolean;
      end;
  private
    {$IFDEF XMLSAX_BACKEND_LIBXML2}
    FWriter: xmlTextWriterPtr;
    {$ENDIF}
    {$IFDEF XMLSAX_BACKEND_OXML}
    FOpenElements: TList;
    FWriter: TXMLWriter;
    {$ENDIF}
  protected
    {$IFDEF XMLSAX_BACKEND_LIBXML2}
    procedure Check(ReturnCode: integer; const Msg: string);
    function Encode(const Value: string): RawByteString;
    property Writer: xmlTextWriterPtr read FWriter;
    {$ENDIF}
    {$IFDEF XMLSAX_BACKEND_OXML}
    property Writer: TXMLWriter read FWriter;
    {$ENDIF}
    procedure AppendElement(const Name: string);
    procedure AppendElementEnd;
    procedure AppendProcessingInstruction(const Name, Value: string);
    procedure AppendAttribute(const Name: string; const Value: string);
    procedure AppendString(const Value: string);
    {$IFDEF XMLSAX_BACKEND_OXML}
    function GetLastOpenElement(out Element: TXMLSAXWriterElementInfo; Extract: boolean): boolean; overload;
    function GetLastOpenElement(Extract: boolean): TXMLSAXWriterElementInfo; overload;
    {$ENDIF}
  public
    constructor Create(const FileName: string);
    destructor Destroy; override;
    procedure Flush;
  end;

implementation

type
  TElementInfo = class
  private
    const GROWTH_FACTOR = 16;
  public
    constructor Create;
    procedure Clear;
    procedure AddAttribute(const Name, Value: string);
  public
    Name: string;
    AttributeCount: integer;
    Attributes: TXMLSAX.TAttributes;
    Value: string;
    ValueIsCDATA: boolean;
    HeaderSent: boolean;
    DataSent: boolean;
  end;

{$IFDEF XMLSAX_BACKEND_OXML}
type
  TMySAXParser = class(TSAXParser)
  private
    FSender: TObject;
    FNodeHandler: TXMLSAX.TXmlNodeHandler;
    FDataHandler: TXMLSAX.TXmlDataHandler;
    FProgressHandler: TXMLSAX.TXmlProgressHandler;
    FCurrentElement: TElementInfo;
    FElementStack: TList;
    function GetCurrentElement(Extract: boolean): TElementInfo;
  private
    const
      InitialElement = nil;
  protected
    procedure HandleStartDocument(aSaxParser: TSAXParser);
    procedure HandleEndDocument(aSaxParser: TSAXParser);
    procedure HandleStartElement(Sender: TSAXParser; const aName: OWideString; const aAttributes: TSAXAttributes);
    procedure HandleEndElement(Sender: TSAXParser; const aName: OWideString);
    procedure HandleCharacters(Sender: TSAXParser; const aText: OWideString);
    procedure DoProgress;
  public
    constructor Create(Sender: TObject; NodeHandler: TXMLSAX.TXmlNodeHandler; DataHandler: TXMLSAX.TXmlDataHandler; ProgressHandler: TXMLSAX.TXmlProgressHandler);
    destructor Destroy; override;
    property ElementStack: TList read FElementStack;
  end;
{$ENDIF}

{ TElementInfo }

constructor TElementInfo.Create;
begin
  inherited;
  Clear;
end;

procedure TElementInfo.Clear;
begin
  Name := '';
  AttributeCount := 0;
  SetLength(Attributes, 0);
  Value := '';
  ValueIsCDATA := False;
  HeaderSent := False;
  DataSent := False;
end;

procedure TElementInfo.AddAttribute(const Name, Value: string);
var
  Attribute: TXMLSAX.TAttribute;
  n: integer;
begin
  n := Length(Attributes);
  if n <= AttributeCount then
    SetLength(Attributes, n + GROWTH_FACTOR);
  Attribute.Name := Name;
  Attribute.Value := Value;
  Attributes[AttributeCount] := Attribute;
  Inc(AttributeCount);
end;

{ TMySAXParser }

{$IFDEF XMLSAX_BACKEND_OXML}

constructor TMySAXParser.Create(Sender: TObject; NodeHandler: TXMLSAX.TXmlNodeHandler; DataHandler: TXMLSAX.TXmlDataHandler; ProgressHandler: TXMLSAX.TXmlProgressHandler);
begin
  inherited Create;
  FSender := Sender;
  FNodeHandler := NodeHandler;
  FDataHandler := DataHandler;
  FProgressHandler := ProgressHandler;
  FCurrentElement := nil;
  Self.OnStartDocument := Self.HandleStartDocument;
  Self.OnEndDocument := Self.HandleEndDocument;
  Self.OnStartElement := Self.HandleStartElement;
  Self.OnEndElement := Self.HandleEndElement;
  Self.OnCharacters := Self.HandleCharacters;
end;

destructor TMySAXParser.Destroy;
begin
  FreeAndNil(FCurrentElement);
  inherited;
end;

procedure TMySAXParser.DoProgress;
begin
  if Assigned(FProgressHandler) then
  begin
    FProgressHandler(FSender, ApproxStreamPosition);
  end;
end;

function TMySAXParser.GetCurrentElement(Extract: boolean): TElementInfo;
var
  ElementIndex: integer;
begin
  if FElementStack = nil then
    Raise EXMLSAXReaderError.Create('Invalid XML file');
  if FElementStack.Count <= 0 then
    Raise EXMLSAXReaderError.Create('Invalid XML file');
  ElementIndex := FElementStack.Count - 1;
  Result := FElementStack[ElementIndex];
  if Extract then
    FElementStack.Delete(ElementIndex);
  if Result = nil then
    Raise EXMLSAXReaderError.Create('Invalid XML file');
end;

procedure TMySAXParser.HandleCharacters(Sender: TSAXParser; const aText: OWideString);
var
  Element: TElementInfo;
begin
  Element := GetCurrentElement(False);
  if TMySAXParser(Sender).FReaderToken.TokenType = rtCData then
  begin
    if (not Element.ValueIsCDATA) and (Trim(Element.Value) <> '') then
      Raise EXMLSAXReaderError.Create('Invalid XML file: mixed plaintext and CDATA');
    if aText <> '' then
      Element.Value := Element.Value + aText;
    Element.ValueIsCDATA := True;
  end
  else
  begin
    if aText <> '' then
    begin
      if Element.ValueIsCDATA then
        Raise EXMLSAXReaderError.Create('Invalid XML file: mixed plaintext and CDATA');
      Element.Value := Element.Value + aText;
    end;
  end;
  DoProgress;
end;

procedure TMySAXParser.HandleEndDocument(aSaxParser: TSAXParser);
begin
  try
    if (FElementStack.Count <> 1) or (FElementStack[0] <> InitialElement) then
      Raise EXMLSAXReaderError.Create('Invalid XML file');
  finally
    FreeAndNil(FElementStack);
  end;
end;

procedure TMySAXParser.HandleEndElement(Sender: TSAXParser; const aName: OWideString);
var
  Element: TElementInfo;
begin
  Element := GetCurrentElement(True);
  try
    if Assigned(FDataHandler) then
    begin
      FDataHandler(FSender, Element.Name, Element.Attributes, Element.Value, Element.ValueIsCDATA);
    end;
  finally
    FreeAndNil(Element);
  end;
  DoProgress;
end;

procedure TMySAXParser.HandleStartDocument(aSaxParser: TSAXParser);
begin
  FreeAndNil(FElementStack);
  FElementStack := TList.Create;
  FElementStack.Add(InitialElement);
end;

procedure TMySAXParser.HandleStartElement(Sender: TSAXParser; const aName: OWideString; const aAttributes: TSAXAttributes);
var
  Element, LastElement: TElementInfo;
  AttributeIndex: integer;
begin
  Element := TElementInfo.Create;
  try
    Element.Name := aName;
    for AttributeIndex := 0 to Pred(aAttributes.Count) do
      Element.AddAttribute(aAttributes[AttributeIndex].NodeName, aAttributes[AttributeIndex].NodeValue);
    LastElement := Element;
    FElementStack.Add(Element);
    Element := nil;
  finally
    FreeAndNil(Element);
  end;
  if Assigned(FNodeHandler) then
  begin
    FNodeHandler(FSender, LastElement.Name, LastElement.Attributes);
  end;
  DoProgress;
end;

{$ENDIF}

{ TXMLSAX }

{$IFDEF XMLSAX_BACKEND_LIBXML2}
class procedure TXMLSAX.ParseXml(Sender: TObject; Reader: xmlTextReaderPtr; NodeHandler: TXmlNodeHandler; DataHandler: TXmlDataHandler; ProgressHandler: TXmlProgressHandler);
const
  InitialElement = nil;
var
  ElementStack: TList;
  FilePositionHigh, LastFilePositionLow: DWORD;
begin
  if not Assigned(Reader) then
    Raise EXMLSAXReaderError.Create('XML reader not active');
  ElementStack := TList.Create;
  try
    ElementStack.Add(InitialElement);
    FilePositionHigh := 0;
    LastFilePositionLow := 0;
    ParseXmlNode(Sender, Reader, NodeHandler, DataHandler, ProgressHandler, ElementStack, FilePositionHigh, LastFilePositionLow);
    if (ElementStack.Count <> 1) or (ElementStack[0] <> InitialElement) then
      Raise EXMLSAXReaderError.Create('Invalid XML file');
  finally
    FreeAndNil(ElementStack);
  end;
end;
{$ENDIF}

class function TXMLSAX.GetCopyrightAttributionString: string;
begin
  {$IFDEF XMLSAX_BACKEND_LIBXML2}
  Result := '';
  {$ENDIF}
  {$IFDEF XMLSAX_BACKEND_OXML}
  Result := ''
    + 'Attribution Copyright Notice: Ondrej Pokorny, Kluug.net'#13#10
    + 'Attribution Phrase: This software uses OXml by Kluug.net.'#13#10
    + 'Attribution URL: https://www.kluug.net'#13#10
    ;
  {$ENDIF}
end;

class procedure TXMLSAX.ParseXmlFile(Sender: TObject; const FileName: string; NodeHandler: TXmlNodeHandler; DataHandler: TXmlDataHandler; ProgressHandler: TXmlProgressHandler);
{$IFDEF XMLSAX_BACKEND_LIBXML2}
var
  FileNameAnsi: AnsiString;
  Reader: xmlTextReaderPtr;
{$ENDIF}
{$IFDEF XMLSAX_BACKEND_OXML}
var
  Parser: TSAXParser;
{$ENDIF}
begin
  {$IFDEF XMLSAX_BACKEND_LIBXML2}
  FileNameAnsi := AnsiString(FileName);
  if FileName <> string(FileNameAnsi) then
    raise EInOutError.Create('Only ANSI filenames can be processed using TXMLSAX.ParseXmlFile');
  Reader := xmlReaderForFile(TSAXString(FileNameAnsi), nil, 0);
  if not Assigned(Reader) then
    raise EInOutError.Create('Failed to open XML file: ' + FileName);
  try
    ParseXml(Sender, Reader, NodeHandler, DataHandler, ProgressHandler);
  finally
    xmlFreeTextReader(Reader);
  end;
  {$ELSE}
  {$IFDEF XMLSAX_BACKEND_OXML}
  Parser := TMySAXParser.Create(Sender, NodeHandler, DataHandler, ProgressHandler);
  try
    Parser.ParseFile(FileName);
  finally
    FreeAndNil(Parser);
  end;
  {$ELSE}
    {$MESSAGE ERROR 'SAX implementation incomplete: TXMLSAX.ParseXmlFile'}
  {$ENDIF}
  {$ENDIF}
end;

{$IFDEF XMLSAX_BACKEND_LIBXML2}
class procedure TXMLSAX.ParseXmlNode(Sender: TObject; Reader: xmlTextReaderPtr; NodeHandler: TXmlNodeHandler; DataHandler: TXmlDataHandler; ProgressHandler: TXmlProgressHandler; ElementStack: TList; var FilePositionHigh, LastFilePositionLow: DWORD);

  procedure DoProgress;
  var
    NewFilePositionLow: DWORD;
    NewPosition: int64;
  begin
    NewFilePositionLow := DWORD(xmlTextReaderByteConsumed(Reader));
    if NewFilePositionLow < LastFilePositionLow then // should only happen when we overflow the DWORD
      Inc(FilePositionHigh);
    LastFilePositionLow := NewFilePositionLow;
    NewPosition := FilePositionHigh;
    NewPosition := NewPosition shl 32;
    NewPosition := NewPosition + NewFilePositionLow;
    if Assigned(ProgressHandler) then
      ProgressHandler(Sender, NewPosition);
  end;

  procedure SendElementHeader(const Element: TElementInfo);
  begin
    if not Assigned(Element) then
      Exit; // only send the header once
    if Element.HeaderSent then
      Exit; // only send the header once
    Element.HeaderSent := True;
    SetLength(Element.Attributes, Element.AttributeCount);
    if Assigned(NodeHandler) then
      NodeHandler(Sender, Element.Name, Element.Attributes);
  end;

  procedure SendElementData(const Element: TElementInfo);
  begin
    if not Assigned(Element) then
      Exit; // only send the header once
    if Element.DataSent then
      Exit; // only send the data once
    Element.DataSent := True;
    SetLength(Element.Attributes, Element.AttributeCount);
    if Assigned(DataHandler) then
      DataHandler(Sender, Element.Name, Element.Attributes, Element.Value, Element.ValueIsCDATA);
    end;

  procedure EndElement(var Element: TElementInfo);
  var
    n: integer;
  begin
    if not Assigned(Element) then
      Exit; // only send the header once
    SendElementData(Element);
    FreeAndNil(Element);
    n := ElementStack.Count - 1;
    if n >= 0 then
      ElementStack.Delete(n);
    if n > 0 then
      Element := ElementStack[n - 1];
  end;

var
  Element: TElementInfo;
  Ret, NodeType: integer;
  Name, Value: string;
  {$IFDEF LIBXML_ENDELEMENT_BUG}
  Depth, LastDepth: integer;
  {$ENDIF}
begin
  {$IFDEF LIBXML_ENDELEMENT_BUG}
  LastDepth := -1;
  {$ENDIF}
  if ElementStack.Count <= 0 then
    raise EXMLSAXReaderError.Create('Internal error: Invalid element stack');
  Element := ElementStack[ElementStack.Count - 1];
  Ret := xmlTextReaderRead(Reader);
  while Ret = 1 do
  begin
    DoProgress;
    NodeType := xmlTextReaderNodeType(Reader);
    case NodeType of
      XML_READER_TYPE_ELEMENT:
        begin
          {$IFDEF LIBXML_ENDELEMENT_BUG}
          Depth := xmlTextReaderDepth(Reader);
          while Depth <= LastDepth do
          begin
            SendElementHeader(Element);
            EndElement(Element);
            Dec(LastDepth);
          end;
          LastDepth := Depth;
          {$ENDIF}
          // Send the header of the previous element
          SendElementHeader(Element);
          // Prepare a new child element
          Element := TElementInfo.Create;
          Element.Name := XmlToStr(xmlTextReaderName(Reader));
          ElementStack.Add(Element);
          Ret := xmlTextReaderMoveToFirstAttribute(Reader);
          if Ret <> 0 then
            Continue;
        end;
      XML_READER_TYPE_END_ELEMENT:
        begin
          {$IFDEF LIBXML_ENDELEMENT_BUG}
          Depth := xmlTextReaderDepth(Reader);
          while Depth < LastDepth do
          begin
            SendElementHeader(Element);
            EndElement(Element);
            Dec(LastDepth);
          end;
          {$ENDIF}
          // Send the header of the previous element if it weren't already sent
          SendElementHeader(Element);
          // Remove the element
          EndElement(Element);
          LastDepth := Pred(LastDepth);
        end;
      XML_READER_TYPE_ATTRIBUTE:
        begin
          // Add an attribute
          Name := XmlToStr(xmlTextReaderName(Reader));
          Value := XmlToStr(xmlTextReaderValue(Reader));
          if Name = '' then
            Raise EXMLSAXReaderError.Create('Invalid XML file: bad attribute name');
          Element.AddAttribute(Name, Value);
          Ret := xmlTextReaderMoveToNextAttribute(Reader);
          if Ret <> 0 then
            Continue;
        end;
      XML_READER_TYPE_TEXT:
        begin
          // Send the header of the previous element if it weren't already sent
          SendElementHeader(Element);
          // Add data
          Value := XmlToStr(xmlTextReaderValue(Reader));
          if Value <> '' then
          begin
            if Element.ValueIsCDATA then
              Raise EXMLSAXReaderError.Create('Invalid XML file: mixed plaintext and CDATA');
            Element.Value := Element.Value + Value;
          end;
        end;
      XML_READER_TYPE_CDATA:
        begin
          // Send the header of the previous element if it weren't already sent
          SendElementHeader(Element);
          // Add data
          if (not Element.ValueIsCDATA) and (Trim(Element.Value) <> '') then
            Raise EXMLSAXReaderError.Create('Invalid XML file: mixed plaintext and CDATA');
          Value := XmlToStr(xmlTextReaderValue(Reader));
          if Value <> '' then
            Element.Value := Element.Value + Value;
          Element.ValueIsCDATA := True;
        end;
      end;
    Ret := xmlTextReaderRead(Reader);
  end;
  if (Ret <> 0) and (Ret <> 1) then
    Raise EXMLSAXReaderError.CreateFmt('Invalid XML file (RetCode = %d)', [Ret]);
end;
{$ENDIF}

{$IFDEF XMLSAX_BACKEND_LIBXML2}
class function TXMLSAX.XmlToStr(const Value: TSAXString; const FreeIt: boolean): string;
begin
  Result := '';
  if Value <> nil then
  begin
    try
      Result := UTF8ToString(Value);
    finally
      if FreeIt then
      begin
        XmlFree(Value);
      end;
    end;
  end;
end;
{$ENDIF}

{ TXMLSAXWriter }

procedure TXMLSAXWriter.AppendAttribute(const Name, Value: string);
{$IFDEF XMLSAX_BACKEND_LIBXML2}
var
  XmlName, XmlValue: RawByteString;
{$ENDIF}
begin
  {$IFDEF XMLSAX_BACKEND_LIBXML2}
  XmlName := Encode(Name);
  XmlValue := Encode(Value);
  Check(xmlTextWriterWriteAttribute(Writer, PAnsiChar(XmlName), PAnsiChar(XmlValue)), 'xmlTextWriterWriteAttribute');
  {$ELSE}
  {$IFDEF XMLSAX_BACKEND_OXML}
  Writer.Attribute(Name, Value);
  {$ELSE}
  {$MESSAGE ERROR 'SAX implementation incomplete: TXMLSAXWriter.AppendAttribute'}
  {$ENDIF}
  {$ENDIF}
end;

procedure TXMLSAXWriter.AppendElement(const Name: string);
{$IFDEF XMLSAX_BACKEND_LIBXML2}
var
  XmlName: RawByteString;
{$ENDIF}
{$IFDEF XMLSAX_BACKEND_OXML}
var
  Element: TXMLSAXWriterElementInfo;
{$ENDIF}
begin
  {$IFDEF XMLSAX_BACKEND_LIBXML2}
  XmlName := Encode(Name);
  Check(xmlTextWriterStartElement(Writer, PAnsiChar(XmlName)), 'xmlTextWriterStartElement');
  {$ELSE}
  {$IFDEF XMLSAX_BACKEND_OXML}
  if GetLastOpenElement(Element, False) then
  begin
    if not Element.IsClosed then
    begin
      Writer.FinishOpenElement;
      Element.IsClosed := True;
    end;
  end;
  Writer.OpenElement(Name);
  Element := TXMLSAXWriterElementInfo.Create;
  try
    Element.Name := Name;
    Element.IsClosed := False;
    FOpenElements.Add(Element);
    Element := nil;
  finally
    FreeAndNil(Element);
  end;
  {$ELSE}
  {$MESSAGE ERROR 'SAX implementation incomplete: TXMLSAXWriter.AppendElement'}
  {$ENDIF}
  {$ENDIF}
end;

procedure TXMLSAXWriter.AppendElementEnd;
{$IFDEF XMLSAX_BACKEND_OXML}
var
  Element: TXMLSAXWriterElementInfo;
{$ENDIF}
begin
  {$IFDEF XMLSAX_BACKEND_LIBXML2}
  Check(xmlTextWriterEndElement(Writer), 'xmlTextWriterEndElement');
  {$ELSE}
  {$IFDEF XMLSAX_BACKEND_OXML}
  Element := GetLastOpenElement(True);
  try
    if not Element.IsClosed then
    begin
      Writer.FinishOpenElementClose;
    end
    else
    begin
      Writer.CloseElement(Element.Name);
    end;
  finally
    FreeAndNil(Element);
  end;
  {$ELSE}
  {$MESSAGE ERROR 'SAX implementation incomplete: TXMLSAXWriter.AppendElementEnd'}
  {$ENDIF}
  {$ENDIF}
end;

procedure TXMLSAXWriter.AppendProcessingInstruction(const Name, Value: string);
{$IFDEF XMLSAX_BACKEND_LIBXML2}
var
  XmlName: RawByteString;
  XmlValue: RawByteString;
{$ENDIF}
begin
  {$IFDEF XMLSAX_BACKEND_LIBXML2}
  XmlName := Encode(Name);
  XmlValue := Encode(Value);
  Check(xmlTextWriterStartPI(Writer, PAnsiChar(XmlName)), 'xmlTextWriterStartPI');
  Check(xmlTextWriterWriteString(Writer, PAnsiChar(XmlValue)), 'xmlTextWriterWriteString');
  Check(xmlTextWriterEndPI(Writer), 'xmlTextWriterEndPI');
  {$ELSE}
  {$IFDEF XMLSAX_BACKEND_OXML}
  Writer.ProcessingInstruction(Name, Value);
  {$ELSE}
  {$MESSAGE ERROR 'SAX implementation incomplete: TXMLSAXWriter.AppendProcessingInstruction'}
  {$ENDIF}
  {$ENDIF}
end;

procedure TXMLSAXWriter.AppendString(const Value: string);
{$IFDEF XMLSAX_BACKEND_LIBXML2}
var
  XmlValue: RawByteString;
{$ENDIF}
begin
  {$IFDEF XMLSAX_BACKEND_LIBXML2}
  XmlValue := Encode(Value);
  Check(xmlTextWriterWriteString(Writer, PAnsiChar(XmlValue)), 'xmlTextWriterWriteString');
  {$ELSE}
  {$IFDEF XMLSAX_BACKEND_OXML}
  Writer.RawText(Value);
  {$ELSE}
  {$MESSAGE ERROR 'SAX implementation incomplete: TXMLSAXWriter.AppendString'}
  {$ENDIF}
  {$ENDIF}
end;

{$IFDEF XMLSAX_BACKEND_LIBXML2}
procedure TXMLSAXWriter.Check(ReturnCode: integer; const Msg: string);
var
  LastError: xmlErrorPtr;
begin
  if ReturnCode < 0 then
  begin
    LastError := xmlGetLastError();
    if LastError = nil then
      raise EXMLSAXWriterError.CreateFmt('%s (rc = %d)', [Msg, ReturnCode])
    else
      raise EXMLSAXWriterError.CreateFmt('%s (rc = %d): %s', [Msg, ReturnCode, LastError.message]);
  end;
end;
{$ENDIF}

constructor TXMLSAXWriter.Create(const FileName: string);
{$IFDEF XMLSAX_BACKEND_LIBXML2}
var
  FileNameAnsi: AnsiString;
{$ENDIF}
begin
  inherited Create;
  {$IFDEF XMLSAX_BACKEND_LIBXML2}
  FileNameAnsi := AnsiString(FileName);
  if FileName <> string(FileNameAnsi) then
    raise EInOutError.Create('Only ANSI filenames can be processed using TXMLSAX.ParseXmlFile');
  FWriter := xmlNewTextWriterFilename(PAnsiChar(FileNameAnsi), 0);
  if not Assigned(FWriter) then
    raise EInOutError.Create('Failed to create XML file: ' + FileName);
  xmlTextWriterSetIndent(Writer, 1);
  Check(xmlTextWriterStartDocument(Writer, nil, 'UTF-8', nil), 'xmlTextWriterStartDocument');
  {$ENDIF}
  {$IFDEF XMLSAX_BACKEND_OXML}
  FOpenElements := TList.Create;
  FWriter := TXMLWriter.Create;
  FWriter.WriterSettings.WriteBOM := True;
  FWriter.WriterSettings.IndentType := itIndent;
  FWriter.InitFile(FileName);
  FWriter.XMLDeclaration;
  {$ENDIF}
end;

destructor TXMLSAXWriter.Destroy;
{$IFDEF XMLSAX_BACKEND_OXML}
var
  Element: TXMLSAXWriterElementInfo;
{$ENDIF}
begin
  {$IFDEF XMLSAX_BACKEND_LIBXML2}
  if Assigned(FWriter) then
  begin
    Check(xmlTextWriterEndDocument(Writer), 'xmlTextWriterEndDocument');
    xmlFreeTextWriter(FWriter);
    FWriter := nil;
  end;
  {$ENDIF}
  {$IFDEF XMLSAX_BACKEND_OXML}
  if Assigned(Writer) then
  begin
    while GetLastOpenElement(Element, True) do
    begin
      try
        if not Element.IsClosed then
          Writer.CloseElement(Element.Name);
      finally
        FreeAndNil(Element);
      end;
    end;
    FreeAndNil(FWriter);
  end;
  FreeAndNil(FOpenElements);
  {$ENDIF}
  inherited;
end;

{$IFDEF XMLSAX_BACKEND_LIBXML2}
function TXMLSAXWriter.Encode(const Value: string): RawByteString;
begin
  Result := UTF8Encode(Value);
end;
{$ENDIF}

procedure TXMLSAXWriter.Flush;
begin
  {$IFDEF XMLSAX_BACKEND_LIBXML2}
  xmlTextWriterFlush(Writer);
  {$ELSE}
  {$IFDEF XMLSAX_BACKEND_OXML}
  // No such function
  {$ELSE}
  {$MESSAGE ERROR 'SAX implementation incomplete: TXMLSAXWriter.Flush'}
  {$ENDIF}
  {$ENDIF}
end;

{$IFDEF XMLSAX_BACKEND_OXML}
function TXMLSAXWriter.GetLastOpenElement(out Element: TXMLSAXWriterElementInfo; Extract: boolean): boolean;
var
  Index: integer;
begin
  Result := False;
  Element := nil;
  if FOpenElements = nil then
    Exit;
  Index := FOpenElements.Count - 1;
  if Index < 0 then
    Exit;
  Element := FOpenElements[Index];
  if Extract then
    FOpenElements.Delete(Index);
  if Element = nil then
    Exit;
  Result := True;
end;
{$ENDIF}

{$IFDEF XMLSAX_BACKEND_OXML}
function TXMLSAXWriter.GetLastOpenElement(Extract: boolean): TXMLSAXWriterElementInfo;
begin
  if not GetLastOpenElement(Result, Extract) then
    raise EXMLSAXWriterError.Create('Internal error: invalid last open element');
end;
{$ENDIF}

end.
