[yunqa.de] Re: DIXml: XSLT transformation - How to trap errors

  • From: Delphi Inspiration <delphi@xxxxxxxx>
  • To: yunqa@xxxxxxxxxxxxx
  • Date: Tue, 02 Nov 2010 14:41:14 +0100

On 29.10.2010 11:14, FNProgramvare wrote:

> Example code:
> 
> <xsl:stylesheet version="1.0"
> xmlns:xsl="http://www.w3.org/1999/XSL/Transform";>
> <xsl:template match="/">
> <html>
>   <head>
>   </head>
>   <body>
>     <xsl:text>This text is output</xsl:text>
>     <xsl:variable name="subTotals">
>       <xsl:for-each select="$invoices/invoice/item">
>       </xsl:for-each>
>     </xsl:variable>
>     <xsl:text>This text is not output</xsl:text>
>   </body>
> </html>
> </xsl:template>
> </xsl:stylesheet>
> 
> I have set up an error handler with xmlSetStructuredErrorFunc. However,
> it is not getting called.

The xmlSetStructuredErrorFunc() error handler is somewhat limited. In
particular, it is not invoked for XSLT errors.

The advantage for Delphi users is that xmlSetStructuredErrorFunc reports
"structured" error messages which are easy to process. Other error
handlers apply C printf error messages instead, which are not natively
supported by Delphi.

> If I use the xsltproc command line utility, I get this error data:
> 
>   runtime error: file test.xsl line 12 element for-each
>   Variable 'invoices' has not been declared.
>   xmlXPathCompiledEval: evaluation failed
>   runtime error: file test.xsl line 12 element for-each
>   Failed to evaluate the 'select' expression.
> 
> How can I display the same error data using DIXml?

The xsltproc command line utility writes errors to the C stdout / stderr
streams which are not available in Delphi.

Fortunately, DIXml supports a "generic" error handler in addition to the
"structured" one mentioned above. There are two separate generic error
handlers, one for XML and another for XSLT errors:

  * xmlSetGenericErrorFunc()
  * xsltSetGenericErrorFunc()

The error data you are seeing with xsltproc is reported throuth the
xsltSetGenericErrorFunc() handler.

Both the XML and the XSLT handlers pass their error messages in C printf
style to a CEDECL VARARGS function. Delphi supports VARARGS for external
functions only, but a workaround is available.

I have modified DIXml_XSLT_Browser_fMain.pas to use the generic error
handlers and added a very simple sprintf() Delphi port to format the
actual error messages (attached).

Using this updated version, DIXml_XSLT_Browser outputs the same error
messages as xsltproc.

Ralf
{ DIXml Demo to perform XSL transformation.

  Visit the DIXml Internet site for latest information and updates:

    http://www.yunqa.de/delphi/

  Copyright (c) 2007-2010 Ralf Junker, The Delphi Inspiration <delphi@xxxxxxxx>

------------------------------------------------------------------------------ }

unit DIXml_XSLT_Browser_fMain;

{.$DEFINE Debug}// Default: Off

{$I DI.inc}

{ Suppress some Delphi Unicode string conversion warnings. }
{$IFDEF COMPILER_12_UP}
{$WARN IMPLICIT_STRING_CAST OFF}
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
{$WARN EXPLICIT_STRING_CAST OFF}
{$WARN EXPLICIT_STRING_CAST_LOSS OFF}
{$ENDIF COMPILER_12_UP}

interface

uses
  DISystemCompat, SysUtils, Classes, Forms, Controls, ComCtrls,
  StdCtrls, ExtCtrls, FileCtrl, OleCtrls,
  {$IFDEF COMPILER_5}
  SHDocVw
  {$ELSE}
  {$IFDEF COMPILER_10_UP}SHDocVw{$ELSE}ShDocVw_TLB{$ENDIF}
  {$ENDIF};

