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

https://github.com/slibre/freepascal · Puppet · 424 lines · 375 code · 49 blank · 0 comment · 6 complexity · 7648548f4d5811e09c7f4d311a7f3830 MD5 · raw file

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