Qore Programming Language

  • Increase font size
  • Default font size
  • Decrease font size

WSDL class

E-mail Print PDF

Initial support for SOAP is included in the Qore distribution with the WSDL class.

It's incomplete, but works for some subset of SOAP (and is very easily extended).

/Users/david/src/qore/module-xml/examples/WSDL.qc

# -*- mode: qore; indent-tabs-mode: nil -*-
#! @file WSDL.qc WSDL: Web Services Description Language: http://www.w3.org/TR/wsdl

# WSDL classes

# provides some minimal WSDL and XSD support for SOAP messaging used by the
# SoapClient class and the SoapHandler
# not complete, needs namespace verification, improved XSD support, element
# groups, etc

# 0.3.2: fixed bugs de/serializing negative values for "int" and "short"
# 0.3.1: improved XSD imports and namespace handling

# 0.3: implemented WSDLLib class of helper functions
#      implemented support for xsd import statements in WSDLs

# 0.2: use parseXMLAsData() instead of parseXML()
#      implemented initial simpleType support
#      fixed xsd:date serialization and deserialization

# make sure we have the required qore version
# 0.7.3 has parseXMLAsData()
# 0.7.6 has object -= list and object -= string handling
# 0.8.0 converted to hard typing for compatibility with %require-types
%requires qore >= 0.8.1

# requires XML functionality
%requires xml

%disable-warning unreferenced-variable

#! main WSDL namespace
namespace WSDL {
    #! this WSDL implementation version
    const version     = "0.3.2";

    const XET_ALL      = "ALL";
    const XET_CHOICE   = "CHOICE";
    const XET_SEQUENCE = "SEQUENCE";

    #! SOAP 1.1 envelope URI
    const SOAP_11_ENV  = "http://schemas.xmlsoap.org/soap/envelope/";
    #! SOAP 1.2 envelope URI
    const SOAP_12_ENV  = "http://www.w3.org/2003/05/soap-envelope";

    #! SOAP 1.1 namespace URI
    const SOAP_12_NS   = "http://schemas.xmlsoap.org/wsdl/soap12/";

    #! XSD namespace URI
    const XSD_NS       = "http://www.w3.org/2001/XMLSchema";
    #! XSI namespace URI
    const XSI_NS       = "http://www.w3.org/2001/XMLSchema-instance";

    #! HTTP namespace URI
    const HTTP_NS      = "http://schemas.xmlsoap.org/wsdl/http/";
    #! MIME namespace URI
    const MIME_NS      = "http://schemas.xmlsoap.org/wsdl/mime/";

    #! soap 1.1 envelope namespaces
    const ENVELOPE_11_NS =
	( "soapenv:Envelope" :
	  ( "^attributes^" :
	    ( "xmlns:soapenv" : SOAP_11_ENV,
	      "xmlns:xsd"     : XSD_NS,
	      "xmlns:xsi"     : XSI_NS ) ) );

    #! soap 1.2 envelope namespaces
    const ENVELOPE_12_NS =
	( "soapenv:Envelope" :
	  ( "^attributes^" :
	    ( "xmlns:soapenv" : SOAP_12_ENV,
	      "xmlns:xsd"     : XSD_NS,
	      "xmlns:xsi"     : XSI_NS ) ) );

    #! soap encoding URI
    const SOAP_ENCODING = "http://schemas.xmlsoap.org/soap/encoding/";

    #! mapping from Qore types to xsd types for xsd type "anyType"
    const any_type_map =
	( Type::String      : "string",
	  Type::Int         : "long",
	  Type::Boolean     : "boolean",
	  Type::Date        : "dateTime",
	  Type::Float       : "decimal",
	  Type::NothingType : "string",
	  Type::NullType    : "string",
	  Type::Binary      : "base64Binary" );

    # error codes, to save memory, only defined once
    const SOAP_SERIALIZATION_ERROR = "SOAP-SERIALIZATION-ERROR";
    const SOAP_DESERIALIZATION_ERROR = "SOAP-DESERIALIZATION-ERROR";
    const WSDL_ERROR = "WSDL-ERROR";

    const RANGE_SHORT = (-32768, 32767);
    const RANGE_INT = (-2147483648, 2147483647);
}

#! contains helper methods for retrieving WSDLs from a URL
class WSDL::WSDLLib {
    #! retrieves a local file and returns the file's contents as a string
    /** called by WSDLLib::getFileFromURL() in case the scheme is "file" */
    static string getFile(string $fn) {
	my File $f();
	$f.open2($fn);
	return $f.read(-1);
    }

    #! retrieves a file from a URL with HTTP and returns the file's contents as a string
    /** called by WSDLLib::getFileFromURL() in case the scheme is "http" */
    static string getHTTP(string $url, any $path, any $hc, any $headers) {
	if (exists $hc) {
	    if (!($hc instanceof HTTPClient))
		throw "GET-FILE-FROM-URL-ERROR", sprintf("object is not an HTTPClient: %n", type($hc));
	    $hc.setURL($url);
	}
	else
	    $hc = new HTTPClient(("url" : $url));
	return $hc.get(exists $path ? $path : "/", $headers);
    }

    #! retrieves a file from a URL with the FTP protocol and returns the file's contents as binary data
    /** called by WSDLLib::getFileFromURL() in case the scheme is "ftp" */
    static binary getFTP(string $url, string $path) {
	my string $file = basename($path);
	if (!exists $file)
	    throw "WSDL-LIB-ERROR", sprintf("missing file name in URL %n", $url);

	my FtpClient $f($url);
	$f.connect();

	my string $dir = dirname($path);
	if (exists $dir)
	    $f.cwd($dir);

	return $f.getAsBinary($file);
    }

    #! retrieves a file from a URL
    static any getFileFromURL(string $url, string $def_protocol, any $http_client, any $http_headers) {
	my hash $u = parse_url($url);

	if (!exists $u.protocol)
	    $u.protocol = exists $def_protocol ? $def_protocol : "file";

	switch ($u.protocol) {
	    case "file":
		return WSDLLib::getFile($u.host + $u.path);

	    case /^http(s)?$/:
		return WSDLLib::getHTTP($url, $u.path, $http_client, $http_headers);

	    case /^ftp(s)?$/:
		return WSDLLib::getFTP($url, $u.path);

	    default:
	        throw "WSDL-LIB-ERROR", sprintf("do not know how to retrieve data with protocol %n given in URL %n", $u.protocol, $url);
	}
    }

    #! returns the argument
    static WebService getWSDL(WebService $wsdl) {
        return $wsdl;
    }

    #! returns a WSDL string form a file name, optional HTTPClient object and optional header hash
    static string getWSDL(string $wsdl, *HTTPClient $http_client, *hash $http_headers) {
	if (strlen($wsdl) > 256 && $wsdl !~ /^\w+:\/\/.*$/)
	    return $wsdl;
	return WSDLLib::getFileFromURL($wsdl, "file", $http_client, $http_headers);
    }

    #! takes a hash representation of a SOAP message and parses it to a Qore data structure; handles multipart messages, checks the content-type, and handles hrefs in the message
    static hash parseSOAPMessage(hash $msg) {
	if (exists $msg."_qore_multipart") {
	    if ($msg."_qore_multipart" != "related")
		throw "SOAP-MESSAGE-ERROR", sprintf("don't understand multipart/%s messages, expected multipart/related", $msg."_qore_multipart");

	    my any $bdry = $msg."_qore_multipart_boundary";
	    if (!strlen($bdry))
		throw "SOAP-MESSAGE-ERROR", sprintf("multipart message received without multipart boundary; headers=%n", $msg - "body");

	    my hash $mpmsg;
	    my list $l = split("\r\n--" + $bdry, $msg.body);

	    #printf("l=%N\n", $l);
	    #my File $f(); $f.open2("t.bin", O_CREAT|O_WRONLY|O_TRUNC); $f.write(binary($l[3])); exit();
	    #my File $f(); $f.open2("t.bin", O_CREAT|O_WRONLY|O_TRUNC); $f.write(binary($msg.body)); exit();

	    for (my int $i = 1; $i < (elements $l - 1); ++$i) {
		my string $m = $l[$i];

		my int $ie = index($m, "\r\n\r\n");
		if ($ie == -1) {
		    throw "SOAP-MESSAGE-ERROR", sprintf("part %d has no headers: %n", $i, $m);
		}
		my hash $hh;
		foreach my string $hl in (split("\r\n", substr($m, 2, $ie))) {
		    trim $hl;
		    my (string $hi, any $ignore, string $ha) = $hl =~ x/^(.*):([ \t])*(.*)$/;
		    $hi = tolower($hi);
		    #printf("hl=%n hi=%n ha=%n\n", $hl, $hi, $ha);exit();
		    $hh.$hi = $ha;
		}
		if (!exists $hh."content-id")
		    throw "SOAP-MESSAGE-ERROR", sprintf("expecting part header Content-ID in part %d; headers: %n", $i, $hh);

		my any $b;
		if ($hh."content-transfer-encoding" == "binary") {
		    # unfortunately we have to do some tricks to get the binary data out here
                    # FIXME: tricks probably not necessary with qore 0.8.1+
		    $m = force_encoding($m, "ascii");
		    # recalculate byte offset
		    $ie = index($m, "\r\n\r\n");
		    #printf("ie=%d m=%d\n", $ie, strlen($m));exit();
		    $b = binary(substr($m, $ie + 4));

		    #my File $f(); $f.open2("t.bin", O_CREAT|O_WRONLY|O_TRUNC); $f.write($b); exit();
		}
		else {
		    $b = substr($m, $ie + 4);

		    if ($hh."content-type" =~ /charset=/) {
			my string $c = ($hh."content-type" =~ x/charset=([^;]+)/)[0];
			$b = force_encoding($b, $c);
		    }
		}

		if ($hh."content-id" !~ /^\<.*\>$/)
		    throw "SOAP-MESSAGE-ERROR", sprintf("expected part ID to have the following format: <id>, instead got %s", $hh."content-id");

		my hash $p = ( "hdr" : $hh,
                               "body" : $b );

		if ((!exists $msg."_qore_multipart_start" && $i == 1)
		    || (exists $msg."_qore_multipart_start" && $msg."_qore_multipart_start" == $hh."content-id")) {
		    $mpmsg.body = $p;
		}
		else {
		    my string $id = substr($hh."content-id", 1, -1);
		    $mpmsg.part.$id = $p;
		}
	    }
	    # check content-type
	    WSDLLib::checkSOAPContentType($mpmsg.body.hdr."content-type");

	    #printf("part %d hh=%N\nbody=%s (%d)\n", $i, $hh, type($b), elements($b)); #exit();
	    my hash $xmldata = parseXMLAsData($mpmsg.body.body);

	    # parse entire data structure to find "href"s or href attributes
	    WSDLLib::substHref(\$xmldata, $mpmsg.part);
	    return $xmldata;
	}

	WSDLLib::checkSOAPContentType($msg."content-type");

	return parseXMLAsData($msg.body);
    }

