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

  1unit extjsxml;
  2
  3{$mode objfpc}{$H+}
  4
  5interface
  6
  7uses
  8  Classes, SysUtils, httpdefs, fpextjs, dom, xmlread, xmlwrite, fpwebdata, db;
  9
 10Type
 11
 12  { TExtJSXMLWebdataInputAdaptor }
 13
 14  TExtJSXMLWebdataInputAdaptor = CLass(TCustomWebdataInputAdaptor)
 15  private
 16    FDE: String;
 17    FRE: String;
 18    FREEL: String;
 19    FXML : TXMLDocument;
 20    FDocRoot : TDOMElement;
 21    FRoot : TDOMElement;
 22    FCurrentRow : TDOMElement;
 23    FIDValue : TDOMElement;
 24    function isDocumentStored: boolean;
 25    function IsRecordStored: boolean;
 26    function isRootStored: boolean;
 27    function CheckData: Boolean;
 28  protected
 29  Public
 30    Constructor Create(AOwner : TComponent); override;
 31    Destructor destroy; override;
 32    Function TryFieldValue(Const AFieldName : String; out AValue : String) : Boolean; override;
 33    Property DocumentElement : String Read FDE Write FDE stored isDocumentStored;
 34    Property RootElement : String Read FRE Write FRE stored isRootStored;
 35    Property RecordElement : String Read FREEL Write FREEL stored IsRecordStored;
 36  end;
 37  { TExtJSJSONDataFormatter }
 38
 39  { TExtJSXMLDataFormatter }
 40  TXMLElementEvent = Procedure (Sender : TObject; AElement : TDOMElement) of object;
 41  TXMLExceptionObjectEvent = Procedure(Sender : TObject; E : Exception; AResponse : TDOMElement) of Object;
 42
 43  TExtJSXMLDataFormatter = Class(TExtJSDataFormatter)
 44  private
 45    FAfterDataToXML: TXMLElementEvent;
 46    FAfterRowToXML: TXMLElementEvent;
 47    FBeforeDataToXML: TXMLElementEvent;
 48    FBeforeRowToXML: TXMLElementEvent;
 49    FDP: String;
 50    FOnErrorResponse: TXmlExceptionObjectEvent;
 51    FReP: String;
 52    FRP: String;
 53    function IsDocumentStored: boolean;
 54    function IsRecordStored: boolean;
 55    function IsRootStored: boolean;
 56  protected
 57    Function CreateAdaptor(ARequest : TRequest) : TCustomWebdataInputAdaptor; override;
 58    Procedure DoExceptionToStream(E : Exception; ResponseContent : TStream); override;
 59    Function GetDataContentType : String; override;
 60    function RowToXML(Doc: TXMLDocument): TDOMelement;
 61    Procedure DoBeforeRow(ARow : TDOMElement); virtual;
 62    Procedure DoAfterRow(ARow : TDOMElement); virtual;
 63    Procedure DoBeforeData(Data : TDOMElement); virtual;
 64    Procedure DoAfterData(Data: TDOMElement); virtual;
 65    procedure DatasetToStream(Stream: TStream); override;
 66  public
 67    Constructor Create(AOwner : TComponent); override;
 68  published
 69    Property RootProperty : String Read FRP Write FRP Stored IsRootStored;
 70    Property RecordProperty : String Read FReP Write FReP Stored IsRecordStored;
 71    Property DocumentProperty : String Read FDP Write FDP Stored IsDocumentStored;
 72    // Called before row element (passed to handler) is filled with fields.
 73    Property BeforeRowToXML : TXMLElementEvent Read FBeforeRowToXML Write FBeforeRowToXML;
 74    // Called after row element (passed to handler) was filled with fields.
 75    Property AfterRowToXML : TXMLElementEvent Read FAfterRowToXML Write FAfterRowToXML;
 76    // Called before any rows are added to root element (passed to handler).
 77    Property BeforeDataToXML : TXMLElementEvent Read FBeforeDataToXML Write FBeforeDataToXML;
 78    // Called after all rows are appended to root element (passed to handler).
 79    Property AfterDataToXML : TXMLElementEvent Read FAfterDataToXML Write FAfterDataToXML;
 80    // Called when an exception is caught and formatted.
 81    Property OnErrorResponse : TXmlExceptionObjectEvent Read FOnErrorResponse Write FOnErrorResponse;
 82  end;
 83
 84implementation
 85{ $define wmdebug}
 86{$ifdef wmdebug}
 87uses dbugintf;
 88{$endif wmdebug}
 89
 90Resourcestring
 91  SerrNoExceptionMessage = 'No exception to take error message from.';
 92
 93Const
 94  // For TExtJSXMLDataFormatter.
 95  SDefDocumentProperty = 'xrequest';
 96  SDefRecordProperty   = 'row';
 97  SDefRootProperty     = 'dataset';
 98
 99  // Fpr TExtJSXMLWebdataInputAdaptor