type
  TfrmXsltBrowser = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    pnlBottom: TPanel;
    btnShow: TButton;
    Splitter2: TSplitter;
    Splitter3: TSplitter;
    pnlDir: TPanel;
    pnlDirCaption: TPanel;
    pnlXsl: TPanel;
    flbXsl: TFileListBox;
    pnlXslCaption: TPanel;
    pnlXml: TPanel;
    flbXml: TFileListBox;
    pnlXmlCaption: TPanel;
    DirectoryListBox: TDirectoryListBox;
    PageControl: TPageControl;
    tsTransformation: TTabSheet;
    WebBrowser: TWebBrowser;
    tsXmlSource: TTabSheet;
    tsXslSource: TTabSheet;
    memoXmlSource: TMemo;
    memoXslSource: TMemo;
    tsErrors: TTabSheet;
    memoErrors: TMemo;
    tsTransformationSource: TTabSheet;
    memoTransformationSource: TMemo;
    pnlXmlCharSet: TPanel;
    cboXmlEncoding: TComboBox;
    pnlXslCharSet: TPanel;
    cboXslEncoding: TComboBox;
    Panel2: TPanel;
    cboDrive: TDriveComboBox;
    procedure ctrlExecute(Sender: TObject);
    procedure DirectoryListBoxChange(Sender: TObject);
    procedure flbChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FTransforming: Boolean;
    procedure DoTransform;
  end;

var
  frmXsltBrowser: TfrmXsltBrowser;

const
  APP_TITLE = 'DIXml Demo: XSLT Browser';

implementation

uses
  Windows, DIXml;

{$R *.dfm}

procedure AddEncodings(const s: TStrings);
const
  Encodings: array[0..20] of string =
    ('UTF-8', 'UTF-16', 'UTF-16LE', 'UTF-16BE', 'ASCII', 'HTML',
    'ISO-8859-1', 'ISO-8859-2', 'ISO-8859-3', 'ISO-8859-4', 'ISO-8859-5',
    'ISO-8859-6', 'ISO-8859-7', 'ISO-8859-8', 'ISO-8859-9', 'ISO-8859-10',
    'ISO-8859-11', 'ISO-8859-13', 'ISO-8859-14', 'ISO-8859-15', 'ISO-8859-16');
var
  i: Integer;
begin
  for i := Low(Encodings) to High(Encodings) do
    s.Add(Encodings[i]);
end;

//------------------------------------------------------------------------------

procedure TfrmXsltBrowser.FormCreate(Sender: TObject);
begin
  Caption := APP_TITLE;
  DirectoryListBox.Directory := ExtractFilePath(ParamStr(0));

  AddEncodings(cboXmlEncoding.Items); cboXmlEncoding.ItemIndex := 0;
  AddEncodings(cboXslEncoding.Items); cboXslEncoding.ItemIndex := 0;

  WebBrowser.Navigate('about:blank');

  {$IFDEF Debug}
  flbXml.ItemIndex := flbXml.Items.IndexOf('test.xml');
  flbXsl.ItemIndex := flbXsl.Items.IndexOf('test.xsl');
  DoTransform;
  {$ENDIF Debug}
end;

//------------------------------------------------------------------------------

{ A simple sprintf port from C to Pascal. Supports the the most frequently used
  format specifiers only. Please extend as necessary.

  Returns the number of characters written to Buffer. Buffer must be large
  enough to hold all output. If the output size is unknown, pass Buffer as nil
  to return the number of character in Buffer required to hold all output. }
function sprintf(Buffer: PAnsiChar; const Format: PAnsiChar; Args: Pointer): 
Integer;
var
  o: PAnsiChar; // Output buffer

  { Write a single character. Convert single line breaks to CRLF. }
  procedure Append(const c: AnsiChar); overload;
  begin
    if c = #10 then
      begin
        if Assigned(Buffer) then
          o^ := #13;
        Inc(o);
        if Assigned(Buffer) then
          o^ := #10;
        Inc(o);
      end
    else
      begin
        if Assigned(Buffer) then
          o^ := c;
        Inc(o);
      end;
  end;

  { Write a null-terminated string. }
  procedure Append(p: PAnsiChar); overload;
  begin
    while p^ <> #0 do
      begin
        Append(p^);
        Inc(p);
      end;
  end;

  { Write an AnsiString. }
  procedure Append(const s: AnsiString); overload;
  const
    AC_ZERO: AnsiChar = '0';
  var
    i, l: Integer;
  begin
    l := Length(s);
    for i := 1 to l do
      Append(s[i]);
  end;

