freepascal.compiler/packages/fcl-web/src/webdata/extjsxml.pp

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2019 by the Free Pascal development team

    extjs xml

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
unit extjsxml;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, httpdefs, fpextjs, dom, xmlread, xmlwrite, fpwebdata, db;

Type

  { TExtJSXMLWebdataInputAdaptor }

  TExtJSXMLWebdataInputAdaptor = CLass(TCustomWebdataInputAdaptor)
  private
    FDE: String;
    FRE: String;
    FREEL: String;
    FXML : TXMLDocument;
    FDocRoot : TDOMElement;
    FRoot : TDOMElement;
    FCurrentRow : TDOMElement;
    FIDValue : TDOMElement;
    function isDocumentStored: boolean;
    function IsRecordStored: boolean;
    function isRootStored: boolean;
    function CheckData: Boolean;
  protected
  Public
    Constructor Create(AOwner : TComponent); override;
    Destructor destroy; override;
    Function TryFieldValue(Const AFieldName : String; out AValue : String) : Boolean; override;
    Property DocumentElement : String Read FDE Write FDE stored isDocumentStored;
    Property RootElement : String Read FRE Write FRE stored isRootStored;
    Property RecordElement : String Read FREEL Write FREEL stored IsRecordStored;
  end;
  { TExtJSJSONDataFormatter }

  { TExtJSXMLDataFormatter }
  TXMLElementEvent = Procedure (Sender : TObject; AElement : TDOMElement) of object;
  TXMLExceptionObjectEvent = Procedure(Sender : TObject; E : Exception; AResponse : TDOMElement) of Object;

  TExtJSXMLDataFormatter = Class(TExtJSDataFormatter)
  private
    FAfterDataToXML: TXMLElementEvent;
    FAfterRowToXML: TXMLElementEvent;
    FBeforeDataToXML: TXMLElementEvent;
    FBeforeRowToXML: TXMLElementEvent;
    FDP: String;
    FOnErrorResponse: TXmlExceptionObjectEvent;
    FReP: String;
    FRP: String;
    function IsDocumentStored: boolean;
    function IsRecordStored: boolean;
    function IsRootStored: boolean;
  protected
    Function CreateAdaptor(ARequest : TRequest) : TCustomWebdataInputAdaptor; override;
    Procedure DoExceptionToStream(E : Exception; ResponseContent : TStream); override;
    Function GetDataContentType : String; override;
    function RowToXML(Doc: TXMLDocument): TDOMelement;
    Procedure DoBeforeRow(ARow : TDOMElement); virtual;
    Procedure DoAfterRow(ARow : TDOMElement); virtual;
    Procedure DoBeforeData(Data : TDOMElement); virtual;
    Procedure DoAfterData(Data: TDOMElement); virtual;
    procedure DatasetToStream(Stream: TStream); override;
  public
    Constructor Create(AOwner : TComponent); override;
  published
    Property RootProperty : String Read FRP Write FRP Stored IsRootStored;
    Property RecordProperty : String Read FReP Write FReP Stored IsRecordStored;
    Property DocumentProperty : String Read FDP Write FDP Stored IsDocumentStored;
    // Called before row element (passed to handler) is filled with fields.
    Property BeforeRowToXML : TXMLElementEvent Read FBeforeRowToXML Write FBeforeRowToXML;
    // Called after row element (passed to handler) was filled with fields.
    Property AfterRowToXML : TXMLElementEvent Read FAfterRowToXML Write FAfterRowToXML;
    // Called before any rows are added to root element (passed to handler).
    Property BeforeDataToXML : TXMLElementEvent Read FBeforeDataToXML Write FBeforeDataToXML;
    // Called after all rows are appended to root element (passed to handler).
    Property AfterDataToXML : TXMLElementEvent Read FAfterDataToXML Write FAfterDataToXML;
    // Called when an exception is caught and formatted.
    Property OnErrorResponse : TXmlExceptionObjectEvent Read FOnErrorResponse Write FOnErrorResponse;
  end;

implementation
{ $define wmdebug}
{$ifdef wmdebug}
uses dbugintf;
{$endif wmdebug}

Resourcestring
  SerrNoExceptionMessage = 'No exception to take error message from.';

Const
  // For TExtJSXMLDataFormatter.
  SDefDocumentProperty = 'xrequest';
  SDefRecordProperty   = 'row';
  SDefRootProperty     = 'dataset';

  // Fpr TExtJSXMLWebdataInputAdaptor
  SDefRootElement     = SDefRootProperty;
  SDefRecordElement   = SDefRecordProperty;
  SDefDocumentElement = SDefDocumentProperty;

function TExtJSXMLDataFormatter.IsRootStored: boolean;
begin
  Result:=RootProperty<>SDefRootProperty;
end;

function TExtJSXMLDataFormatter.CreateAdaptor(ARequest: TRequest
  ): TCustomWebdataInputAdaptor;

Var
  R : TExtJSXMLWebdataInputAdaptor;