    private static checkSOAPContentType(string $ct) {
	foreach my string $sct in ("application/soap+xml", "text/xml") {
	    if (bindex($ct, $sct) != -1)
		return;
	}

	throw "SOAP-MESSAGE-ERROR", sprintf("don't know how to handle content-type %n (expecting 'application/soap+xml' or 'text/xml')", $ct);
    }

    private static processHref(reference $xmldata, string $hr, hash $parts) {
	if ($hr !~ /^cid:/)
	    throw "SOAP-MESSAGE-ERROR", sprintf("messages references non-local part %n; cannot handle non-local parts", $hr);
	$hr = substr($hr, 4);
	if (!exists $parts.$hr)
	    throw "SOAP-MESSAGE-ERROR", sprintf("message references non-existent part %n", $hr);
	$xmldata = $parts.$hr.body;
    }

    private static substHref(reference $xmldata, hash $parts) {
	foreach my string $k in (keys $xmldata) {
	    if (exists $xmldata.$k."^attributes^".href)
		WSDLLib::processHref(\$xmldata.$k, $xmldata.$k."^attributes^".href, $parts);
	    else if (exists $xmldata.$k.href)
		WSDLLib::processHref(\$xmldata.$k, $xmldata.$k.href, $parts);
	    else if (type($xmldata.$k) == Type::List) {
		foreach my any $e in (\$xmldata.$k)
		    WSDLLib::substHref(\$e, $parts);
	    }
	    else if (type($xmldata.$k) == Type::Hash)
		WSDLLib::substHref(\$xmldata.$k, $parts);
	}
    }
}

# abstract class providing helper methods to subclasses
class WSDL::XSDBase {
    static private doType(string $t, hash $nsinfo = hash()) returns any{
	#printf("DEBUG: XSDBase::doType(%n, %n)\n", $t, $nsinfo);
	my (any $ns, any $type) = $t =~ x/(\w+):(\w+)/;
	if (!exists $type)
	    return ( "val" : $t );

	# if this is in the XML Schema namespace, then it's a base type
	if ($nsinfo.xml_schema.$ns)
	    return new XSDBaseType($type);

	return ( "ns"  : $ns,
		 "val" : $type );
    }

    static removeNS(reference $h) {
	foreach my string $k in (keys $h) {
	    my (any $ns, any $name) = $k =~ x/(\w+):(\w+)/;
	    if (exists $ns) {
		if (type($h.$k) == Type::Hash)
		    $h.$k.ns = $ns;
		$h.$name = $h.$k;
		$h -= $k;
	    }
	}
    }

    static removeNS2(reference $h) {
	foreach my string $k in (keys $h) {
	    my (any $ns, any $name) = $k =~ x/(\w+):(\w+)/;
	    if (exists $ns) {
		if (type($h.$k) == Type::Hash)
		    $h.$k.".ns" = $ns;
		$h.$name = $h.$k;
		$h -= $k;
	    }
	}
    }
}

# abstract type common to all XSD classes
class WSDL::XSDData inherits XSDBase {
    any getValue(any $mrh, any $val) {
	if (exists $val."^attributes^".href) {
	    my string $href = substr($val."^attributes^".href, 1);

	    if (!exists $mrh.$href)
		throw "INVALID-REFERENCE", sprintf("multiRef id=%n does not exist", $href);

	    return $mrh.$href;
	}
	return $val;
    }
}

# abstract type common to all XSD classes with a "name" attribute
class WSDL::XSDNamedData inherits XSDData {
    public {
        any $.name;
        any $.ns;
    }
    constructor(reference $e) {
	WSDL::XSDBase::removeNS(\$e);

	$.name = $e."^attributes^".name;
    }

    string getName() {
	return exists $.name ? $.name : "<unnamed type>";
    }

    any getNS() {
	return $.ns;
    }
}

# class for XSD base types
class WSDL::XSDBaseType inherits XSDData {
    public {
        string $.type;
        string $.nstype;
    }
    constructor(string $t) {
	$.type = $t;
	$.nstype = "xsd:" + $t;
    }

    any serialize(any $val, any $omit_type) {
	my (any $type, string $nstype);
	# set type according to Qore type if xsd type is anyType
	if ($.type == "anyType") {
	    # we have to specify the type in this case
	    $omit_type = False;
	    $type = any_type_map{type($val)};
	    $nstype = "xsd:" + $type;
	    if (!exists $type)
		throw SOAP_SERIALIZATION_ERROR, sprintf("cannot serialize xsd type anyType from Qore type %n", type($val));
	}
	else {
	    $type = $.type;
	    $nstype = $.nstype;
	}

	switch ($type) {
	    case "byte": {
		my int $v = int($val);
		if (($v & 0xff) != $v)
		    throw SOAP_SERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $v, $type);
		break;
	    }

	    case "short": {
		my int $v = int($val);
		if ($v < RANGE_SHORT[0] || $v > RANGE_SHORT[1])
		    throw SOAP_SERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $v, $type);
		break;
	    }