label
  lblLiteralChar;
var
  a: PAnsiChar; // Args
  f: PAnsiChar; // Format string
  t: PAnsiChar; // Temp
begin
  f := Format;
  a := Args;
  o := Buffer;
  while f^ <> #0 do
    if f^ = '%' then // Format specifier should follow.
      begin
        Inc(f);

        case f^ of

          // Conversion-Type Characters

          // Numerics

          'd', 'i': // Signed decimal integer.
            begin
              Append(IntToStr(PInteger(a)^));
              Inc(a, SizeOf(Integer));
              Inc(f);
            end;

          'g': // Signed floating point value in either e or f form.
            begin
              Append(FloatToStr(PSingle(a)^));
              Inc(a, SizeOf(Single));
              Inc(f);
            end;

          'u': // Unsigned decimal integer.
            begin
              Append(IntToStr(PCardinal(a)^));
              Inc(a, SizeOf(Cardinal));
              Inc(f);
            end;

          'x': // Unsigned hexadecimal integer.
            begin
              Append(IntToHex(PCardinal(a)^, 8));
              Inc(a, SizeOf(Cardinal));
              Inc(f);
            end;

          // Characters

          '%': // Prints the '%' character.
            goto lblLiteralChar;

          's': // String pointer. Prints characters until null-terminator.
            begin
              t := PPAnsiChar(a)^;
              Inc(a, SizeOf(PAnsiChar));
              Append(t);
              Inc(f);
            end;

        else
          raise Exception.Create('Unsupported Format Specifier');
        end;
      end
    else
      begin
        lblLiteralChar:
        Append(f^);
        Inc(f);
      end;

  if Assigned(Buffer) then
    o^ := #0;

  Result := o - Buffer;
end;

//------------------------------------------------------------------------------

procedure OnGenericErrorFunc(UserData: Pointer; const Msg: PAnsiChar); cdecl;
var
  Args: PAnsiChar;
  l: Integer;
  s: AnsiString;