100  SDefRootElement     = SDefRootProperty;
101  SDefRecordElement   = SDefRecordProperty;
102  SDefDocumentElement = SDefDocumentProperty;
103
104function TExtJSXMLDataFormatter.IsRootStored: boolean;
105begin
106  Result:=RootProperty<>SDefRootProperty;
107end;
108
109function TExtJSXMLDataFormatter.CreateAdaptor(ARequest: TRequest
110  ): TCustomWebdataInputAdaptor;
111
112Var
113  R : TExtJSXMLWebdataInputAdaptor;
114
115begin
116  R:=TExtJSXMLWebdataInputAdaptor.Create(Self);
117  R.Request:=ARequest;
118  R.DocumentElement:=Self.DocumentProperty;
119  R.RootElement:=Self.RootProperty;
120  R.RecordElement:=Self.RecordProperty;
121  Result:=R;
122end;
123
124function TExtJSXMLDataFormatter.IsRecordStored: boolean;
125begin
126  Result:=RecordProperty<>SDefRecordProperty;
127end;
128
129function TExtJSXMLDataFormatter.IsDocumentStored: boolean;
130begin
131  Result:=DocumentProperty<>SDefDocumentProperty
132end;
133
134procedure TExtJSXMLDataFormatter.DoExceptionToStream(E: Exception;
135  ResponseContent: TStream);
136
137Var
138  Xml : TXMLDocument;
139  El,C : TDOMElement;
140
141begin
142  XML:=TXMLDocument.Create;
143  try
144    El:=XML.CreateElement(RootProperty);
145    XML.AppendChild(El);
146    El[SuccessProperty]:='false';
147    C:=XML.CreateElement(SuccessProperty);
148    C.AppendChild(XML.CreateTextNode('false'));
149    El.AppendChild(c);
150    C:=XML.CreateElement(MessageProperty);
151    El.AppendChild(C);
152    If Assigned(E) then
153      C.AppendChild(XML.CreateTextNode(E.Message))
154    else
155      C.AppendChild(XML.CreateTextNode(SerrNoExceptionMessage));
156    If Assigned(FOnErrorResponse) then
157      FOnErrorResponse(Self,E,El);
158    WriteXMLFile(XML,ResponseContent);
159  Finally
160    XML.Free;
161  end;
162end;
163
164function TExtJSXMLDataFormatter.GetDataContentType: String;
165begin
166  Result:='text/xml';
167end;
168
169Function TExtJSXMLDataFormatter.RowToXML(Doc : TXMLDocument) : TDOMelement;
170
171Var
172  E : TDOMElement;
173  F : TField;
174  I : Integer;
175  S : String;
176begin
177  Result:=Doc.CreateElement(RecordProperty);
178  try
179    DoBeforeRow(Result);
180    For I:=0 to Dataset.Fields.Count-1 do
181      begin
182      F:=Dataset.Fields[i];
183      E:=Doc.CreateElement(F.FieldName);
184      If F.DataType in [ftMemo, ftFmtMemo, ftWideMemo, ftBlob ] then
185        S:=F.AsString
186      else
187        S:=F.DisplayText;
188      If (OnTranscode<>Nil) then
189        OnTranscode(Self,F,S,True);
190      E.AppendChild(Doc.CreateTextNode(S));
191      Result.AppendChild(E);
192      end;
193    DoAfterRow(Result);
194  except
195    Result.Free;
196    Raise;
197  end;
198end;
199
200procedure TExtJSXMLDataFormatter.DoBeforeRow(ARow: TDOMElement);
201begin
202  If Assigned(FBEforeRowToXml) then
203    FBEforeRowToXml(Self,ARow);
204end;
205
206procedure TExtJSXMLDataFormatter.DoAfterRow(ARow: TDOMElement);
207begin
208  If Assigned(FAfterRowToXml) then
209    FAfterRowToXml(Self,ARow);
210end;
211
212procedure TExtJSXMLDataFormatter.DoBeforeData(Data: TDOMElement);
213begin
214  If Assigned(FBeforeDataToXML) then
215    FBeforeDataToXML(Self,Data);
216end;
217
218procedure TExtJSXMLDataFormatter.DoAfterDAta(Data: TDOMElement);
219begin
220  If Assigned(FAfterDataToXML) then
221    FAfterDataToXML(Self,Data);
222end;
223
224procedure TExtJSXMLDataFormatter.DatasetToStream(Stream: TStream);
225
226Var
227  Xml : TXMLDocument;
228  E,C : TDOMElement;
229  i,RCount,ACount : Integer;
230  DS : TDataset;
231
232begin
233  RCount:=0;
234  ACount:=0;
235  DS:=Dataset;
236   XML:=TXMLDocument.Create;
237   try
238     E:=XML.CreateElement(RootProperty);
239     XML.AppendChild(E);
240     DoBeforeData(E);
241     // Go to start
242     ACount:=PageStart;
243     While (Not DS.EOF) and (ACount>0) do
244       begin
245       DS.Next;
246       Dec(ACount);
247       Inc(RCount);
248       end;
249     ACount:=PageSize;
250     While (not DS.EOF) and ((PageSize=0) or (ACount>0)) do
251       begin
252       Inc(RCount);
253       Dec(ACount);
254       E.AppendChild(RowToXML(XML));
255       DS.Next;
256       end;
257     If (PageSize>0) then
258       While (not DS.EOF) do
259         begin
260         Inc(RCount);
261         DS.Next;
262         end;
263     C:=XML.CreateElement(TotalProperty);
264     C.AppendChild(XML.CreateTextNode(IntToStr(RCount)));
265     E.AppendChild(C);
266     C:=XML.CreateElement(SuccessProperty);
267     C.AppendChild(XML.CreateTextNode('true'));
268     E.AppendChild(C);
269     DoAfterData(E);
270     WriteXMLFile(XML,Stream);
271   finally
272     XML.Free;
273   end;
274end;
275
276constructor TExtJSXMLDataFormatter.Create(AOwner: TComponent);
277begin
278  inherited Create(AOwner);
279  RootProperty:=SDefRootProperty;
280  RecordProperty:=SDefRecordProperty;
281  DocumentProperty:=SDefDocumentProperty
282end;
283
284{ TExtJSXMLWebdataInputAdaptor }
285
286
287function TExtJSXMLWebdataInputAdaptor.isDocumentStored: boolean;
288begin
289  Result:=DocumentElement<>SDefDocumentElement;
290end;
291
292function TExtJSXMLWebdataInputAdaptor.IsRecordStored: boolean;
293begin
294  Result:=RecordElement<>SDefRecordElement;
295end;
296
297function TExtJSXMLWebdataInputAdaptor.isRootStored: boolean;
298begin
299  Result:=RootElement<>SDefRootElement;
300end;
301
302function TExtJSXMLWebdataInputAdaptor.CheckData: Boolean;
303
304Var
305  S : String;
306  T : TStringSTream;
307  E : TDomElement;
308  P : Integer;
309
310begin
311  {$ifdef wmdebug}senddebug('Check data: '+Request.Content);{$endif}
312  Result:=Assigned(FXML);
313  If Not (Result)  then
314    begin
315    S:=Request.ContentType;
316    P:=Pos(';',S);
317    If (P<>0) then
318      S:=Copy(S,1,P-1);
319   {$ifdef wmdebug}senddebug('Check data: '+S);{$endif}
320    Result:=CompareText(S,'application/x-www-form-urlencoded')=0;
321    If not Result then
322      begin
323      T:=TStringStream.Create(Request.Content);
324      try
325        XmlRead.ReadXMLFile(FXML,T);
326        If (DocumentElement<>'') and (FXML.DocumentElement.NodeName=DocumentElement) then
327          begin
328          {$ifdef wmdebug}senddebug('Document element is ExtJS DocumentElement');{$endif}
329          FDocRoot:=FXML.DocumentElement;
330          E:=FDocRoot;
331          end
332        else if (DocumentElement<>'') then
333          begin
334          //FXML.
335          {$ifdef wmdebug}senddebug('Looking for ExtJS Documentelement "'+DocumentElement+'" in XML.DocumentElement');{$endif}
336          FDocRoot:=FXML.DocumentElement.FindNode(DocumentElement) as TDOMElement;
337          E:=FDocRoot;
338          end;
339        {$ifdef wmdebug}senddebug('Looking for DocRoot element "'+RootElement+'" in FDocRoot');{$endif}
340        If Assigned(FDocRoot) then
341          FRoot:=FDocRoot
342        else
343          FRoot:=FXML.FindNode(RootElement) as TDomElement;
344        {$ifdef wmdebug}senddebug('Looking for current record element "'+RecordElement+'" in FRoot');{$endif}
345        If Assigned(FRoot) then
346          begin
347          FCurrentRow:=FRoot.FindNode(RecordElement) as TDomElement;
348          If Not Assigned(FCurrentRow) then
349            FIDValue:=FRoot.FindNode('ID') as TDomElement;
350          end
351        else
352          begin
353          {$ifdef wmdebug}senddebug('Looking for current record element "'+RecordElement+'" in document');{$endif}
354          FCurrentRow:=FXML.FindNode(RecordElement) as TDomElement;
355          end;
356        If (FCurrentRow=Nil) and (FXML.DocumentElement.NodeName=RecordElement) then
357          begin
358          {$ifdef wmdebug}senddebug('Documentelement is  record element "'+RecordElement+'"');{$endif}
359          FCurrentRow:=FXML.DocumentElement;
360          end;
361        {$ifdef wmdebug}senddebug('Have current row: "'+IntToStr(Ord(Assigned(FCurrentRow)))+'"');{$endif}
362        Result:=True;
363      finally
364        T.free;
365      end;
366      end;
367    end;
368
369end;
370
371function TExtJSXMLWebdataInputAdaptor.TryFieldValue(const AFieldName: String;
372  out AValue: String): Boolean;
373
374Var
375  I : Integer;
376  E : TDOMElement;
377  N : TDOMNode;
378
379begin
380  Result:=False;
381  if CheckData then
382    begin
383    If Assigned(FIDValue) and (0=CompareText(AFieldName,'ID')) then
384      begin
385      AValue:=FIDValue.NodeValue;
386      Result:=True;
387      end
388    else if Assigned(FCurrentRow) then
389      begin
390      E:=FCurrentRow.FindNode(AFieldName) as TDomElement;
391      Result:=Assigned(E);
392      if result then
393        begin
394        N:=E.FirstChild;
395        If Assigned(N) then
396          AValue:=N.NodeValue;
397        end;
398      end;
399    end;
400end;
401
402constructor TExtJSXMLWebdataInputAdaptor.Create(AOwner: TComponent);
403begin
404  inherited Create(AOwner);
405  RootElement:=SDefRootElement;
406  RecordElement:=SDefRecordElement;
407  DocumentElement:=SDefDocumentElement;
408end;
409
410destructor TExtJSXMLWebdataInputAdaptor.destroy;
411begin
412  FreeAndNil(FXML);
413  inherited destroy;
414end;
415
416initialization
417  WebDataProviderManager.RegisterInputAdaptor('ExtJS - XML',TExtJSXMLWebdataInputAdaptor);
418  WebDataProviderManager.RegisterDataProducer('ExtJS - XML',TExtJSXMLDataFormatter);
419
420finalization
421  WebDataProviderManager.UnRegisterInputAdaptor('ExtJS - XML');
422  WebDataProviderManager.UnRegisterDataProducer('ExtJS - XML')
423end.
424