/packages/fcl-web/src/webdata/extjsxml.pp
Puppet | 424 lines | 375 code | 49 blank | 0 comment | 6 complexity | 7648548f4d5811e09c7f4d311a7f3830 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
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