begin
  R:=TExtJSXMLWebdataInputAdaptor.Create(Self);
  R.Request:=ARequest;
  R.DocumentElement:=Self.DocumentProperty;
  R.RootElement:=Self.RootProperty;
  R.RecordElement:=Self.RecordProperty;
  Result:=R;
end;

function TExtJSXMLDataFormatter.IsRecordStored: boolean;
begin
  Result:=RecordProperty<>SDefRecordProperty;
end;

function TExtJSXMLDataFormatter.IsDocumentStored: boolean;
begin
  Result:=DocumentProperty<>SDefDocumentProperty
end;

procedure TExtJSXMLDataFormatter.DoExceptionToStream(E: Exception;
  ResponseContent: TStream);

Var
  Xml : TXMLDocument;
  El,C : TDOMElement;

begin
  XML:=TXMLDocument.Create;
  try
    El:=XML.CreateElement(RootProperty);
    XML.AppendChild(El);
    El[SuccessProperty]:='false';
    C:=XML.CreateElement(SuccessProperty);
    C.AppendChild(XML.CreateTextNode('false'));
    El.AppendChild(c);
    C:=XML.CreateElement(MessageProperty);
    El.AppendChild(C);
    If Assigned(E) then
      C.AppendChild(XML.CreateTextNode(E.Message))
    else
      C.AppendChild(XML.CreateTextNode(SerrNoExceptionMessage));
    If Assigned(FOnErrorResponse) then
      FOnErrorResponse(Self,E,El);
    WriteXMLFile(XML,ResponseContent);
  Finally
    XML.Free;
  end;
end;

function TExtJSXMLDataFormatter.GetDataContentType: String;
begin
  Result:='text/xml';
end;

Function TExtJSXMLDataFormatter.RowToXML(Doc : TXMLDocument) : TDOMelement;

Var
  E : TDOMElement;
  F : TField;
  I : Integer;
  S : String;
begin
  Result:=Doc.CreateElement(RecordProperty);
  try
    DoBeforeRow(Result);
    For I:=0 to Dataset.Fields.Count-1 do
      begin
      F:=Dataset.Fields[i];
      E:=Doc.CreateElement(F.FieldName);
      If F.DataType in [ftMemo, ftFmtMemo, ftWideMemo, ftBlob ] then
        S:=F.AsString
      else
        S:=F.DisplayText;
      If (OnTranscode<>Nil) then
        OnTranscode(Self,F,S,True);
      E.AppendChild(Doc.CreateTextNode(S));
      Result.AppendChild(E);
      end;
    DoAfterRow(Result);
  except
    Result.Free;
    Raise;
  end;
end;

procedure TExtJSXMLDataFormatter.DoBeforeRow(ARow: TDOMElement);
begin
  If Assigned(FBEforeRowToXml) then
    FBEforeRowToXml(Self,ARow);
end;

procedure TExtJSXMLDataFormatter.DoAfterRow(ARow: TDOMElement);
begin
  If Assigned(FAfterRowToXml) then
    FAfterRowToXml(Self,ARow);
end;

procedure TExtJSXMLDataFormatter.DoBeforeData(Data: TDOMElement);
begin
  If Assigned(FBeforeDataToXML) then
    FBeforeDataToXML(Self,Data);
end;

procedure TExtJSXMLDataFormatter.DoAfterDAta(Data: TDOMElement);
begin
  If Assigned(FAfterDataToXML) then
    FAfterDataToXML(Self,Data);
end;

procedure TExtJSXMLDataFormatter.DatasetToStream(Stream: TStream);

Var
  Xml : TXMLDocument;
  E,C : TDOMElement;
  i,RCount,ACount : Integer;
  DS : TDataset;

begin
  RCount:=0;
  ACount:=0;
  DS:=Dataset;
   XML:=TXMLDocument.Create;
   try
     E:=XML.CreateElement(RootProperty);
     XML.AppendChild(E);
     DoBeforeData(E);
     // Go to start
     ACount:=PageStart;
     While (Not DS.EOF) and (ACount>0) do
       begin
       DS.Next;
       Dec(ACount);
       Inc(RCount);
       end;
     ACount:=PageSize;
     While (not DS.EOF) and ((PageSize=0) or (ACount>0)) do
       begin
       Inc(RCount);
       Dec(ACount);
       E.AppendChild(RowToXML(XML));
       DS.Next;
       end;
     If (PageSize>0) then
       While (not DS.EOF) do
         begin
         Inc(RCount);
         DS.Next;
         end;
     C:=XML.CreateElement(TotalProperty);
     C.AppendChild(XML.CreateTextNode(IntToStr(RCount)));
     E.AppendChild(C);
     C:=XML.CreateElement(SuccessProperty);
     C.AppendChild(XML.CreateTextNode('true'));
     E.AppendChild(C);
     DoAfterData(E);
     WriteXMLFile(XML,Stream);
   finally
     XML.Free;
   end;
end;

constructor TExtJSXMLDataFormatter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  RootProperty:=SDefRootProperty;
  RecordProperty:=SDefRecordProperty;
  DocumentProperty:=SDefDocumentProperty
