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