	    case "int": {
		my int $v = int($val);
		if ($v < RANGE_INT[0] || $v > RANGE_INT[1])
		    throw SOAP_SERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $v, $type);
		break;
	    }

	    case "unsignedByte": {
		my int $v = int($val);
		if (($v & 0xff) != $v)
		    throw SOAP_SERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $v, $type);
	        if ($v < 0)
		    throw SOAP_SERIALIZATION_ERROR, sprintf("type %n does not accept negative values (value supplied: %d)", $type, $v);
		break;
	    }

	    case "unsignedShort": {
		my int $v = int($val);
		if ($v < 0 || $v > RANGE_SHORT[1])
		    throw SOAP_SERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $v, $type);
		break;
	    }

	    case "unsignedInt": {
		my int $v = int($val);
		if ($v < 0 || $v > RANGE_INT[1])
		    throw SOAP_SERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $v, $type);
		break;
	    }

	    case "unsignedLong": {
		my int $v = int($val);
	        if ($v < 0)
		    throw SOAP_SERIALIZATION_ERROR, sprintf("type %n does not accept negative values (value supplied: %d)", $type, $v);
		break;
	    }

	    case "positiveInteger":
	        if ($val <= 0)
		    throw SOAP_SERIALIZATION_ERROR, sprintf("type %n only accepts positive values (value supplied: %d)", $type, $val);
	        break;

	    case "date":
		$val = format_date("YYYY-MM-DD", date($val));
	        break;

	    case "dateTime":
		$val = format_date("YYYY-MM-DDTHH:mm:SS", date($val));
	        break;

	    case "boolean":
		$val = $val ? "true" : "false";
	        break;

	    case "time":
		$val = format_date("hh:mm:ss.ms", date($val));
	        break;

	    case "base64Binary":
		$val = makeBase64String($val);
	        break;

	    case "hexBinary":
		$val = makeHexString($val);
	        break;
	}

	#printf("DEBUG: FORCE: type=%n, nstype=%n, val=%n\n", $type, $.nstype, $val);
	if ($omit_type == "ns")
	    return ( "^attributes^" : ( "xmlns:xsi" : XSI_NS, "xsi:type" : $nstype ), "^value^" : $val );
	return $omit_type ? $val : ( "^attributes^" : ( "xsi:type" : $nstype ), "^value^" : $val );
    }

    any deserialize(any $types, any $mrh, any $val) {
	my string $type;
	if (type($val) == Type::Hash) {
	    $type = $val."^attributes^"."xsi:type";
	    my string $t = ($type =~ x/\w+:(\w+)/)[0];
	    if (exists $t)
		$type = $t;

	    if ($.type != "anyType" && $type != $.type)
		throw SOAP_DESERIALIZATION_ERROR, sprintf("expecting base type %n, got %n", $.type, $val."^attributes^"."xsi:type");
	    if (exists $val."^value^")
		$val = $val."^value^";
	}
	else
	    $type = $.type;

	switch ($type) {
	    case "string":
	    case "anyURI":
	    # note that we do not convert xsd:integer to a qore integer to avoid losing precision
	    case "integer":
		return $val;

	    case "byte":
		$val = int($val);
		if (($val & 0xff) != $val)
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $val, $.type);
	        return $val;

	    case "short":
		$val = int($val);
		if ($val < RANGE_SHORT[0] || $val > RANGE_SHORT[1])
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $val, $.type);
	        return $val;

	    case "int":
		$val = int($val);
		if ($val < RANGE_INT[0] || $val > RANGE_INT[1])
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $val, $.type);
	        return $val;

	    case "long":
		return int($val);

	    case "unsignedByte":
		$val = int($val);
		if (($val & 0xff) != $val)
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $val, $.type);
	        if ($val < 0)
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("type %n does not accept negative values (value supplied: %d)", $.type, $val);
	        return $val;

	    case "unsignedShort":
		$val = int($val);
		if (($val & 0xffff) != $val)
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $val, $.type);
	        if ($val < 0)
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("type %n does not accept negative values (value supplied: %d)", $.type, $val);
	        return $val;

	    case "unsignedInt":
		$val = int($val);
		if (($val & 0xffffffff) != $val)
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("value %d is out of range for type %n", $val, $.type);
	        if ($val < 0)
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("type %n does not accept negative values (value supplied: %d)", $.type, $val);
	        return $val;

	    case "unsignedLong":
	        if ($val < 0)
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("type %n does not accept negative values (value supplied: %d)", $.type, $val);
		return int($val);

	    case "positiveInteger":
	        if ($val <= 0)
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("type %n only accepts positive values (value supplied: %d)", $.type, $val);
		return int($val);

	    case "date":
	        # remove dashes from date
		$val =~ s/-//g;
		return date($val);

	    case "dateTime":
		return date(substr($val, 0, 4) + substr($val, 5, 2) + substr($val, 8, 2) +
			    substr($val, 11, 2) + substr($val, 14, 2) + substr($val, 17, 2));

	    case "time":
		return date("19700101" + substr($val, 0, 2) + substr($val, 3, 2) + substr($val, 6, 2)) +
		       milliseconds(substr($val, 9, 3));

	    case "boolean":
		if ($val =~ /true/i)
		    return True;
	        if ($val =~ /false/i)
		    return False;
	        return boolean($val);

	    case "decimal":
		return float($val);

	    case "base64Binary":
		return parseBase64String($val);

	    case "hexBinary":
		return parseHexString($val);

	    default: {
		if ($.type == "anyType")  {
		    if (exists $types.$type)
			return $types.$type.deserialize($types, $mrh, $val);
		}
		throw SOAP_DESERIALIZATION_ERROR, sprintf("don't know how to handle type %n", $.type);
	    }
	}
    }

    string getName() {
	return $.type;
    }

    string getNameWithNS() {
	return $.nstype;
    }
}

# class for XSD array types; currently only supports "binary"; used, for example with HTTP MultiPart messages
class WSDL::XSDArrayType inherits XSDData {
    public {
        string $.type;
    }
    constructor(string $t) {
	$.type = $t;

	if ($t != "binary")
	    throw "XSD-ARRAYTYPE-ERROR", sprintf("don't know how to handle arrays of type %n", $t);
    }
    any serialize(any $val, any $omit_type) {
	switch ($.type) {
	    case "binary": {
		my string $t = ::type($val);
		if ($t == Type::String)
		    $val = binary($val);
		else if ($t != Type::Binary)
		    throw SOAP_SERIALIZATION_ERROR, sprintf("cannot serialize type %n from type %n; requires string or binary", $.type, $t);
                return $val;
	    }

	    default: {
		throw SOAP_SERIALIZATION_ERROR, sprintf("don't know how to handle type %n", $.type);
	    }
	}
    }
    any deserialize(any $types, any $mrh, any $val) {
	switch ($.type) {
	    case "binary": {
		if (::type($val) != Type::Binary)
		    throw SOAP_DESERIALIZATION_ERROR, sprintf("cannot deserialize type %n from type %n; requires binary", $.type, ::type($val));
		return $val;
	    }

	    default: {
		throw SOAP_DESERIALIZATION_ERROR, sprintf("don't know how to handle type %n", $.type);
	    }
	}
    }
}

# XSD element class
class WSDL::XSDElement inherits XSDNamedData {
    public {
        any $.type;
        int $.minOccurs = 1;
        int $.maxOccurs = 1;
        bool $.nillable = False;
    }
    constructor(hash $e, any $nsinfo, any $unresolved) : XSDNamedData(\$e) {
	if ($nsinfo instanceof XSDData) {
	    $.type = $nsinfo;
	    return;
	}

	my any $a = $e."^attributes^";

	if (exists $a.minOccurs)
	    $.minOccurs = int($a.minOccurs);

	if (exists $a.maxOccurs)
	    if ($a.maxOccurs == "unbounded")
	        $.maxOccurs = -1;
	    else
		$.maxOccurs = int($a.maxOccurs);

	if ($.maxOccurs != -1 && $.minOccurs > $.maxOccurs)
	    throw "XSD-ELEMENT-ERROR", sprintf("minOccurs (%d) > maxOccurs (%d) for element %s", $.minOccurs, $.maxOccurs, $.name);

	if ($a.nillable == "true")
	    $.nillable = True;

	if (exists $a.type) {
	    $.type = WSDL::XSDBase::doType($a.type, $nsinfo);

	    # add self to unresolved list if element type cannot be resolved
	    if (!($.type instanceof XSDData)) {
		#printf("DEBUG: self=%n\n", $self);
		$unresolved.add($self);
	    }
	}
	else if (exists $e.simpleType)
	    $.type = new XSDSimpleType($e.simpleType, $nsinfo, $unresolved);
	else if (exists $e.complexType)
	    $.type = new XSDComplexType($e.complexType, $nsinfo, $unresolved);

	#printf("DEBUG: XSDElement self=%N\n", $self);
    }

    any serialize(any $h, any $omit_type, any $omit_ns, any $key, any $typename) {
	if (!exists $h) {
	    if ($.minOccurs) {
		if ($.nillable) {
		    my hash $rh = ("xsi:nil" : "true");
		    if (!$omit_type)
			$rh += ("xsi:type" : $.type.getNameWithNS());
		    return ("^attributes^" : $rh);
		}
	        else {
		    if (exists $key && exists $typename)
			throw SOAP_SERIALIZATION_ERROR, sprintf("missing value for %s.%s (minOccurs=%d, type %n)", $typename, $key, $.minOccurs, $.type.getName());
		    else
			throw SOAP_SERIALIZATION_ERROR, sprintf("missing element value (minOccurs=%d, type %n)", $.minOccurs, $.type.getName());
		}
	    }
	    else
		return;
	}
	if (type($h) == Type::List) {
	    if (elements $h == 1)
		$h = $h[0];
	    else {
		if ($.maxOccurs == 1)
		    throw SOAP_SERIALIZATION_ERROR, sprintf("cannot serialize element %n of type %n from a list because maxOccurs = 1", $.name, $.type.getName());
		if (elements $h > $.maxOccurs && $.maxOccurs > 0)
		    throw SOAP_SERIALIZATION_ERROR, sprintf("list for element %n of type %n has %d element%s, but maxOccurs = %d", $.name, $.type.getName(), elements $h, elements $h == 1 ? "" : "s", $.maxOccurs);
		if (elements $h < $.minOccurs)
		    throw SOAP_SERIALIZATION_ERROR, sprintf("list for element %n of type %n has %d element%s, but minOccurs = %d", $.name, $.type.getName(), elements $h, elements $h == 1 ? "" : "s", $.minOccurs);

		my list $l = ();
		foreach my any $e in ($h) {
		    $l += $.type.serialize($e, $omit_type, $omit_ns);
		}
		return $l;
	    }
	}
	if ($.minOccurs > 1)
	    throw SOAP_SERIALIZATION_ERROR, sprintf("only one element passed to element %n of type $n, but minOccurs = %d", $.name, $.type.getName(), $.minOccurs);
	#printf("DEBUG: element %n omit_type=%n omit_ns=%n\n", $.name, $omit_type, $omit_ns);
	#printf("DEBUG: type=%N\n", $.type);
	return $.type.serialize($h, $omit_type, $omit_ns);
    }