begin
  { Print message into buffer. Format arguments are passed as cdecl varargs,
    so we have to apply a Delphi little magic to retrieve them. }
  Args := Pointer(@Msg);
  Inc(Args, SizeOf(Msg));
  l := sprintf(nil, Msg, Args);

  SetString(s, nil, l);
  l := sprintf(Pointer(s), Msg, Args);

  { Trim trailing line breaks. }
  while (l > 0) and (s[l] in [#10, #13]) do
    Dec(l);
  SetLength(s, l);

  { Output final error message. }
  frmXsltBrowser.memoErrors.Lines.Add(s);
end;

//------------------------------------------------------------------------------

procedure TfrmXsltBrowser.DoTransform;
var
  XmlFile, XmlEncoding: string;
  XmlFile8, XmlEncoding8: Utf8String;
  XslFile, XslEncoding: string;
  XslFile8, XslEncoding8: Utf8String;
  ResultFile: string;
  resultfile8: Utf8String;
  OldCursor: TCursor;
  TC: xsltTransformContextPtr;
  XmlDoc, XslDoc, ResultDoc: xmlDocPtr;
  XslStyle: xsltStyleSheetPtr;
begin
  if not FTransforming and (flbXml.ItemIndex >= 0) and (flbXsl.ItemIndex >= 0) 
then
    begin
      FTransforming := True;
      btnShow.Enabled := False;
      OldCursor := Screen.Cursor;
      Screen.Cursor := crHourGlass;

      memoErrors.Lines.BeginUpdate;
      try
        memoErrors.Lines.Clear;

        XmlFile := flbXml.FileName;
        XmlEncoding := cboXmlEncoding.Text;
        memoXmlSource.Lines.LoadFromFile(XmlFile);

        XslFile := flbXsl.FileName;
        XslEncoding := cboXslEncoding.Text;
        memoXslSource.Lines.LoadFromFile(XslFile);

        ResultFile := ChangeFileExt(XmlFile, '.htm');
        SysUtils.DeleteFile(ResultFile);

        { Report XML and XSLT errors to the same callback function. }
        xmlSetGenericErrorFunc(nil, OnGenericErrorFunc);
        xsltSetGenericErrorFunc(nil, OnGenericErrorFunc);
        { Set some options. }
        xmlSubstituteEntitiesDefault(1);

        { Load the XML document. }
        XmlFile8 := Utf8Encode(XmlFile);
        XmlEncoding8 := Utf8Encode(XmlEncoding);
        XmlDoc := xmlReadFile(PAnsiChar(XmlFile8), PAnsiChar(XmlEncoding8), 0);
        if Assigned(XmlDoc) then
          try
            xmlXIncludeProcessFlags(XmlDoc, XSLT_PARSE_OPTIONS);

            { Load the style sheet as an XML document. }
            XslFile8 := Utf8Encode(XslFile);
            XslEncoding8 := Utf8Encode(XslEncoding);
            XslDoc := xmlReadFile(PAnsiChar(XslFile8), PAnsiChar(XslEncoding8), 
0);
            if Assigned(XslDoc) then
              begin
                xmlXIncludeProcessFlags(XslDoc, XSLT_PARSE_OPTIONS);

                { Convert the XML style sheet to a style structure. If this is
                  successfull, the XslStyle result takes ownership off XslDoc. }
                XslStyle := xsltParseStylesheetDoc(XslDoc);
                if Assigned(XslStyle) then

                  try
                    { Create the transformation context. }
                    TC := xsltNewTransformContext(XslStyle, XmlDoc);
                    try
                      xsltSetCtxtParseOptions(TC, XML_PARSE_PEDANTIC);
                      { Now the actual transformation. }
                      ResultDoc := xsltApplyStylesheetUser(XslStyle, XmlDoc, 
nil, nil, nil, TC);
                      if Assigned(ResultDoc) then
                        try
                          resultfile8 := Utf8Encode(ResultFile);
                          xsltSaveResultToFileName(PAnsiChar(resultfile8), 
ResultDoc, XslStyle, 0);
                        finally
                          xmlFreeDoc(ResultDoc);
                        end;
                    finally
                      xsltFreeTransformContext(TC);
                    end;
                  finally
                    xsltFreeStyleSheet(XslStyle);
                  end

                else
                  begin
                    xmlFreeDoc(XslDoc);
                  end;
              end;
          finally
            xmlFreeDoc(XmlDoc);
          end;

        if FileExists(ResultFile) then
          begin
            memoTransformationSource.Lines.LoadFromFile(ResultFile);
            WebBrowser.Navigate(ResultFile);
          end
        else
          begin
            memoTransformationSource.Text := 'Transformation failed - see 
Errors tab for details';
            PageControl.ActivePage := tsTransformationSource;
          end;

      finally
        memoErrors.Lines.EndUpdate;
        Screen.Cursor := OldCursor;
        btnShow.Enabled := True;
        FTransforming := False;
      end;
    end;
end;

//------------------------------------------------------------------------------

procedure TfrmXsltBrowser.ctrlExecute(Sender: TObject);
begin
  DoTransform;
end;

//------------------------------------------------------------------------------

procedure TfrmXsltBrowser.DirectoryListBoxChange(Sender: TObject);
begin
  flbXml.Directory := DirectoryListBox.Directory;
  flbXsl.Directory := DirectoryListBox.Directory;
  flbXml.ItemIndex := 0;
  flbXsl.ItemIndex := 0;
  flbChange(nil);
end;

//------------------------------------------------------------------------------

procedure TfrmXsltBrowser.flbChange(Sender: TObject);
begin
  btnShow.Enabled := not FTransforming and (flbXml.ItemIndex >= 0) and 
(flbXsl.ItemIndex >= 0);
end;

//------------------------------------------------------------------------------

initialization
  xmlInitParser; // Initialize the XML library.
  xsltInit; // Initialize the XSLT library.
  exsltRegisterAll; // Register all EXSLT functions.

finalization
  xmlCleanupParser; // Clear global XML library variables.
  xsltCleanupGlobals; // Clear global XSLT library variables.

end.

Other related posts: