Module cWebService.pkg
1Use Windows.pkg
2Use Flexml.pkg
3Use Set.pkg
4
5Use cCallInterface.pkg
6Use cCallInterfaceHelper_mixin.pkg
7Use SoapConstants.pkg
8Use LanguageTextWebApp.pkg
9
10{ ClassLibrary=WebApp }
11{ DDOHost=True }
12{ ComponentType=WSOClass } //JVH
13{ HelpTopic=cWebService }
14Class cWebService is a cObject
15
16 Procedure Construct_Object
17 String sWSOName
18 Forward Send Construct_Object
19
20 { DesignTime=False }
21 Property Handle Main_DD 0
22 { Category=Behavior }
23 Property String psDescription ""
24 { Category=Behavior }
25 Property String psServiceName "tempService"
26 { Category=Behavior }
27 Property String psServiceURI "http://tempuri.org/"
28 { Category=Behavior }
29 Property String psServiceTitle "Visual DataFlex Web Service"
30 { Category=Behavior }
31 Property String psDocumentation ""
32 { Category=Behavior }
33 Property Boolean pbDocumentStyle True // if True document, false RPC
34
35 { Visibility=Private }
36 Property string psWebServiceMetaDataURI "http://www.dataaccess.com/schemas/WebServiceMetaData"
37
38 // This will only happen if there is a programming class bug
39 If (ghInetSession=0) Begin
40 Error DFERR_PROGRAM C_$MissingISO
41 Abort
42 End
43
44 // register object as a WebService
45 Get Object_Label To sWSOName
46 Send Set_Wso_Data To ghInetSession sWSOName self
47
48
49 // creates call interface object and message support for this class including
50 // register interface.
51 // all access is through property phoCallInterface
52 Send DefineCallInterfaceHelper_mixin
53 // Tells callInterface to do datatype conversions with XML data
54 Set pbConvertXML to True
55
56 End_Procedure //Construct_Object
57
58 Import_class_protocol cCallInterfaceHelper_mixin
59
60 // A web-service exception (soap fault) is generated by calling this message with
61 // error text and then exiting the function.
62
63 Procedure WebServiceException string sError
64 send WebServiceException of oCallInterface sError
65 end_procedure
66
67
68 // These three messages are directed from the callinterface object to here via the
69 // phoWebServiceImplementor property. This means that WOs handle this making it easier
70 // to augment
71
72 { Visibility=Private }
73 Function DeserializeXml Address aXml string sDataType Returns Handle
74 Integer hoXml
75 Get Create U_cXmlDomDocument to hoXml
76 Get LoadXmlFromAddress of hoXml aXml to windowindex
77 Function_Return hoXml
78 End_Function
79
80 { Visibility=Private }
81 Function SerializeXml Handle hObj string sDataType Returns Address
82 Address aXml
83 if (hObj);
84 Get paXml of hObj to aXml
85 Function_Return aXml
86 End_Function
87
88 { Visibility=Private }
89 Procedure DisposeObject Handle hObj
90 if (hObj);
91 Send Destroy of hObj
92 End_Procedure
93
94 Procedure LogEvent Integer iEventType String lpszEvent
95 Send LogEvent To ghInetSession iEventType lpszEvent
96 End_Procedure
97
98 Procedure LogErrorEvent Integer iErr String sText
99 Send LogErrorEvent To ghInetSession iErr sText
100 End_Procedure
101
102 // Pass these properties to ISO. This makes it easier to debug
103
104 //{ MethodType=Property }
105// Function pbVerboseErrors Returns Integer
106// Function_Return (pbVerboseErrors(ghInetSession))
107// End_Function
108
109// //Doc/ Visibility=Public MethodType=Property
110// Procedure Set pbVerboseErrors Integer bState
111// Set pbVerboseErrors Of ghInetSession To bState
112// End_Procedure
113
114 { MethodType=Property }
115 Function pbAllErrorsToEventLog Returns Integer
116 Function_Return (pbAllErrorstoEventLog(ghInetSession))
117 End_Function
118
119 { MethodType=Property }
120 { Category="Error Handling" }
121 { PropertyType=Boolean }
122 { InitialValue=False }
123 Procedure Set pbAllErrorsToEventLog Integer bState
124 Set pbAllErrorstoEventLog Of ghInetSession To bState
125 End_Procedure
126
127 { MethodType=Property }
128 Function pbAllErrorsToLocal Returns Integer
129 Function_Return (pbAllErrorstoLocal(ghInetSession))
130 End_Function
131
132 { MethodType=Property }
133 { Category="Error Handling" }
134 { PropertyType=Boolean }
135 { InitialValue=False }
136 Procedure Set pbAllErrorsToLocal Integer bState
137 Set pbAllErrorstoLocal Of ghInetSession To bState
138 End_Procedure
139
140 { Visibility=Private }
141 Procedure AddServiceTypeDefinitions handle hoRoot string sNSPre string sNsURI
142 String sXml
143 Handle hoXml hoDoc
144 Boolean bOk
145 Get InterfaceTypeDefinitions sNsPre sNsURI to sXml
146 Get Create U_cXmlDomDocument to hoXml
147 Get LoadXml of hoXml sXml to bOk
148 If (bOk) Begin
149 Get DocumentElement of hoXml to hoDoc
150 Get AppendNode of hoRoot hoDoc to bOk
151 Send Destroy to hoDoc
152 End
153 Send Destroy to hoXml
154 End_Procedure
155
156 { Visibility=Private }
157 Procedure AddServiceOperations handle hoRoot string sNSPre string sNsURI
158 integer iCount iItem
159 String sMethodName
160 String sMethodType
161 //String sParams
162 String sComment
163 Boolean bExtended
164 handle hoOperation
165
166 Get InterfaceMessageCount to iCount
167
168 For iItem From 0 to (iCount-1)
169
170 Get InterfaceMessageIsExtended iItem to bExtended
171 If not bExtended Begin
172 Error DFERR_PROGRAM C_$ParamsMustBeExtended
173 Procedure_return
174 End
175
176 Get InterfaceMessageName iItem to sMethodName
177 //Get InterfaceMessageParams iItem to sParams
178 Get InterfaceMessageComment iItem to sComment
179
180 If (sMethodName<>"get_WebServiceMetaData") Begin
181 // Split the "raw" method name into sMethodType and
182 // real method name. Raw method name is of the format:
183 // get_MethodName, set_MethodName or msg_MethodName.
184 Move (lowercase(Left (sMethodName, 3))) To sMethodType
185 Move (Remove(sMethodName, 1, 4)) To sMethodName
186
187 Get AddElementNS of hoRoot sNsURI (sNSPre+"operation") "" to hoOperation
188 Send AddAttribute of hoOperation "name" sMethodName
189 Send AddAttribute of hoOperation "methodType" sMethodType
190 If (sComment<>"") Begin
191 Send AddElementNS of hoOperation sNsURI (sNSPre+"documentation") sComment
192 end
193
194 //Send AddOperationParameters hoOperation sNSPre sNsURI sParams
195 Send AddOperationParameters hoOperation sNSPre sNsURI iItem
196 Send Destroy of hoOperation
197 end
198 Loop
199 end_procedure
200
201 { Visibility=Private }
202 Procedure AddOperationParameters Integer hoOperation String sNSPre string sNsURI Integer iMethodIndex
203 Integer iParam iParamCount iParamType iDimCount
204 Boolean bParamByRef
205 String sParamType sParamName
206 Handle hoParam
207 Get InterfaceMessageParamCount iMethodIndex to iParamCount
208 For iParam from 0 to iParamCount
209 Get InterfaceMessageParamType iMethodIndex iParam to iParamType
210 Get InterfaceMessageParamTypeName iMethodIndex iParam to sParamType
211 Get InterfaceMessageParamDimCount iMethodIndex iParam to iDimCount
212 If (iParam=iParamCount) Begin
213 // If the paramtype is xsNoParam (-1) then we don't have a return parameter (i.e., it's a procedure)
214 If (iParamType<>xsEmpty) begin
215 //Return type
216 If (iParamType=xsStruct) Begin
217 Send AddAttribute of hoOperation "returnTypeRef" sParamType
218 End
219 Else Begin
220 Move (Lowercase(sParamType)) to sParamType
221 if (sParamType="xmlhandle");
222 Move "xml" to sParamType
223 Send AddAttribute of hoOperation "returnType" sParamType
224 End
225 If (iDimCount) Begin
226 Send AddAttribute of hoOperation "returnTypeArrayDimCount" iDimCount
227 End
228 End
229 End
230 Else Begin
231 //Parameter
232 Get AddElementNS of hoOperation sNsURI (sNSPre+"parameter") "" to hoParam
233 Get InterfaceMessageParamName iMethodIndex iParam to sParamName
234 Send AddAttribute of hoParam "name" sParamName
235 If (iParamType=xsStruct) Begin
236 Send AddAttribute of hoParam "typeRef" sParamType
237 End
238 Else Begin
239 Move (Lowercase(sParamType)) to sParamType
240 if (sParamType="xmlhandle");
241 Move "xml" to sParamType
242 Send AddAttribute of hoParam "type" sParamType
243 End
244 If (iDimCount) Begin
245 Send AddAttribute of hoParam "arrayDimCount" iDimCount
246 End
247 Get InterfaceMessageParamByRef iMethodIndex iParam to bParamByRef
248 If (bParamByRef) Begin
249 Send AddAttribute of hoParam "byref" "true"
250 End
251 Send Destroy of hoParam
252 End
253 Loop
254 End_Procedure
255
256 // see WebServiceMetaData.xsd for a description of what needs to be generated here!
257
258 { Visibility=Private }
259 Function WebServiceMetaData Returns String
260 String sWebServiceMetaDataURI sServiceURI sServiceTitle sDocumentation sServiceName
261 String sXml
262 handle hoXML hoRoot hoOperation hoParam
263 string sNsPre
264 Boolean bDocumentStyle
265
266 Get psWebServiceMetaDataURI to sWebServiceMetaDataURI
267 Get psServiceName to sServiceName
268 Get psServiceURI to sServiceURI
269 Get psServiceTitle to sServiceTitle
270 Get psDocumentation to sDocumentation
271 Get pbDocumentStyle to bDocumentStyle
272
273 Move "wso:" to sNsPre
274 Get Create U_cXmlDomDocument to hoXml
275 Get CreateDocumentElementNS of hoXml sWebServiceMetaDataURI (sNsPre+"webServiceObject") to hoRoot
276 Send AddAttribute of hoRoot "name" sServiceName
277 Send AddAttribute of hoRoot "title" sServiceTitle
278 Send AddAttribute of hoRoot "namespace" sServiceURI
279 Send AddAttribute of hoRoot "soapBodyStyle" (if(bDocumentStyle,"document","rpc"))
280 Send AddElementNS of hoRoot sWebServiceMetaDataURI (sNsPre+"documentation") sDocumentation
281 Send AddServiceTypeDefinitions hoRoot sNsPre sWebServiceMetaDataURI
282 Send AddServiceOperations hoRoot sNsPre sWebServiceMetaDataURI
283 Get psXml of hoRoot to sXml
284 send destroy of hoRoot
285 send destroy of hoXml
286 Function_Return sXml
287 End_Function
288
289 Function SoapHeaderRequestNode Returns Handle
290 Address pVDFISData pData
291 Integer iTemp
292 Handle hoXml
293 Boolean bOk bKeepAlive
294
295 Get WebServiceRequestHeaders of ghInetSession to pVDFISData
296 If (pVDFISData=0) Begin
297 Send LogErrorEvent DFERR_WEBAPP_BAD_PARAMETER C_$pVDFISDataIsNull
298 Function_Return 0
299 End
300
301 Get VDFISData_pData pVDFISData to pData
302 If (pData<>0) Begin
303 Get Create of Desktop U_cXmlDomDocument to hoXml
304 Get LoadXMLFromAddress of hoXml pData to bOk
305 //TODO - Add the error message to language .inc file
306 If (not(bOk));
307 Send LogErrorEvent DFERR_WEBAPP_BAD_PARAMETER C_$InvalidSOAPRequestHeader
308
309 Move (DeRefDW(pVDFISData, VDFISData.bKeepAlive)) to bKeepAlive
310 If (not(bKeepAlive));
311 Move (Free(pData)) to iTemp
312 End
313 Move (Free(pVDFISData)) to iTemp
314
315 Function_Return hoXml
316 End_Function
317
318 Procedure AddSoapHeaderNode Handle hoNode
319 Address pData
320 Boolean bOK
321
322 // if node is not passed or it is not an element, this is an error
323 If (hoNode=0 or piNodeType(hoNode)<>NODE_ELEMENT) Begin
324 //TODO - Add the error message to language .inc file
325 Send LogErrorEvent DFERR_WEBAPP_BAD_PARAMETER C_$CannotAddSOAPResponseHeader1
326 Procedure_Return
327 End
328
329 Get paXml of hoNode to pData
330 // this should be very rare. For some reason an xml node of type element could not be converted to pData
331 If (not(pData)) Begin
332 //TODO - Add the error message to language .inc file
333 Send LogErrorEvent DFERR_WEBAPP_BAD_PARAMETER C_$CannotAddSOAPResponseHeader2
334 Procedure_Return
335 End
336 Send AddWebServiceResponseHeader of ghInetSession pData
337 Move (Free(pData)) to bOK
338 End_Procedure
339
340 Function ServerVariable String sVariableName Returns String
341 String sVal
342 Address pVar pData
343 Integer iTemp bKeepAlive
344
345 Get HttpServerVariable of ghInetSession sVariableName to pVar
346 Get Copy_VDFISDATAtoString pVar to sVal
347
348 //Cleanup memory
349 If (pVar) Begin
350
351 Get VDFISData_pData pVar to pData
352 Move (DeRefDW(pVar, VDFISData.bKeepAlive)) to bKeepAlive
353 If ( (pData) and (not(bKeepAlive)) );
354 Move (Free(pData)) to iTemp
355 Move (Free(pVar)) to iTemp
356 End
357 Function_Return sVal
358 End_Function
359
360 Procedure End_Construct_Object
361 Send RegisterInterface get_WebServiceMetaData "get_WebServiceMetaData" " Returns string" ""
362 Forward send End_construct_object
363 end_procedure
364
365End_Class
366