    any deserialize(any $types, any $mrh, any $val) {
	my any $a = $val."^attributes^";
	WSDL::XSDBase::removeNS(\$a);

	if (!exists $val || $a.nil == "true") {
	    if ($.nillable || !$.minOccurs)
		return;
	    throw SOAP_DESERIALIZATION_ERROR, sprintf("NOTHING passed for element %n, but nillable=False and minOccurs=%d", $.name, $.minOccurs);
	}

	if (type($val) == Type::List) {
	    my int $el = elements $val;
	    if ($.maxOccurs != -1 && $el > $.maxOccurs)
		throw SOAP_DESERIALIZATION_ERROR, sprintf("error deserializing element %n, maxOccurs=%d but list is %d elements long", $.name, $.maxOccurs, $el);
	    if ($el < $.minOccurs)
		throw SOAP_DESERIALIZATION_ERROR, sprintf("error deserializing element %n, minOccurs=%d but list is %d elements long", $.name, $.minOccurs, $el);

	    my list $l;
	    foreach my any $e in ($val)
		$l[elements $l] = $.type.deserialize($types, $mrh, $.getValue($mrh, $e));
	    return $l;
	}

	if ($.minOccurs > 1)
	    throw SOAP_DESERIALIZATION_ERROR, sprintf("single value passed for element %n, but minOccurs=%d", $.name, $.minOccurs);

	return $.type.deserialize($types, $mrh, $.getValue($mrh, $val));
    }
}

# XSD simple type class
class WSDL::XSDSimpleType inherits XSDNamedData {
    public {
        any $.nsinfo;
        list $.enum = ();
        any $.type;
    }

    constructor(hash $st, any $nsinfo, any $unresolved) : XSDNamedData(\$st) {
	$.nsinfo = $nsinfo;
	#my any $a = $st."^attributes^";
	delete $st."^attributes^";

	WSDL::XSDBase::removeNS(\$st);

	if (exists $st.restriction) {
	    my any $r = $st.restriction;

	    my any $base = $r."^attributes^".base;
	    if (!exists $base)
		throw "XSD-SIMPLETYPE-ERROR", sprintf("missing 'base' attribute in simpleType %n restriction", $.name);

	    $.type = WSDL::XSDBase::doType($base, $nsinfo);

	    # add base type to unresolved list if type cannot be resolved
	    if (!($.type instanceof XSDData))
		$unresolved.add($self);

	    WSDL::XSDBase::removeNS(\$r);

	    if (exists $r.enumeration)
		$.enum = map $1."^attributes^".value, $r.enumeration;
	    else
		throw "XSD-SIMPLETYPE-ERROR", sprintf("missing enumeration element in simpleType %n restriction", $.name);
	}
	else
	    throw "XSD-SIMPLETYPE-ERROR", sprintf("missing restriction element in simpleType %n", $.name);

	#printf("DEBUG: st=%N\n", $self); exit();
    }

    any serialize(any $val, any $omit_type, any $omit_ns) {
	if (!inlist($val, $.enum))
	    throw "SOAP-SERIALIZATION-ERROR", sprintf("value %n passed to simpleType %n is not in the enumeration list (%n)", $val, $.name, $.enum);

	return $.type.serialize($val, $omit_type, $omit_ns);
    }

    any deserialize(any $types, any $mrh, any $val) {
	my any $v = $.type.deserialize($types, $mrh, $val);

	if (!inlist($v, $.enum))
	    throw "SOAP-DESERIALIZATION-ERROR", sprintf("value %n passed to simpleType %n is not in the enumeration list (%n)", $v, $.name, $.enum);

	return $v;
    }

    string getNameWithNS() {
	return "ns1:" + $.name;
    }
}

# XSD complex type class
class WSDL::XSDComplexType inherits XSDNamedData {
    public {
        any $.nsinfo;
        any $.array;
        any $.restriction;
        any $.extension;
        any $.hash_type;
        any $.elements;
    }
    constructor(any $ct, any $nsinfo, any $unresolved) : XSDNamedData(\$ct) {
	$.nsinfo = $nsinfo;
	#my any $a = $ct."^attributes^";
	delete $ct."^attributes^";

	my any $d = $ct.complexContent;
	if (exists $d) {
	    WSDL::XSDBase::removeNS(\$d);
	    if (exists $d.restriction) {
		WSDL::XSDBase::removeNS(\$d.restriction);

		my any $base = $d.restriction."^attributes^".base;

		# FIXME: handle namespace
		my (any $ns, any $tn) = $base =~ x/(\w+):(\w+)/;
		if (exists $tn) {
		    if ($tn == "Array") {
			# FIXME check that namespace is SOAP encoding
			my any $aa = $d.restriction.attribute."^attributes^";
			WSDL::XSDBase::removeNS(\$aa);
			if (!exists $aa.arrayType)
			    throw WSDL_ERROR, sprintf("cannot parse complexType restriction: %n", $d.restriction);

			# FIXME: handle multiple dimensions?
			my (any $ans, any $atn) = $aa.arrayType =~ x/(\w+):(\w+)\[\]$/;
			if (exists $atn) {
			    $.array.val = $atn;
			    $.array.ns  = $ans;
			}
			else
			    $.array.val = $aa.arrayType;

			delete $d.restriction.attribute;
			#printf("DEBUG: ans=%n atn=%n aa=%N\n", $ans, $atn, $aa);
			return;
		    }
		    else {
			$.restriction = $tn;
		    }
		}

		delete $d.restriction."^attributes^";

		$.parseData($d.restriction, $unresolved);
	    }
	    else if (exists $d.extension) {
		$.extension = $d.extension."^attributes^".base;

		# FIXME: check for soap encoding namespace
		$.extension =~ s/(.*:)(.*)/$2/;
		delete $d.extension."^attributes^";
		WSDL::XSDBase::removeNS(\$d.extension);

		$.parseData($d.extension, $unresolved);
	    }
	    else
		throw "XSD-COMPLEXCONTENT-ERROR", sprintf("can't parse complexContent %n information", (keys $d)[0]);
	}
	else
	    $.parseData($ct, $unresolved);
    }

    private parseData(any $d, any $unresolved) {
	delete $d.ns;
	if (elements $d > 1)
	    throw WSDL_ERROR, sprintf("expecting a single element in the complexType hash, got: %n", keys $d);

	my string $k = (keys $d)[0];
	if ($k == "all") {
	    $.hash_type = XET_ALL;
	    WSDL::XSDBase::removeNS(\$d.all);
	    $.elements = $.parseElements($d.all.element, $unresolved);
	}
	else if ($k == "choice") {
	    $.hash_type = XET_CHOICE;
	    WSDL::XSDBase::removeNS(\$d.choice);
	    $.elements = $.parseElements($d.choice.element, $unresolved);
	}
	else if ($k == "sequence") {
	    $.hash_type = XET_SEQUENCE;
	    WSDL::XSDBase::removeNS(\$d.sequence);
	    if (exists $d.sequence.element)
		$.elements = $.parseElements($d.sequence.element, $unresolved);
	    else
		$.elements = hash();
	}
	else
	    throw "XSD-COMPLEXTYPE-ERROR", sprintf("unknown keys in %n", $d);
    }

    private hash parseElements(any $el, any $unresolved) {
	#printf("DEBUG: XSDComplexType::parseElements(%n)\n", $el);
	my hash $h;
	foreach my any $e in ($el) {
	    my XSDElement $elem($e, $.nsinfo, $unresolved);
	    $h.($elem.name) = $elem;
	}
	return $h;
    }

    any serialize(any $h, any $omit_type, any $omit_ns) {
	if (exists $.array)
	    return $.array.serialize($h, $omit_type, $omit_ns);

	if (type($h) != Type::Hash)
	    throw SOAP_SERIALIZATION_ERROR, sprintf("expecting hash argument to serialize from complexType %n (got %n, type %n)", $.getName(), $h, type($h));

	my hash $rh;

	if ($.hash_type == XET_SEQUENCE || $.hash_type == XET_ALL) {
	    foreach my string $p in (keys $.elements) {
		#printf("element=%s=%N\nvalue=%N\n", $p, $.elements.$p, $h.$p);
		my any $e = $.elements.$p.serialize($h.$p, $omit_type, $omit_ns, $p, $.name);
		if (exists $e) {
		    my any $key = $omit_ns ? $p : ("ns1:" + $p);
		    $rh.$key = $e;
		}
		delete $h.$p;
	    }
	    if (elements $h)
		throw SOAP_SERIALIZATION_ERROR, sprintf("%n %s of type %n (valid elements: %n)", (my string $kl = keys $h), elements $kl == 1 ? "is an invalid member" : "are invalid members", $.getName(), keys $.elements);
	}
	else { # "choice" - union
	    if (elements $h > 1)
		throw SOAP_SERIALIZATION_ERROR, sprintf("cannot serialize type %s with more than 1 member (%n)", $.getName(), keys $h);
	    my any $key = (keys $h)[0];
	    if (!exists $.elements.$key)
		throw SOAP_SERIALIZATION_ERROR, sprintf("%n is an invalid member of type %n", $key, $.getName());

	    # add namespace if necessary
	    my string $nskey = $omit_ns ? $key : ("ns1:" + $key);
	    $rh.$nskey = $.elements.$key.serialize($h.$key, $omit_type, $omit_ns, $key, $.name);
	}

	if (exists $.name && !$omit_type)
	    $rh."^attributes^" = ( "xsi:type" : "ns1:" + $.name );
	#printf("complex type %s returning %n from %n\n", $.name, $rh, $h);
	return $rh;
    }

