The SOAP Interface

<definitions name="TemperatureService" 
targetNamespace="http://www.xmethods.net/sd/TemperatureService.wsdl">
  <message name="getTempRequest">
    <part name="zipcode" type="xsd:string"/>
  </message>
  <message name="getTempResponse">
    <part name="return" type="xsd:float"/>
  </message>
  <portType name="TemperaturePortType">
    <operation name="getTemp">
      <input message="tns:getTempRequest"/>
      <output message="tns:getTempResponse"/>
    </operation>
  </portType>
  <binding name="TemperatureBinding" type="tns:TemperaturePortType">
    <soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
    <operation name="getTemp">
      <soap:operation soapAction=""/>
      <input>
        <soap:body use="encoded" namespace="urn:xmethods-Temperature-Demo" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
      </input>
      <output>
        <soap:body use="encoded" namespace="urn:xmethods-Temperature-Demo" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
      </output>
    </operation>
  </binding>
  <service name="TemperatureService">
    <documentation>
      Returns current temperature in a given U.S. zipcode  
    </documentation>
    <port name="TemperaturePort" binding="tns:TemperatureBinding">
      <soap:address location="http://services.xmethods.net:80/soap/servlet/rpcrouter"/>
    </port>
  </service>
</definitions>

{define-proc {getTemp zipcode:String}:float}

{import * from CURL.XML.SOAP}
{let xsd:String = "http://www.w3.org/2001/XMLSchema"}
{let xsi:String = "http://www.w3.org/2001/XMLSchema-instance"}

|| One input argument named "zipcode" of type "string"
|| corresponding to Curl language type String.
{let input-arguments:{Array-of Soap-1-1-ArgumentDescriptor} =
    {{Array-of Soap-1-1-ArgumentDescriptor}
        {Soap-1-1-StandardArgumentDescriptor
            {XMLName "", "zipcode"},
            {XMLName xsd, "string"},
            String
        }
    }
}

|| One output argument named "return" of XML type float
|| corresponding to Curl language type float.
{let output-arguments:{Array-of Soap-1-1-ArgumentDescriptor} =
    {{Array-of Soap-1-1-ArgumentDescriptor}
        {Soap-1-1-StandardArgumentDescriptor
            {XMLName "", "return"},
            {XMLName xsd, "float"},
            float
        }
    }
}

|| The operation descriptor.
{let get-temp:Soap-1-1-HttpOperation =
    {Soap-1-1-HttpOperation
        || operation name
        {XMLName "urn:xmethods-Temperature-Demo", "getTemp"},
        || url
        {url "http://services.xmethods.net:80/soap/servlet/rpcrouter" },
        || SOAPAction value in HTTP headers
        "",
        input-arguments,
        output-arguments,
        include-type-attribute? = true, || ###
        xsi = xsi || ### 
    }
}

{let result = {get-temp.call trace?= true, "02142"}}
{value result[0]}

|| The actual SOAP call.
{let anys:{Array-of any}={get-temp.call "01915"}}

{define-class public ConvertMessage
  field public currency:String
  field public amount:double
  field public to-currency:String

  {constructor public {default
                          currency:String,
                          amount:double,
                          to-currency:String
                      }
    set self.currency=currency
    set self.amount=amount
    set self.to-currency=to-currency
  }
}

|| marshaler helper -- marshals a field of a struct.
{define-proc public {marshaler-helper
                        mapper:XMLCurlMappingRegistry,
                        encoding-style:String,
                        xos:XMLOutputStream,
                        element-name:XMLName,
                        content-xml-type:XMLName,
                        content-curl-type:Type,
                        content-value:any,
                        include-type-attribute?:bool,
                        xsi:String
                    }:void
    {xos.write-one {new XMLStartElement, element-name}}
    {mapper.marshal
        encoding-style,
        content-value asa content-curl-type,
        content-curl-type,
        content-xml-type,
        xos,
        include-type-attribute?,
        xsi
    }
    {xos.write-one {new XMLEndElement}}
    {return}
}

|| converts Curl language value to XML for ConvertMessage type
{define-proc public {convert-message-marshaler
                        mapper:XMLCurlMappingRegistry,
                        encoding-style:String,
                        value:any,
                        xos:XMLOutputStream,
                        include-type-attribute?:bool,
                        xsi:String
                    }:void

    let cm:ConvertMessage = value asa ConvertMessage
    {marshaler-helper
        mapper,
        encoding-style,
        xos,
        {new XMLName, "", "currency"},
        {new XMLName, "", "string"},
        String,
        cm.currency,
        include-type-attribute?,
        xsi
    }
    {marshaler-helper
        mapper,
        encoding-style,
        xos,
        {new XMLName, "", "amount"},
        {new XMLName, "", "double"},
        double,
        cm.amount,
        include-type-attribute?,
        xsi
    }
    {marshaler-helper
        mapper,
        encoding-style,
        xos,
        {new XMLName, "", "toCurrency"},
        {new XMLName, "", "string"},
        String,
        cm.to-currency,
        include-type-attribute?,
        xsi
    }
    {return}
}

