diff --git a/.gitattributes b/.gitattributes index 530ddf77d1..5358e8b955 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3460,6 +3460,7 @@ packages/fcl-web/src/jsonrpc/fpextdirect.pp svneol=native#text/plain packages/fcl-web/src/jsonrpc/fpjsonrpc.pp svneol=native#text/plain packages/fcl-web/src/jsonrpc/readme.txt svneol=native#text/plain packages/fcl-web/src/jsonrpc/webjsonrpc.pp svneol=native#text/plain +packages/fcl-web/src/restbridge/sqldbrestado.pp svneol=native#text/plain packages/fcl-web/src/restbridge/sqldbrestauth.pp svneol=native#text/plain packages/fcl-web/src/restbridge/sqldbrestauthini.pp svneol=native#text/plain packages/fcl-web/src/restbridge/sqldbrestbridge.pp svneol=native#text/plain diff --git a/packages/fcl-web/src/restbridge/sqldbrestado.pp b/packages/fcl-web/src/restbridge/sqldbrestado.pp new file mode 100644 index 0000000000..b8aebb31fd --- /dev/null +++ b/packages/fcl-web/src/restbridge/sqldbrestado.pp @@ -0,0 +1,377 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2019 by the Free Pascal development team + + SQLDB REST bridge : ADO-styled XML input/output + + 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 sqldbrestado; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, DateUtils, db,fpjson, dom, XMLRead, XMLWrite,sqldbrestschema,sqldbrestio, sqldbrestbridge; + +Type + + { TADOInputStreamer } + + TADOInputStreamer = Class(TRestInputStreamer) + private + FDataName: UTF8String; + FRowName: UTF8String; + FXML: TXMLDocument; + FPacket : TDOMElement; + FData : TDOMElement; // Equals FPacket + FRow : TDOMElement; + Protected + function GetNodeText(N: TDOmNode): UnicodeString; + Public + Destructor Destroy; override; + Class Function GetContentType: String; override; + Function SelectObject(aIndex : Integer) : Boolean; override; + function GetContentField(aName: UTF8string): TJSONData; override; + procedure InitStreaming; override; + Property XML : TXMLDocument Read FXML; + Property Packet : TDOMElement Read FPacket; + Property Data : TDOMElement Read FData; + Property Row : TDOMElement Read FRow; + Property DataName : UTF8String Read FDataName Write FDataName; + Property RowName : UTF8String Read FRowName Write FRowName; + end; + + { TADOOutputStreamer } + + TADOOutputStreamer = Class(TRestOutputStreamer) + Private + FDataName: UTF8String; + FRowName: UTF8String; + FXML: TXMLDocument; + FData : TDOMElement; // Equals FRoot + FRow: TDOMElement; + FRoot: TDomElement; + function CreateXSD: TDomElement; + Public + procedure EndData; override; + procedure EndRow; override; + procedure FinalizeOutput; override; + procedure StartData; override; + procedure StartRow; override; + // Return Nil for null field. + function FieldToXML(aPair: TRestFieldPair): TDOMElement; virtual; + procedure WriteField(aPair: TRestFieldPair); override; + procedure WriteMetadata(aFieldList: TRestFieldPairArray); override; + Procedure CreateErrorContent(aCode : Integer; Const aMessage: String); override; + Property XML : TXMLDocument Read FXML; + Property Data : TDOMelement Read FData; + Property Row : TDOMelement Read FRow; + Public + Destructor Destroy; override; + Class Function GetContentType: String; override; + function RequireMetadata : Boolean; override; + procedure InitStreaming; override; + Property DataName : UTF8String Read FDataName Write FDataName; + Property RowName : UTF8String Read FRowName Write FRowName; + end; + +implementation + +uses sqldbrestconst; + +{ TADOInputStreamer } + +destructor TADOInputStreamer.Destroy; +begin + FreeAndNil(FXML); + inherited Destroy; +end; + +class function TADOInputStreamer.GetContentType: String; +begin + Result:='text/xml'; +end; + +function TADOInputStreamer.SelectObject(aIndex: Integer): Boolean; + +Var + N : TDomNode; + NN : UnicodeString; +begin + Result:=False; + NN:=UTF8Decode(RowName); + N:=FData.FindNode(NN); + While (aIndex>0) and (N<>Nil) and (N.NodeName<>NN) and (N.NodeType<>ELEMENT_NODE) do + begin + N:=N.NextSibling; + Dec(aIndex); + end; + Result:=(aIndex=0) and (N<>Nil); + If Result then + FRow:=N as TDomElement + else + FRow:=Nil; +end; + +function TADOInputStreamer.GetNodeText(N: TDOmNode): UnicodeString; + +Var + V : TDomNode; + +begin + Result:=''; + V:=N.FirstChild; + While (V<>Nil) and (V.NodeType<>TEXT_NODE) do + V:=V.NextSibling; + If Assigned(V) then + Result:=V.NodeValue; +end; + +function TADOInputStreamer.GetContentField(aName: UTF8string): TJSONData; + +Var + NN : UnicodeString; + N : TDomNode; +begin + NN:=UTF8Decode(aName); + N:=FRow.FindNode(NN); + if Assigned(N) and (N.NodeType=ELEMENT_NODE) then + Result:=TJSONString.Create(UTF8Encode(GetNodeText(N))); +end; + +procedure TADOInputStreamer.InitStreaming; + +Var + Msg : String; + N : TDomNode; + NN : UnicodeString; + +begin + if DataName='' then + DataName:='Data'; + if RowName='' then + RowName:='Row'; + FreeAndNil(FXML); + if Stream.Size<=0 then + exit; + try + ReadXMLFile(FXML,Stream); + except + On E : Exception do + begin + Msg:=E.Message; + FXML:=Nil; + end; + end; + if (FXML=Nil) then + Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsInvalidContent),SErrInvalidXMLInput,[Msg]); + FPacket:=FXML.DocumentElement; + NN:=UTF8Decode(DataName); + if FPacket.NodeName<>NN then + Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsInvalidContent),SErrInvalidXMLInput,[SErrMissingDocumentRoot]); + FData:=FPacket; +end; + +{ TADOOutputStreamer } + + +procedure TADOOutputStreamer.EndData; +begin + FData:=Nil; +end; + +procedure TADOOutputStreamer.EndRow; +begin + FRow:=Nil; +end; + +procedure TADOOutputStreamer.FinalizeOutput; + +begin + xmlwrite.WriteXML(FXML,Stream); + FreeAndNil(FXML); +end; + +procedure TADOOutputStreamer.StartData; +begin + // Rows are straight under the Data packet + FData:=FRoot; +end; + +procedure TADOOutputStreamer.StartRow; +begin + if (FRow<>Nil) then + Raise ESQLDBRest.Create(Statuses.GetStatusCode(rsError),SErrDoubleRowStart); + FRow:=FXML.CreateElement(UTF8Decode(RowName)); + FData.AppendChild(FRow); +end; + +function TADOOutputStreamer.FieldToXML(aPair: TRestFieldPair): TDOMElement; + +Var + F : TField; + S : UTF8String; + +begin + Result:=Nil; + F:=aPair.DBField;; + If (aPair.RestField.FieldType=rftUnknown) then + raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsError),SErrUnsupportedRestFieldType, [aPair.RestField.PublicName]); + If (F.IsNull) then + Exit; + S:=FieldToString(aPair.RestField.FieldType,F); + Result:=FXML.CreateElement(UTF8Decode(aPair.RestField.PublicName)); + Result.AppendChild(FXML.CreateTextNode(UTF8Decode(S))); +end; + +procedure TADOOutputStreamer.WriteField(aPair: TRestFieldPair); + +Var + D : TDOMElement; + N : UTF8String; + +begin + N:=aPair.RestField.PublicName; + if FRow=Nil then + Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsError),SErrFieldWithoutRow,[N]); + D:=FieldToXML(aPair); + if (D=Nil) and (not HasOption(ooSparse)) then + D:=FXML.CreateElement(UTF8Decode(aPair.RestField.PublicName)); + if D<>Nil then + FRow.AppendChild(D); +end; + +function TADOOutputStreamer.CreateXSD: TDomElement; + +// Create XSD and append to root. Return element to which field list must be appended. + +Var + SN,N,E,TLN : TDomElement; + +begin + SN:=FXML.CreateElement('xs:schema'); + SN['id']:=Utf8Decode(DataName); + SN['xmlns']:=''; + SN['xmlns:xs']:='http://www.w3.org/2001/XMLSchema'; + SN['xmlns:msdata']:= 'urn:schemas-microsoft-com:xml-msdata'; + FRoot.AppendChild(SN); + // Add table list with 1 table. + // Element + N:=FXML.CreateElement('xs:element'); + SN.AppendChild(N); + N['name']:=UTF8Decode(DataName); + N['msdata:IsDataSet']:='true'; + N['msdata:UseCurrentLocale']:='true'; + // element is a complex type + TLN:=FXML.CreateElement('xs:complexType'); + N.AppendChild(TLN); + // Complex type is a choice (0..Unbounded] of records + N:=FXML.CreateElement('xs:choice'); + TLN.AppendChild(N); + N['minOccurs']:='0'; + N['maxOccurs']:='unbounded'; + // Each record is an element + E:=FXML.CreateElement('xs:element'); + N.AppendChild(E); + E['name']:=Utf8Decode(RowName); + // Record is a complex type of fields + N:=FXML.CreateElement('xs:complexType'); + E.AppendChild(N); + // Fields are a sequence. To this sequence, the fields may be appended. + Result:=FXML.CreateElement('xs:sequence'); + N.AppendChild(Result); +end; + +Const + XMLPropTypeNames : Array [TRestFieldType] of string = ( + 'unknown', { rtfUnknown } + 'xs:int', { rftInteger } + 'xs:int', { rftLargeInt} + 'xs:double', { rftFloat } + 'xs:dateTime', { rftDate } + 'xs:dateTime', { rftTime } + 'xs:dateTime', { rftDateTime } + 'xs:string', { rftString } + 'xs:boolean', { rftBoolean } + 'xs:base64Binary' { rftBlob } + ); + +procedure TADOOutputStreamer.WriteMetadata(aFieldList: TRestFieldPairArray); + +Var + FMetadata : TDOMElement; + F : TDomElement; + P : TREstFieldPair; + I : integer; + S : Utf8String; + K : TRestFieldType; + +begin + FMetadata:=CreateXSD; + For I:=0 to Length(aFieldList)-1 do + begin + P:=aFieldList[i]; + K:=P.RestField.FieldType; + S:=XMLPropTypeNames[K]; + F:=FXML.CreateElement('xs:element'); + F['name']:=Utf8Decode(P.Restfield.PublicName); + F['type']:=Utf8decode(S); + F['minOccurs']:='0'; + FMetaData.AppendChild(F); + end; +end; + +class function TADOOutputStreamer.GetContentType: String; +begin + Result:='text/xml'; +end; + +function TADOOutputStreamer.RequireMetadata: Boolean; +begin + Result:=True; +end; + +procedure TADOOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String); + +Var + ErrorObj : TDomElement; + +begin + ErrorObj:=FXML.CreateElement(UTF8Decode(GetString(rpErrorRoot))); + ErrorObj['code']:=UTF8Decode(IntToStr(aCode)); + ErrorObj['message']:=UTF8Decode(aMessage); + FRoot.AppendChild(ErrorObj); +end; + +destructor TADOOutputStreamer.Destroy; +begin + FreeAndNil(FXML); + inherited Destroy; +end; + +procedure TADOOutputStreamer.InitStreaming; + +begin + FXML:=TXMLDocument.Create; + FXML.XMLStandalone:=True; + if DataName='' then + DataName:='Data'; + FRoot:=FXML.CreateElement('Data'); + FXML.AppendChild(FRoot); + if RowName='' then + RowName:='Row'; +end; + +Initialization + TADOInputStreamer.RegisterStreamer('ado'); + TADOOutputStreamer.RegisterStreamer('ado'); +end. +