    hash deserialize(any $types, any $mrh, any $val) {
	if (exists $.array)
	    return $.array.deserialize($types, $mrh, $val);

	if (type($val) != Type::Hash)
	    throw SOAP_DESERIALIZATION_ERROR, sprintf("cannot deserialize type %n from qore type %n (expecting hash)", $.getName(), type($val));

	my hash $rh;

	my any $attr = $val."^attributes^";
	delete $val."^attributes^";

	# ensure types match
	my any $tn = $attr."xsi:type";
	if (exists $tn) {
	    my (any $ns, any $name) = $tn =~ x/(.*):(.*)/;
	    if (exists $name)
		$tn = $name;
	    if ($tn != $.name)
		throw SOAP_DESERIALIZATION_ERROR, sprintf("expecting ComplexType type %n, got %n", $.getName(), $tn);
	}

	WSDL::XSDBase::removeNS2(\$val);

	#my any $ns = $val.".ns";
        $val -= ".ns";

	if ($.hash_type == XET_SEQUENCE || $.hash_type == XET_ALL) {
	    foreach my string $p in (keys $.elements) {
		#printf("element %n\n", $p);
		$rh.$p = $.elements.$p.deserialize($types, $mrh, $.getValue($mrh, $val.$p));
		delete $val.$p;
	    }
	    delete $val."^attributes^";
	    if (elements $val)
		throw SOAP_DESERIALIZATION_ERROR, sprintf("invalid element %n passed in type %n (expecting %n)", (keys $val)[0], $.getName(), keys $.elements);
	}
	else { # "choice" - union
	    my any $kl = keys $val;
	    if (elements $kl > 1)
		throw SOAP_DESERIALIZATION_ERROR, sprintf("too many elements supplied for union type %n (%n)", $.getName(), $kl);
	    $kl = $kl[0];
	    if (!exists $.elements.$kl)
		throw SOAP_DESERIALIZATION_ERROR, sprintf("element %n is not a valid element for union type %n", $kl, $.getName());

	    $rh.$kl = $.elements.$kl.deserialize($types, $mrh, $.getValue($mrh, $val.$kl));
	}
	return $rh;
    }

    string getNameWithNS() {
	return "ns1:" + $.name;
    }
}

#! web service operation class
class WSDL::WSOperation inherits XSDNamedData {
    public {
        any $.input;
        any $.output;
	any $.types;
	string $.targetns;
	bool $.soap12 = False;
	bool $.usedocns = False;
        string $.soapAction = "";
        string $.request_name = "";
        any $.in;
        any $.out;
        bool $.docstyle = False;
    }

    constructor(any $p, any $types, string $targetns, any $messages, bool $soap12 = False, bool $usedocns = False) : XSDNamedData(\$p) {
	$.types = $types;
	$.targetns = $targetns;
	$.soap12 = $soap12;
	$.usedocns = $usedocns;

	my any $msghash = $.processNSValue($p.input."^attributes^");

	my any $msg = $messages.($msghash.message.val);
	if (!exists $msg)
	    throw WSDL_ERROR, sprintf("missing definition for input message %n required by operation %n", $msghash.name.val, $.name);
	$.input = $msg;

	if (exists $p.output) {
	    $msghash = $.processNSValue($p.output."^attributes^");

	    $msg = $messages.($msghash.message.val);
	    if (!exists $msg)
		throw WSDL_ERROR, sprintf("missing definition for output message %n required by operation %n", $msghash.name.val, $.name);

	    $.output = $msg;
	}

	my any $op_ns = $.targetns;
	if (exists $op_ns && $op_ns !~ /\/$/)
	    $op_ns += "/";
	$.soapAction = exists $op_ns ? $op_ns + $.name : $.name;
    }

    setDocStyle(reference $idocmap) {
	$.docstyle = True;

	if (elements $.input.args > 1)
	    throw WSDL_ERROR, sprintf("don't know how to handle document-style messages for operation %n that has more than one top-level part (%n)",
					$.name, keys $.input.args);

	my any $arg = (keys $.input.args)[0];
	my any $element = $.input.args.$arg.element.name;
	$.request_name = $element;
	$idocmap.$element = $.input.args.$arg.element;
    }

    setTopLevelRequestElement(any $name) {
	$.request_name = $name;
    }

    string getTopLevelRequestName() {
	return strlen($.request_name) ? $.request_name : $.name;
    }

    #! serializes a request to an XML string for the operation
    /** @param $h the request to serialize
    @return a hash with keys:
    - \c body: XML string in the SOAP request format
    - \c hdr: hash of HTTP headers
    */
    hash serializeRequest(any $h) {
	# setup namespaces for SOAP envelope
	my hash $rh = $.soap12 ? WSDL::ENVELOPE_12_NS : WSDL::ENVELOPE_11_NS;

	my MultiPartRelatedMessage $mpm;
	# do we have mime/multipart input format?
	if (exists $.in.multipart)
	    $mpm = new MultiPartRelatedMessage();

	#printf("DEBUG: docstyle=%n\n", $.docstyle);
	if ($.docstyle)
	    $rh."soapenv:Envelope"."soapenv:Body" = $.input.serializeDocument($.in, $mpm, $h, $.targetns, $.usedocns);
	else
	    $rh."soapenv:Envelope"."soapenv:Body" = $.input.serialize($.in, $mpm, $.name, $h, $.targetns);

	my string $body = HAVE_LIBRARY_DEBUGGING ? makeFormattedXMLString($rh) : makeXMLString($rh);

	if (exists $mpm) {
	    $mpm.splicePart($body, sprintf("<%s>", $.in.body.parts), $.soap12 ? "application/soap+xml" : "text/xml");

	    my hash $rv = $mpm.getMsgAndHeaders();
	    if (strlen($.soapAction)) {
		if ($.soap12)
		    $rv.hdr."Content-Type" += sprintf(";action=%s", $.soapAction);
		$rv.hdr += ("SoapAction" : $.soapAction);
	    }

	    return $rv;
	}

	my string $ct;
	if ($.soap12) {
	    $ct = "application/soap+xml";
	    if (strlen($.soapAction))
		$ct += sprintf(";action=%s", $.soapAction);
	}
	else
	    $ct = "text/xml";

	my hash $rv = ( "hdr" : ( "Content-Type" : $ct ),
                        "body" : $body );

	if (strlen($.soapAction))
	    $rv.hdr += ( "SoapAction" : $.soapAction );

	return $rv;
    }

    #! serializes a SOAP response to an XML string for the operation
    /** @param $h the response to serialize
    @return a hash with keys:
    - \c body: XML string in the SOAP request format
    - \c hdr: hash of HTTP headers
    */
    hash serializeResponse(any $h) {
	# setup namespaces for SOAP envelope
	my hash $rh = $.soap12 ? WSDL::ENVELOPE_12_NS : WSDL::ENVELOPE_11_NS;

	my MultiPartRelatedMessage $mpm;
	# do we have mime/multipart output format?
	if (exists $.out.multipart)
	    $mpm = new MultiPartRelatedMessage();

	#printf("DEBUG: docstyle=%n\n", $.docstyle);
	if ($.docstyle)
	    $rh."soapenv:Envelope"."soapenv:Body" = $.output.serializeDocument($.out, $mpm, $h, $.targetns, $.usedocns);
	else
	    $rh."soapenv:Envelope"."soapenv:Body" = $.output.serialize($.out, $mpm, $.name, $h, $.targetns);

	my string $body = HAVE_LIBRARY_DEBUGGING ? makeFormattedXMLString($rh) : makeXMLString($rh);

	my string $ct = $.soap12 ? "application/soap+xml" : "text/xml";
	if (exists $mpm) {
	    $mpm.splicePart($body, sprintf("<%s>", $.out.body.parts), $ct);
	    return $mpm.getMsgAndHeaders();
	}

	return ( "hdr"  : ( "Content-Type" : $ct ),
		 "body" : $body );
    }