end;

{ TExtJSXMLWebdataInputAdaptor }


function TExtJSXMLWebdataInputAdaptor.isDocumentStored: boolean;
begin
  Result:=DocumentElement<>SDefDocumentElement;
end;

function TExtJSXMLWebdataInputAdaptor.IsRecordStored: boolean;
begin
  Result:=RecordElement<>SDefRecordElement;
end;

function TExtJSXMLWebdataInputAdaptor.isRootStored: boolean;
begin
  Result:=RootElement<>SDefRootElement;
end;

function TExtJSXMLWebdataInputAdaptor.CheckData: Boolean;

Var
  S : String;
  T : TStringSTream;
  E : TDomElement;
  P : Integer;

begin
  {$ifdef wmdebug}senddebug('Check data: '+Request.Content);{$endif}
  Result:=Assigned(FXML);
  If Not (Result)  then
    begin
    S:=Request.ContentType;
    P:=Pos(';',S);
    If (P<>0) then
      S:=Copy(S,1,P-1);
   {$ifdef wmdebug}senddebug('Check data: '+S);{$endif}
    Result:=CompareText(S,'application/x-www-form-urlencoded')=0;
    If not Result then
      begin
      T:=TStringStream.Create(Request.Content);
      try
        XmlRead.ReadXMLFile(FXML,T);
        If (DocumentElement<>'') and (FXML.DocumentElement.NodeName=DocumentElement) then
          begin
          {$ifdef wmdebug}senddebug('Document element is ExtJS DocumentElement');{$endif}
          FDocRoot:=FXML.DocumentElement;
          E:=FDocRoot;
          end
        else if (DocumentElement<>'') then
          begin
          //FXML.
          {$ifdef wmdebug}senddebug('Looking for ExtJS Documentelement "'+DocumentElement+'" in XML.DocumentElement');{$endif}
          FDocRoot:=FXML.DocumentElement.FindNode(DocumentElement) as TDOMElement;
          E:=FDocRoot;
          end;
        {$ifdef wmdebug}senddebug('Looking for DocRoot element "'+RootElement+'" in FDocRoot');{$endif}
        If Assigned(FDocRoot) then
          FRoot:=FDocRoot
        else
          FRoot:=FXML.FindNode(RootElement) as TDomElement;
        {$ifdef wmdebug}senddebug('Looking for current record element "'+RecordElement+'" in FRoot');{$endif}
        If Assigned(FRoot) then
          begin
          FCurrentRow:=FRoot.FindNode(RecordElement) as TDomElement;
          If Not Assigned(FCurrentRow) then
            FIDValue:=FRoot.FindNode('ID') as TDomElement;
          end
        else
          begin
          {$ifdef wmdebug}senddebug('Looking for current record element "'+RecordElement+'" in document');{$endif}
          FCurrentRow:=FXML.FindNode(RecordElement) as TDomElement;
          end;
        If (FCurrentRow=Nil) and (FXML.DocumentElement.NodeName=RecordElement) then
          begin
          {$ifdef wmdebug}senddebug('Documentelement is  record element "'+RecordElement+'"');{$endif}
          FCurrentRow:=FXML.DocumentElement;
          end;
        {$ifdef wmdebug}senddebug('Have current row: "'+IntToStr(Ord(Assigned(FCurrentRow)))+'"');{$endif}
        Result:=True;
      finally
        T.free;
      end;
      end;
    end;

end;

function TExtJSXMLWebdataInputAdaptor.TryFieldValue(const AFieldName: String;
  out AValue: String): Boolean;

Var
  I : Integer;
  E : TDOMElement;
  N : TDOMNode;

begin
  Result:=False;
  if CheckData then
    begin
    If Assigned(FIDValue) and (0=CompareText(AFieldName,'ID')) then
      begin
      AValue:=FIDValue.NodeValue;
      Result:=True;
      end
    else if Assigned(FCurrentRow) then
      begin
      E:=FCurrentRow.FindNode(AFieldName) as TDomElement;
      Result:=Assigned(E);
      if result then
        begin
        N:=E.FirstChild;
        If Assigned(N) then
          AValue:=N.NodeValue;
        end;
      end;
    end;
end;

constructor TExtJSXMLWebdataInputAdaptor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  RootElement:=SDefRootElement;
  RecordElement:=SDefRecordElement;
  DocumentElement:=SDefDocumentElement;
end;

destructor TExtJSXMLWebdataInputAdaptor.destroy;
begin
  FreeAndNil(FXML);
  inherited destroy;
end;

initialization
  WebDataProviderManager.RegisterInputAdaptor('ExtJS - XML',TExtJSXMLWebdataInputAdaptor);
  WebDataProviderManager.RegisterDataProducer('ExtJS - XML',TExtJSXMLDataFormatter);

finalization
  WebDataProviderManager.UnRegisterInputAdaptor('ExtJS - XML');
  WebDataProviderManager.UnRegisterDataProducer('ExtJS - XML')
end.