{define-class public InternetAddress
  field public ip:String
  field public hostname:String

  {constructor public {default ip:String, hostname:String}
    set self.ip=ip
    set self.hostname=hostname
  }
}

|| This procedure unmarshals a filed of a struct
{define-proc public {unmarshaler-helper
                        mapper:XMLCurlMappingRegistry,
                        encoding-style:String,
                        input:XMLInputStream,
                        element-name:XMLName,
                        content-xml-type:XMLName,
                        content-curl-type:Type
                    }:any

    let xml-token:XMLToken={input.read-one}
    {if {type-of xml-token} != XMLStartElement then
        {error "expecting XMLStartElement"}
    }
    {if (xml-token asa XMLStartElement).element != element-name then
        {error "element name mismatch"}
    }
    let return-value:any = {mapper.unmarshal
                               encoding-style,
                               content-curl-type,
                               content-xml-type,
                               input
                           }
    set xml-token={input.read-one}
    {if {type-of xml-token} != XMLEndElement then
        {error "expecting XMLEndElement"}
    }
    {return return-value}
}

||Convert XML to Curl language for type InternetAddress
{define-proc public {internet-address-unmarshaler
                        mapper:XMLCurlMappingRegistry,
                        encoding-style:String,
                        input:XMLInputStream
                    }:any

    let ip:any={unmarshaler-helper
                   mapper,
                   encoding-style,
                   input,
                   {new XMLName, "", "IP"},
                   {new XMLName, "", "string"},
                   String
               }
    let hostname:any={unmarshaler-helper
                         mapper,
                         encoding-style,
                         input,
                         {new XMLName, "", "Hostname"},
                         {new XMLName, "", "string"},
                         String
                     }
    {return {new InternetAddress, (ip asa String), (hostname asa
                                                    String)
            }
    }
}

|| 1. create a type mapping registry
{let my-registry:XMLCurlMappingRegistry={new XMLCurlMappingRegistry}}

|| 2. register the marshaler for ConvertMessage
{my-registry.map-types
    soap-encoding,
    {new XMLName,
        "",
        "ConvertMessage"},
    ConvertMessage,
    convert-message-marshaler,
    null
}

|| 3. the actual SOAP call
{let anys:#{Array-of any}={currency-converter.call
                              {new ConvertMessage, "NLG", 100.0, "DEM"},
                              registry=my-registry
                          }
}

{import * from CURL.XML.SOAP}

{let xsd:String = "http://www.w3.org/2001/XMLSchema"}

|| 0 input arguments
{let input-arguments:{Array-of Soap-1-1-ArgumentDescriptor}=
    {new {Array-of Soap-1-1-ArgumentDescriptor}}
}

|| 0 output arguments
{let output-arguments:{Array-of Soap-1-1-ArgumentDescriptor}=
    {new {Array-of Soap-1-1-ArgumentDescriptor}}
}

|| construct a header as an array of XMLToken
{let input-headers:{Array-of XMLToken}={new {Array-of XMLToken}}}
|| the header element is "echoMeStringRequest" containing a string
{input-headers.append {new XMLStartElement,
                          {new XMLName,
                              "http://soapinterop.org/echoheader/",
                              "echoMeStringRequest"}
                      }
}
{input-headers.append {new XMLCharacters, "Hello, Header"}}
{input-headers.append {new XMLEndElement}}

|| operation descriptor
{let echo-void:Soap-1-1-HttpOperation=
    {new Soap-1-1-HttpOperation,
        || operation name
        {new XMLName,"http://soapinterop.org/", "echoVoid"},
        || url
        || {url "http://mssoapinterop.org/stk/InteropC.wsdl" },
        {url "http://www.whitemesa.net/interop/std/echohdr"},
        || SOAPAction value
        || "urn:soapinterop",
        "http://soapinterop.org/",
        input-arguments,
        output-arguments
    }
}

|| the actual SOAP call -- headers are passed a value
|| of keyword argument
{let (anys:#{Array-of any}, return-headers:#{Array-of XMLToken})=
    {echo-void.call headers=input-headers, trace?=true}
}

|| The output arguments are returned in array of anys
|| This soap call returns 0 arguments
{if anys.size !=0 then
    {error "expected 0 return arguments, but got " & anys.size}
}

|| The headers are returned as array of XMLToken.
|| The header passed back should have the same contents
|| as the string passed in -- "Hello, Header"
{if return-headers.size < 4 then
    {error "error in return headers"}
}
{if {type-of return-headers[0]} != XMLStartElement then
    {error "expected first element of return headers to be
    XMLStartElement"}
}
{if {type-of return-headers[1]} != XMLAttribute then
    {error "expected first element of return headers to be
    XMLAttribute"}
}
{type-switch return-headers[2]
 case chars:XMLCharacters do
    {output "content of return header element: " & chars.characters}
 else
    {error "expect XMLCharacters as second element of return headers"}
}
{if {type-of return-headers[3]} != XMLEndElement then
    {error "expected first element of return headers to be
    XMLEndElement"}
}