    private list processMultiRef(hash $body) {
	# setup multiRef lookup hash, if any are present
	my hash $mrh;
	if (exists $body.multiRef) {
	    foreach my any $mr in ($body.multiRef)
		$mrh.($mr."^attributes^".id) = $mr;

	    # resolve interior references to multiRefs
	    foreach my string $id in (keys $mrh) {
		foreach my string $key in (keys $mrh.$id) {
		    if ($key == "^attributes^")
			continue;

		    #printf("multiRef id=%n key=%n val=%n\n", $id, $key, $mrh.$id.$key);

		    if (type($mrh.$id.$key) == Type::List) {
			foreach my any $e in (\$mrh.$id.$key) {
			    my any $href = substr($e."^attributes^".href, 1);
			    if (exists $href) {
				if (!exists $mrh.$href)
				    throw "INVALID-MULTIREF", sprintf("multiRef id=%n does not exist", $href);
				$e = $mrh.$href;
			    }
			}
		    }
		    else if (type($mrh.$id.$key) == Type::Hash) {
			my any $href = substr($mrh.$id.$key."^attributes^".href, 1);
			if (exists $href) {
			    if (!exists $mrh.$href)
				throw "INVALID-MULTIREF", sprintf("multiRef id=%n does not exist", $href);
			    $mrh.$id.$key = $mrh.$href;
			}
		    }
		}
	    }

	    delete $body.multiRef;
	}
	#printf("mrh=%N\n", $mrh);
	#printf("operation=%N\n", $self);

	my any $msg;
	foreach my string $key in (keys $body) {
	    if ($key != "^attributes^") {
		$msg = $body.$key;
		break;
	    }
	}

	# remove namespace tags from element names
	WSDL::XSDBase::removeNS2(\$msg);

	return ($mrh, $msg);
    }

    #! parses a hash representing a parsed XML request (parsed with parseXMLAsData()) for the operation and returns the corresponding Qore data structure
    /** @param $o the parsed XML request (parsed with parseXMLAsData()) for the operation
    @return the Qore data structure corresponding to the request data
    */
    any deserializeRequest(hash $o) {
	WSDL::XSDBase::removeNS(\$o);
	WSDL::XSDBase::removeNS(\$o.Envelope);

	my hash $body = $o.Envelope.Body;

	my (any $mrh, any $msg) = $.processMultiRef($body);

	#my any $ns = $msg.".ns";
	$msg -= ".ns";

	return $.docstyle ? $.input.deserializeDocument($.types, $mrh, $msg) : $.input.deserialize($.types, $mrh, $msg);
    }

    #! parses a hash representing a parsed XML response (parsed with parseXMLAsData()) for the operation and returns the corresponding Qore data structure
    /** @param $o the parsed XML response (parsed with parseXMLAsData()) for the operation
    @return the Qore data structure corresponding to the response data
    */
    any deserializeResponse(hash $o) {
	WSDL::XSDBase::removeNS2(\$o);
	WSDL::XSDBase::removeNS2(\$o.Envelope);

	my hash $body = $o.Envelope.Body;

	my (any $mrh, any $msg) = $.processMultiRef($body);

	#my any $ns = $msg.".ns";
	$msg -= ".ns";

	# check for Soap Fault, if so raise an exception immediately with the fault info
	WSDL::XSDBase::removeNS2(\$body);

	if (exists $body.Fault) {
	    WSDL::XSDBase::removeNS(\$body.Fault);
	    if ($.soap12) {
		WSDL::XSDBase::removeNS(\$body.Fault.Code);
		WSDL::XSDBase::removeNS(\$body.Fault.Reason);
		my string $desc = sprintf("The following fault response was received from the server: code=%n", $body.Fault.Code.Value);
		my any $sc = $body.Fault.Code.Subcode;
		while (exists $sc) {
		    WSDL::XSDBase::removeNS(\$sc);
		    $desc += sprintf(", subcode=%n", $sc.Value);
		    $sc = $sc.Subcode;
		}
		foreach my any $rn in ($body.Fault.Reason.Text) {
		    $desc += sprintf(", text=%n", $rn);
		}

		throw "SOAP-SERVER-FAULT-RESPONSE", $desc, $body.Fault;
	    }
	    else {
		my string $desc = sprintf("The following fault response was received from the server: code=%n", $body.Fault.faultcode);
		if (exists $body.Fault.faultstring)
		    $desc += sprintf(", faultstring=%n", $body.Fault.faultstring);
		if (exists $body.Fault.desc)
		    $desc += sprintf(", desc=%n", $body.Fault.desc);

		throw "SOAP-SERVER-FAULT-RESPONSE", $desc, $body.Fault;
	    }
	}

	return $.docstyle ? $.output.deserializeDocument($.types, $mrh, $msg) : $.output.deserialize($.types, $mrh, $msg);
    }

    private hash processNSValue(hash $h) {
	foreach my string $k in (keys $h) {
	    my (any $ns, any $name) = $h.$k =~ x/(\w+):(\w+)/;
	    if (!exists $name)
		$h.$k.val = $h.$k;
	    else {
		$h.$k.ns = $ns;
		$h.$k.val = $name;
	    }
	}
	return $h;
    }

    #! returns True if the operations is a SOAP 1.2 operation
    /** @return True if the operations is a SOAP 1.2 operation
    */
    bool isSoap12() {
	return $.soap12;
    }

    #! returns the target namespace for the operation
    /** @return the target namespace for the operation
    */
    string getTargetNS() {
	return $.targetns;
    }

    setOutputMultipart(any $v) {
	$.out.multipart = $v;
	$.out.parts = ();
    }

    private parsePart(reference $msg, any $part) {
	WSDL::XSDBase::removeNS(\$part);
	#my any $a = $part."^attributes^";
	$part -= "^attributes^";

	if (exists $part.body) {
	    my any $pa = $part.body."^attributes^";
	    if ($pa.use != "literal")
		throw WSDL_ERROR, sprintf("unsupported body part without use=\"literal\": %n", $part.body);
	    $msg.body = $pa;
	}
	else if (exists $part.content) {
	    foreach my any $c in ($part.content) {
		my any $pa = $c."^attributes^";
		my any $name = $pa.part;
		if (!exists $name)
		    throw WSDL_ERROR, sprintf("unsupported content part without part attribute: %n", $c);
		my any $type = $pa.type;
		if (!exists $type)
		    throw WSDL_ERROR, sprintf("unsupported content part without type attribute: %n", $c);

		if (!exists $msg.parts.$name)
		    $msg.parts.$name = $type;
		else {
		    if (type($msg.parts.$name) != Type::List)
			$msg.parts.$name = list($msg.parts.$name);
		    $msg.parts.$name += $type;
		}
	    }
	}
	else
	    throw WSDL_ERROR, sprintf("cannot parse part: %n", $part);

	#printf("DEBUG: part: %N\nmsg=%N\n", $part, $msg);#exit();
    }

    addOutputPart(any $part) {
	if (!exists $.out.multipart)
	    throw WSDL_ERROR, sprintf("WSOperation::addOutputPart(): internal error: cannot add a part to a non-multipart message; part=%n", $part);

	$.parsePart(\$.out, $part);
    }

    setInputMultipart(any $v) {
	$.in.multipart = $v;
	$.in.parts = ();
    }

    addInputPart(any $part) {
	if (!exists $.in.multipart)
	    throw WSDL_ERROR, sprintf("WSOperation::addInputPart(): internal error: cannot add a part to a non-multipart message; part=%n", $part);

	$.parsePart(\$.in, $part);
    }
}

# web service message class
class WSDL::WSMessage inherits XSDNamedData {
    public {
        hash $.args;
        bool $.encoded = False;
    }
    constructor(any $m, any $element_map) : XSDNamedData(\$m) {
	#printf("DEBUG: WSMessage::constructor() m=%n element_map: %n\n", $m, $element_map);

	$.name = $m."^attributes^".name;
	foreach my any $p in ($m.part) {
	    my any $arg = $p."^attributes^";
	    if (exists $arg.element) {
		my (any $ns, any $name) = $arg.element =~ x/(\w+):(\w+)/;
		if (!exists $name)
		    $name = $arg.element;

		if (!exists $element_map.$name) {
		    #printf("DEBUG: WSMessage::constructor() message %n element %n (%n)\n", $.name, $arg.element, keys $element_map);
		    throw WSDL_ERROR, sprintf("message %n references unknown element %n", $.name, $name);
		}
		$.args.($arg.name).element = $element_map.$name;
	    }
	    else {
		$.args.($arg.name) = $arg;
		$.args.($arg.name).type = WSDL::XSDBase::doType($p."^attributes^".type);
	    }
	}
    }

    hash serialize(any $msginfo, any $mpm, any $name, any $h, any $targns) {
	my hash $rh;
	#printf("DEBUG: message %s: h=%n\n", $.name ,$h);

	foreach my string $k in (keys $.args) {
	    if (!exists $h.$k)
		throw SOAP_SERIALIZATION_ERROR, sprintf("missing message argument %n (got %n instead)", $k, keys $h);

	    my any $hv;
	    #printf("DEBUG: arg %n with %n\n", $k, $.args.$k);
	    if (exists $.args.$k.element)
		$hv = $.args.$k.element.serialize($h.$k, !$.encoded, True);
	    else
		$hv = $.args.$k.type.serialize($h.$k, !$.encoded, True);
	    #printf("DEBUG: arg %s got %n from %n (%n)\n", $k, $hv, $h.$k, exists $.args.$k.element ? $.args.$k.element : $.args.$k.type);

	    #printf("DEBUG: WSMessage::serialize() k=%n args=%n, parts=%n\n", $k, keys $.args, $msginfo.parts);
	    if (exists $msginfo.parts.$k) {
		my any $ct = $msginfo.parts.$k;
		if (type($ct) == Type::List)
		    $ct = shift $ct;
		$mpm.addPart($hv, sprintf("<%s>", $k), $ct);
		$hv."^attributes^".href = "cid:" + $k;
	    }

	    $rh.$k = $hv;
	}

	$rh."^attributes^" = ( "xmlns:ns1" : $targns );

	if ($.encoded)
	    $rh."^attributes^" +=
	    ( "soapenv:encodingStyle" : SOAP_ENCODING,
	      "xmlns:soapenc"         : SOAP_ENCODING );

	my hash $rvh.("ns1:" + $name) = $rh;

	return $rvh;
    }

    hash serializeDocument(any $msginfo, any $mpm, any $h, any $targns, any $force_ns) {
	my any $k = (keys $.args)[0];
	#printf("DEBUG: message %s: force_ns=%n args=%n h=%n\n", $.name, $force_ns, keys $.args, $h);

	my any $th = $.args.$k.element.serialize($h, !$.encoded, !$force_ns, $k, "<unknown>");

	my hash $rh."^attributes^" = ( "xmlns:ns1" : $targns );

	if ($.encoded)
	    $rh."^attributes^" +=
	    ( "soapenv:encodingStyle" : SOAP_ENCODING,
	      "xmlns:soapenc"         : SOAP_ENCODING );

	$rh.("ns1:" + $.args.$k.element.name) = $th;
	return $rh;
    }

    any deserialize(any $types, any $mrh, any $val) {
	my hash $ro;

	#my any $ns = $val.".ns";
	$val -= ".ns";

	foreach my string $key in (keys $.args) {
	    if (!exists $val.$key)
		throw SOAP_DESERIALIZATION_ERROR, sprintf("message %n is missing argument %n (%n)", $.name, $key, $val);

	    $ro.$key = exists $.args.$key.element
		? $.args.$key.element.deserialize($types, $mrh, $.getValue($mrh, $val.$key))
		: $.args.$key.type.deserialize($types, $mrh, $.getValue($mrh, $val.$key));
	}

	# if there is only one argument, return it directly
	if (elements $ro == 1)
	    return hash_values($ro)[0];
	return $ro;
    }

    any deserializeDocument(any $types, any $mrh, any $val) {
	my any $k = (keys $.args)[0];

	return $.args.$k.element.deserialize($types, $mrh, $val);
    }
}

# helper class for lazy name resolution
class WSDL::XSDLateResolverHelper {
    private { list $.l = (); }

    constructor() {
    }

    add(any $v) {
	$.l += $v;
    }

    list getList() {
	return $.l;
    }
}

# helper class to save namespaces in the WebService class, parses the imported definitions, and restores the namespace info on exit
class WSDL::XSDImportHelper {
    public {
        any $.ws;
        hash $.sp;
    }

    constructor(WebService $ws, any $xsd) {
	# save WebService object
	$.ws = $ws;

	# get old values of namespace attributes
	$.sp = $ws.("ns", "soap12");
	$ws -= ("ns", "soap12");
    }
    destructor() {
	$.ws -= ("ns", "soap12");
	$.ws += $.sp;
    }
}

#! main class representing a parsed WSDL file
/** This is the main class for handling SOAP communication and is based on a WSDL file
*/
class WSDL::WebService inherits XSDBase {
    public {
        string $.wsdl;
        hash $.ns;
        bool $.soap12 = False;
        hash $.base_type;
        hash $.services;
        list $.wsdl_services = ();
        hash $.idocmap;
        hash $.opmap;
        any $.binding;
        hash $.element_map;
        hash $.messages;
        hash $.types;
        bool $.usedocns = False;
        hash $.portType;
    }

    #! creates the WebService object
    /** @param $str the XML string representing the WSDL
    @param $opts an optional hash of options with the following possible keys:
    - \c http_client a HTTPClient object for retrieving data from import commands
    - \c http_headers a hash of optional HTTP header info to use when retrieving data from import commands
    */
    constructor(string $str, hash $opts = hash()) {
	my hash $h = parseXMLAsData($str);

	# save WSDL text
	$.wsdl = $str;

	# remove namespace (normally "wsdl:") prefix from keys if present
	WSDL::XSDBase::removeNS(\$h);
	WSDL::XSDBase::removeNS(\$h.definitions);
	$.getNSPrefixes($h.definitions."^attributes^");

	#printf("%N\n", $h.definitions.types);

	if (exists $h.definitions.types)
	    $.parseTypes($h.definitions.types, $opts.http_client instanceof HTTPClient ? $opts.http_client : NOTHING, $opts.http_headers);

	if (exists $h.definitions.message)
	    $.parseMessage($h.definitions.message);

	if (exists $h.definitions.portType)
	    $.parsePortType($h.definitions.portType);

	if (exists $h.definitions.binding)
	    $.parseBinding($h.definitions.binding);

	if (exists $h.definitions.service)
	    $.parseService($h.definitions.service);
    }

    #! returns a map of top-level element names to WSOperation objects
    /** @return a map of top-level element names to WSOperation objects
    */
    *hash getOperationMap(any $name) {
	if (!exists $name) {
	    if (elements $.wsdl_services > 2)
		throw "WSDL-GET-INPUT-OPERATION-MAP-ERROR", sprintf("no service argument passed to WSDL::getOperationMap() but the WSDL defines more than one service (%n)", keys ($.services - "port"));
	    #$name = $.wsdl_services[0];
	}
	else if (!inlist($name, ($.services - "port")))
	    throw "WSDL-GET-INPUT-OPERATION-MAP-ERROR", sprintf("service argument %n passed to WSDL::getOperationMap() is not defined by this WSDL (vaild services: %n)", $name, keys ($.services - "port"));

	return $.idocmap;
    }

    private getNSPrefixes(any $a) {
	#printf("DEBUG: getNSPrefixes() %n\n", $a);
	foreach my string $k in (keys $a) {
	    my any $ns = ($k =~ x/xmlns:(\w+)/)[0];

	    if (!exists $ns)
		continue;
	    $.ns.map.$ns = $a.$k;

	    if ($a.$k == XSD_NS)
		$.ns.xml_schema.$ns = True;

	    if ($a.$k == SOAP_12_NS)
		$.soap12 = True;
	}
	# "default" has to be quoted because it's a reserved word
	if (exists $a.xmlns)
	    $.ns."default" = $a.xmlns;
	$.ns.target = $a.targetNamespace;
    }

    private XSDBaseType getBaseType(any $t) {
	if (exists $.base_type.$t)
	    return $.base_type.$t;

	return $.base_type.$t = new XSDBaseType($t);
    }

    private any resolveType(hash $v) {
	if (exists $v.ns && $.ns.xml_schema.($v.ns))
	    return $.getBaseType($v.val);

	# find type
	if (!exists $.types.($v.val))
	    throw WSDL_ERROR, sprintf("cannot resolve type %s%s", exists $v.ns ? sprintf("%s:", $v.ns) : "", $v.val);

	return $.types.($v.val);
    }

    # parse XSD schema types
    private parseTypes(any $data, any $http_client, any $http_headers) {
	WSDL::XSDBase::removeNS(\$data);

	my any $sa = $data.schema."^attributes^";
	if ($sa.elementFormDefault == "qualified")
	    $.usedocns = True;
	foreach my any $schema in ($data.schema) {
	    WSDL::XSDBase::removeNS(\$schema);
	    #printf("DEBUG: WebService::parseTypes() schema=%N\n", $schema);

	    # process XSD import if present
	    if (exists $schema.import) {
		my any $a = $schema.import."^attributes^";
		# import file
		if (strlen($a.schemaLocation)) {
		    my any $xsd = WSDLLib::getFileFromURL($a.schemaLocation, "http", $http_client, $http_headers);

		    # parse imported XSD file and include types in our list
		    # also saves namespace definitions and restores on exit
		    my XSDImportHelper $xih($self, $xsd);

		    # parse XML to Qore data structure ignoring XML element order
		    $xsd = parseXMLAsData($xsd);

		    # parse namespace definitions in schema attributes
		    my list $kl = keys $xsd;
		    if (elements $kl != 1)
			throw WSDL_ERROR, sprintf("expecing a single element indicating an XSD schema in the imported file; got instead: %n", $kl);

		    # get schema member name
		    my any $sk = $kl[0];

		    # get namespace info in new schema
		    $.getNSPrefixes($xsd.$sk."^attributes^");

		    # verify that the top-level key indicates an XSD schema definition
		    my (any $ns, any $mem) = ($sk =~ x/^(\w+):(\w+)$/);
		    if (exists $ns && !$.ns.xml_schema.$ns)
			throw WSDL_ERROR, sprintf("expecing imported schema definition to be in XSD namespace %n, got %n=%n instead", XSD_NS, $ns, $.ns.map.$ns);

		    $.parseTypes($xsd);
		}
	    }

	    my XSDLateResolverHelper $unresolved();
	    foreach my any $st in ($schema.simpleType) {
		my XSDSimpleType $t($st, $.ns, $unresolved);
		$.types.($t.name) = $t;
	    }

	    foreach my any $ct in ($schema.complexType) {
		my XSDComplexType $t($ct, $.ns, $unresolved);
		$.types.($t.name) = $t;
	    }

	    # resolve types
	    foreach my any $e in ($unresolved.getList())
		$e.type = $.resolveType($e.type);

	    foreach my string $t in (keys $.types) {
		if ($.types.$t instanceof XSDComplexType) {
		    #foreach my any $e in (keys $.types.$t."elements")
		    #    if (!($.types.$t."elements".$e.type instanceof XSDData))
		    #	    $.types.$t."elements".$e.type = $.resolveType($.types.$t."elements".$e.type);

		    # process restriction info
		    if (exists $.types.$t.restriction) {
		    	my any $et = $.types.$t.restriction;
			if (!exists $.types.$et)
			    throw WSDL_ERROR, sprintf("complexType %s should be restricted from base type %n, but type %n is not defined", $t, $et, $et);
			# combine base type and new type
			$.types.$t.elements = $.types.$et.elements + $.types.$t.elements;
			printf("extended %s with %s (%n)\n", $t, $et, keys $.types.$t.elements);
		    }

		    # process extension info
		    if (exists $.types.$t.extension) {
			my any $et = $.types.$t.extension;
			if (!exists $.types.$et)
			    throw WSDL_ERROR, sprintf("complexType %s should be extended by %n, but type %n is not defined", $t, $et, $et);
			# combine base type and new type
			$.types.$t.elements = $.types.$et.elements + $.types.$t.elements;
			#printf("extended %s with %s (%n)\n", $t, $et, keys $.types.$t.elements);
		    }

		    # process array info
		    if (exists $.types.$t.array) {
			my any $et = $.types.$t.array.val;
			$.types.$t.array = new XSDArrayType(exists $.types.$et ? $.types.$et : $et);
		    }
		}
	    }

	    # make element map
	    foreach my any $el in ($schema.element) {
		my any $attr = $el."^attributes^";
		if (exists $attr.type) {
		    my any $t = WSDL::XSDBase::doType($attr.type, $.ns);
		    if (!($t instanceof XSDData)) {
			$t = $t.val;
			if (!exists $.types.$t)
			    throw WSDL_ERROR, sprintf("cannot resolve element %n type %n", $el, $t);
			#printf("DEBUG: adding element %n type %n\n", $attr.name, $t);
			$.element_map.($attr.name) = new WSDL::XSDElement(("^attributes^":("name":$attr.name)), $.types.$t, $unresolved);
		    }
		    else {
			#printf("DEBUG: adding element %n type %n\n", $attr.name, $t);
			$.element_map.($attr.name) = new WSDL::XSDElement(("^attributes^":("name":$attr.name)), $t, $unresolved);
		    }
		}
		else {
		    #printf("DEBUG: adding element %n\n", $attr.name);
		    $.element_map.($attr.name) = new WSDL::XSDElement($el, $.ns, $unresolved);
		}
	    }

	    # resolve types
	    foreach my any $e in ($unresolved.getList())
		if (!($e.type instanceof XSDData))
		    $e.type = $.resolveType($e.type);
	}
    }

    private parseMessage(any $message) {
	# parse messages
	foreach my any $m in ($message) {
	    my WSMessage $msg($m, $.element_map);
	    foreach my string $arg in (keys $msg.args) {
		#printf("DEBUG: WebService::parseMessage(): %n: %n\n", $arg, $msg);
		#printf("DEBUG: WebService::parseMessage(): %n: %n\n", $arg, $msg.args.$arg.type);
		if (exists $msg.args.$arg.type && !($msg.args.$arg.type instanceof XSDData))
		    $msg.args.$arg.type = $.resolveType($msg.args.$arg.type);
	    }
	    $.messages.($msg.name) = $msg;
	}
    }

    private parseService(any $svc) {
	WSDL::XSDBase::removeNS(\$svc);
	$.services.name = $svc."^attributes^".name;
	foreach my any $port in ($svc.port) {
	    WSDL::XSDBase::removeNS(\$port);
	    my string $name = $port."^attributes^".name;
	    $.services.port.$name = $port."^attributes^";
	    $.services.port.$name.address = $port.address."^attributes^".location;
	    $.services.port.$name.binding = WSDL::XSDBase::doType($.services.port.$name.binding);
	}
    }

    private parsePortType(any $data) {
	# setup list of services defined in this WSDL
        foreach my any $port in ($data) {
	    WSDL::XSDBase::removeNS(\$port);
	    #printf("DEBUG: portType=%N\n", $port);
	    my string $name = $port."^attributes^".name;
	    $.wsdl_services += $name;
	    foreach my any $p in ($port.operation) {
		my WSOperation $op($p, $.types, $.ns.target, $.messages, $.soap12, $.usedocns);
		$.portType.$name.operations.($op.name) = $op;
		#printf("DEBUG: %n registered operation %n\n", $name, $op.name);
		$.opmap.($op.name) = $op;
	    }
	}
    }

    private parseBinding(any $data) {
	WSDL::XSDBase::removeNS(\$data);
	$data += $data."^attributes^";
	delete $data."^attributes^";

	my bool $docstyle = False;
	if (exists $data.binding) {
	    $data.binding += $data.binding."^attributes^";
	    delete $data.binding."^attributes^";
	    if ($data.binding.style == "document")
		$docstyle = True;
	}

	foreach my any $ophash in ($data.operation) {
	    my string $name = $ophash."^attributes^".name;

	    my any $op = $.opmap.$name;
	    if (!exists $op)
		throw WSDL_ERROR, sprintf("binding for %n references unknown operation %n", $data.name, $name);

	    WSDL::XSDBase::removeNS(\$ophash);

	    my any $sa = $ophash.operation."^attributes^".soapAction;
	    if (exists $sa)
		$op.soapAction = $sa;

	    if ($docstyle || $ophash.operation."^attributes^".style == "document") {
		$op.setDocStyle(\$.idocmap);
	    }

	    WSDL::XSDBase::removeNS(\$ophash.input);
	    if (exists $ophash.input.body) {
		if ($ophash.input.body."^attributes^".use == "encoded") {
		    $op.input.encoded = True;
		    #printf("DEBUG: setting encoding = True for %n.%n input\n", $data.name, $name);
		}
	    }
	    else if (exists $ophash.input.multipartRelated) {
		$op.setInputMultipart(MultiPartMessage::MPT_RELATED);
		WSDL::XSDBase::removeNS(\$ophash.input.multipartRelated);

		if (!exists $ophash.input.multipartRelated.part)
		    throw WSDL_ERROR, sprintf("missing part definition(s) in input message definition for operation %n: %n", $name, $ophash);

		foreach my any $part in ($ophash.input.multipartRelated.part) {
		    WSDL::XSDBase::removeNS(\$part);
		    $op.addInputPart($part);
		}
	    }
	    else
		throw WSDL_ERROR, sprintf("cannot parse input message definition for operation %n: %n", $name, $ophash);

	    WSDL::XSDBase::removeNS(\$ophash.output);
	    if (exists $ophash.output.body) {
		if ($ophash.output.body."^attributes^".use == "encoded") {
		    $op.output.encoded = True;
		    #printf("DEBUG: setting encoding = True for %n.%n output\n", $data.name, $name);
		}
	    }
	    else if (exists $ophash.output.multipartRelated) {
		$op.setOutputMultipart(MultiPartMessage::MPT_RELATED);
		WSDL::XSDBase::removeNS(\$ophash.output.multipartRelated);

		if (!exists $ophash.output.multipartRelated.part)
		    throw WSDL_ERROR, sprintf("missing part definition(s) in output message definition for operation %n: %n", $name, $ophash);

		foreach my any $part in ($ophash.output.multipartRelated.part) {
		    WSDL::XSDBase::removeNS(\$part);
		    $op.addOutputPart($part);
		}
	    }
	    else
		throw WSDL_ERROR, sprintf("cannot parse output message definition for operation %n: %n", $name, $ophash);
	}

	$.binding = $data;
    }

    #! returns True if the WSDL describes a SOAP 1.2 service
    /** @return True if the WSDL describes a SOAP 1.2 service
    */
    bool isSoap12() {
	return $.soap12;
    }

    #! returns the XML string for the WSDL
    /** @return the XML string for the WSDL
    */
    string getWSDL() {
	return $.wsdl;
    }
}

Last Updated on Saturday, 25 December 2010 19:57