Menu
▾
▴
[qs-dev] Re: for review: client interface and sample [Part 1]
|
From: Ina C. <in...@st...> - 2001-02-22 06:57:12
|
Hi Fergus,
I've made the changes that you've pointed out this morning. However, there
is a bug (software error) inside `soap_interface.m' when I tried to abstract
out the code. I've included the error message and marked as XXX inside the
code. Can you please take a look at it? Sorry for the last minute rush.
ps. Since there is a limit on the size of the mail, I've separated
the diff into 2 parts.
Thanks,
Ina
<in...@st...>
========================================================================
Estimated hours taken: 38
Add an interface between server and client such that the client
can send messages in mercury types to the server.
/server/client_demo.m
new module showing how to call the soap_interface to send
messages to the SOAP server.
/server/options.m
add new options to handle command line arguments.
/server/soap_interface.m
new module - provide an interface for programmers to send messages
to the SOAP server.
/server/soap_test_methods.m
/server/web_methods.m
add a function to demonstrate the soap interface.
/server/soap.m
/server/server.m
modify some error handling code.
[Part 1]
Index: client_demo.m
===================================================================
RCS file: client_demo.m
diff -N client_demo.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ client_demo.m Wed Feb 21 22:48:27 2001
@@ -0,0 +1,184 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2001 The University Of Melbourne
+% This file may only be copied under the terms of the GNU General Public
+% License - see the file COPYING
+%---------------------------------------------------------------------------%
+%
+% File: client_demo.m
+% Author: inch
+%
+% This module provide a sample of how to call the SOAP interface to send
+% messages from the client to the SOAP server.
+%
+%---------------------------------------------------------------------------%
+
+:- module client_demo.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module http, options.
+
+:- import_module bool, char, exception, getopt.
+:- import_module int, list, require, std_util, string.
+
+:- import_module soap_interface.
+
+main -->
+ io__command_line_arguments(Args0),
+ { OptionOpts = option_ops(short_option, long_option, option_defaults)},
+ { getopt__process_options(OptionOpts, Args0, _Args, OptionsResult) },
+ (
+ { OptionsResult = ok(OptTable) },
+ { getopt__lookup_bool_option(OptTable, help, Help) },
+ (
+ { Help = yes },
+ options_help
+ ;
+ { Help = no },
+ { getopt__lookup_string_option(OptTable, host, Host) },
+ { getopt__lookup_int_option(OptTable, port, Port) },
+ { getopt__lookup_string_option(OptTable, method, Method) },
+ { getopt__lookup_string_option(OptTable, uri, URI) },
+ { getopt__lookup_string_option(OptTable, xml, XML) },
+ (
+ { XML = "" }
+ ->
+ (
+ { Method_Handler = get_method_handler(Method) }
+ ->
+ call(Method_Handler, OptTable, Host, Port, Method,
+ URI, Responses, Mesg)
+ ;
+ { error("Method not supported.") }
+ ),
+ display_mercury_response(Mesg, Responses)
+ ;
+ soap_call_xml_type(Host, Port, Method, URI, XML,
+ Responses),
+ io__write_string(Responses)
+ )
+ )
+ ;
+ { OptionsResult = error(OptionErrorString) },
+ io__write_string(OptionErrorString),
+ io__nl,
+ options_help
+ ).
+
+%---------------------------------------------------------------------------%
+
+:- type method_handler == pred(option_table(option), string, int, method,
+ uri, list(univ), string, io__state, io__state).
+:- inst method_handler == (pred(in, in, in, in, in, out, out, di, uo) is det).
+
+:- func get_method_handler(string) = method_handler.
+:- mode get_method_handler(in) = out(method_handler) is semidet.
+
+ % Choose a corresponding predicate for a particular method.
+get_method_handler("Hello") = handle_Hello.
+get_method_handler("GetStockPrice") = handle_GetStockPrice.
+get_method_handler("Add3Ints") = handle_Add3Ints.
+get_method_handler("PurchaseBook") = handle_PurchaseBook.
+
+%---------------------------------------------------------------------------%
+
+:- pred handle_Hello(option_table(option), string, int, method, uri,
+ list(univ), string, io__state, io__state).
+:- mode handle_Hello(in, in, in, in, in, out, out, di, uo) is det.
+
+handle_Hello(_OptTable, Host, Port, Method, URI, Responses, Mesg) -->
+ soap_call_mercury_type(Host, Port, Method, URI, [], Responses),
+ { Mesg = "" }.
+
+%---------------------------------------------------------------------------%
+
+:- pred handle_GetStockPrice(option_table(option), string, int, method, uri,
+ list(univ), string, io__state, io__state).
+:- mode handle_GetStockPrice(in, in, in, in, in, out, out, di, uo) is det.
+
+handle_GetStockPrice(OptTable, Host, Port, Method, URI, Responses, Mesg) -->
+ { getopt__lookup_int_option(OptTable, int, Int) },
+ (
+ { Int = -1 }
+ ->
+ io__write_string("Parameter not supplied.\n"),
+ io__write_string("Program terminated.\n"),
+ { Mesg = "" },
+ { Responses = [] }
+ ;
+ soap_call_mercury_type(Host, Port, Method, URI,
+ [univ(Int)], Responses),
+ { Mesg = "Stockprice = " }
+ ).
+
+%---------------------------------------------------------------------------%
+
+:- pred handle_Add3Ints(option_table(option), string, int, method, uri,
+ list(univ), string, io__state, io__state).
+:- mode handle_Add3Ints(in, in, in, in, in, out, out, di, uo) is det.
+
+handle_Add3Ints(OptTable, Host, Port, Method, URI, Responses, Mesg) -->
+ { getopt__lookup_int_option(OptTable, add1, X) },
+ { getopt__lookup_int_option(OptTable, add2, Y) },
+ { getopt__lookup_int_option(OptTable, add3, Z) },
+ (
+ % If some of the arguments are not supplied,
+ % they are treated as 0. Only when all
+ % arguments are not supplied, the program
+ % terminates.
+ { X = 0 }, { Y = 0 }, { Z = 0 }
+ ->
+ io__write_string("Parameter not supplied.\n"),
+ io__write_string("Program terminated.\n"),
+ { Mesg = "" },
+ { Responses = [] }
+ ;
+ soap_call_mercury_type(Host, Port, Method, URI,
+ [univ(X), univ(Y), univ(Z)], Responses),
+ { Mesg = "Add3Ints = " }
+ ).
+%---------------------------------------------------------------------------%
+
+:- pred handle_PurchaseBook(option_table(option), string, int, method, uri,
+ list(univ), string, io__state, io__state).
+:- mode handle_PurchaseBook(in, in, in, in, in, out, out, di, uo) is det.
+
+handle_PurchaseBook(OptTable, Host, Port, Method, URI, Responses, Mesg) -->
+ { getopt__lookup_string_option(OptTable, title, Title) },
+ { getopt__lookup_string_option(OptTable, author, Author)},
+ (
+ { Title = "" }
+ ->
+ io__write_string("Title not supplied.\n"),
+ io__write_string("Program terminated.\n"),
+ { Mesg = "" },
+ { Responses = [] }
+ ;
+ { Author = "" }
+ ->
+ io__write_string("Author not supplied.\n"),
+ io__write_string("Program terminated.\n"),
+ { Mesg = "" },
+ { Responses = [] }
+ ;
+ soap_call_mercury_type(Host, Port, Method, URI,
+ [univ(Title), univ(Author)], Responses),
+ { Mesg = "" }
+ ).
+
+%---------------------------------------------------------------------------%
+:- pred display_mercury_response(string::in, list(univ)::in, io__state::di,
+ io__state::uo) is det.
+
+display_mercury_response(Message, Responses) -->
+ io__write_string(Message),
+ list__foldl((pred(X::in, di, uo) is det -->
+ write(univ_value(X)), nl),
+ Responses).
+
+
Index: options.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/options.m,v
retrieving revision 1.1
diff -u -r1.1 options.m
--- options.m 2000/11/27 10:02:58 1.1
+++ options.m 2001/02/22 06:48:27
@@ -26,6 +26,17 @@
; port
; root
+ % Client options
+ ; method
+ ; uri
+ ; xml
+ ; int % for GetStockPrice
+ ; add1 % for Add3Ints
+ ; add2 % for Add3Ints
+ ; add3 % for Add3Ints
+ ; title % for PurchaseBook
+ ; author % for PurchaseBook
+
% Miscellaneous Options
; help.
@@ -63,25 +74,55 @@
option_default(port, int(8080)).
option_default(root, string("/var/www")).
+ % General client options
+option_default(method, string("")).
+option_default(uri, string("no value")).
+ % for uri, empty string means that the intent of the
+ % SOAP message is provided by the HTTP Request-URI
+ % whereas no value means that there is no indication
+ % of the intent of the message.
+option_default(xml, string("")).
+option_default(int, int(-1)).
+option_default(add1, int(0)).
+option_default(add2, int(0)).
+option_default(add3, int(0)).
+option_default(title, string("")).
+option_default(author, string("")).
+
% Miscellaneous Options
option_default(help, bool(no)).
% please keep this in alphabetic order
+short_option('a', author).
% short_option('f', config_file).
short_option('h', help).
short_option('H', host).
+short_option('i', int).
+short_option('m', method).
short_option('P', port).
short_option('R', root).
+short_option('t', title).
+short_option('u', uri).
short_option('v', verbose).
short_option('V', very_verbose).
+short_option('x', xml).
% long_option("config-file", config_file).
+long_option("add1", add1).
+long_option("add2", add2).
+long_option("add3", add3).
+long_option("author", author).
long_option("help", help).
long_option("host", host).
+long_option("int", int).
+long_option("method", method).
long_option("port", port).
long_option("root", root).
+long_option("title", title).
+long_option("uri", uri).
long_option("verbose", verbose).
long_option("very-verbose", very_verbose).
+long_option("xml", xml).
options_help -->
io__write_strings([
@@ -99,6 +140,26 @@
"\t\tWhich port quicksilver listens on.\n",
"\t-R, --root\n",
"\t\tThe root directory for the html files to be served.\n",
+
+ "\nClient Options:\n",
+ "\t-m, --method\n",
+ "\t\tMethod Name to be called.\n",
+ "\t-u, --uri\n",
+ "\t\tURI of SOAPAction header.\n",
+ "\t-x, --xml\n",
+ "\t\tAn XML message for the RPC.\n",
+ "\t-i, --int\n",
+ "\t\tStocknum for GetStockPrice.\n",
+ "\t--add1\n",
+ "\t\tFirst integer parameter for Add3Ints.\n",
+ "\t--add2\n",
+ "\t\tSecond integer parameter for Add3Ints.\n",
+ "\t--add3\n",
+ "\t\tThird integer parameter for Add3Ints.\n",
+ "\t-a, --author surname,firstname\n",
+ "\t\tAuthor of the book.\n",
+ "\t-t, --title\n",
+ "\t\tTitle of the book.\n",
"\nVerbosity Options:\n",
"\t-v, --verbose\n",
Index: server.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/server.m,v
retrieving revision 1.6
diff -u -r1.6 server.m
--- server.m 2001/02/09 05:15:42 1.6
+++ server.m 2001/02/22 06:48:27
@@ -420,26 +420,29 @@
{ Request^cmd = post },
(
{ Request^body = yes(Body) } ,
- parse_soapmessage(Body, NsBody),
- % XXX parse_soapmessage calls error/1 when failed
- % should change to response with http code = 415
-
- { get_procedure_call(NsBody, Proc) },
- write(Proc), nl, nl,
+ parse_soapmessage(Body, NsBody, ErrMesg),
+ (
+ { ErrMesg = yes(Mesg) },
+ { HttpCode = 415 },
+ { Result = Mesg },
+ { ResBody = no_body }
+ ;
+ { ErrMesg = no },
+ { get_procedure_call(NsBody, Proc) },
- { make_web_request(NsBody, Proc, WebRequest) },
- write(WebRequest), nl, nl,
+ { make_web_request(NsBody, Proc, WebRequest) },
- load_dynamic_library(uri_to_filename(Request^uri),
+ load_dynamic_library(uri_to_filename(Request^uri),
WebRequest, Result, HttpCode, ErrorFlag),
- (
+ (
{ ErrorFlag = no },
{ generate_response_body(NsBody, Proc,
Result, ResBody0) },
{ ResBody = string_body(ResBody0) }
- ;
+ ;
{ ErrorFlag = yes },
{ ResBody = no_body }
+ )
)
;
% 200 - 299 is client request successful
Index: soap.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/soap.m,v
retrieving revision 1.2
diff -u -r1.2 soap.m
--- soap.m 2001/02/09 05:15:42 1.2
+++ soap.m 2001/02/22 06:48:27
@@ -14,13 +14,14 @@
:- module soap.
:- interface.
-:- import_module io, string.
+:- import_module io, std_util, string.
:- import_module xml, xml:ns.
:- import_module web_methods.
% Translates SOAP message to namespace aware SOAP message.
-:- pred parse_soapmessage(string, ((xml:ns):nsDocument), io__state, io__state).
-:- mode parse_soapmessage(in, out, di, uo) is det.
+:- pred parse_soapmessage(string, ((xml:ns):nsDocument), maybe(string),
+ io__state, io__state).
+:- mode parse_soapmessage(in, out, out, di, uo) is det.
% Retrieves method name from the SOAP message.
:- pred get_procedure_call(nsDocument, nsElement).
@@ -50,7 +51,7 @@
% Parses soap message.
% NsDoc is namespace aware soap message.
-parse_soapmessage(SoapMessage, NsDoc) -->
+parse_soapmessage(SoapMessage, NsDoc, ErrorMesg) -->
pstate(mkEntity(SoapMessage), mkEncoding(utf8), init),
io((pred(Dirs0::out, di, uo) is det -->
get_environment_var("XML_DIRS", MStr),
@@ -76,14 +77,16 @@
finish(Res),
(
{ Res = ok((_, Doc)) },
- { nsTranslate(Doc, NsDoc) }
+ { nsTranslate(Doc, NsDoc) },
+ { ErrorMesg = no }
;
% XXX instead of error, should change to response
% with http code 415 Unsupported Media Type
{ Res = error(Err) },
{ string__append("parse_soapmessage failed: ", Err, ErrMsg) },
- { error(ErrMsg) }
+ { ErrorMesg = yes(ErrMsg) },
+ { NsDoc = nsDoc([], 0, [], array([comment("")])) }
).
Index: soap_interface.m
===================================================================
RCS file: soap_interface.m
diff -N soap_interface.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ soap_interface.m Wed Feb 21 22:48:27 2001
@@ -0,0 +1,458 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne
+% This file may only be copied under the terms of the GNU General Public
+% License - see the file COPYING
+%---------------------------------------------------------------------------%
+%
+% File: soap_inteface.m
+% Author: inch
+%
+% Reference:
+% http://www.w3.org/TR/SOAP
+%
+% This module provide an interface for programmers to send messages
+% to the SOAP server. It will provide as basic functionality the
+% ability to do RPC over SOAP. The hard-coded XML encoding for
+% Mercury datatypes (the same encoding as the SOAP server currently
+% expects) will be used to encode the RPC calls.
+%
+%---------------------------------------------------------------------------%
+
+:- module soap_interface.
+:- interface.
+:- import_module io, list, std_util, string.
+:- import_module tcp.
+
+:- type method == string.
+:- type uri == string.
+:- type xml == string.
+
+ % Sends messages (in mercury types) to the SOAP server and returns
+ % the response (in mercury types).
+ % host and port specifies the host and port number that the client
+ % connects to; method specifies the method name of the RPC;
+ % uri indicates the intent of the SOAP HTTP request (see reference
+ % section 6.1); lists of univ are the input parameters of RPC and
+ % the output responses from the server.
+
+:- pred soap_call_mercury_type(host::in, port::in, method::in,
+ uri::in, list(univ)::in, list(univ)::out,
+ io__state::di, io__state::uo) is det.
+
+ % Sends messages (in XML format) to the SOAP server and returns
+ % the response (in XML format).
+ % host and port specifies the host and port number that the client
+ % connects to; method specifies the method name of the RPC;
+ % uri indicates the intent of the SOAP HTTP request (see reference
+ % section 6.1); xmls are the message sends to the server and
+ % the response receives from it.
+
+:- pred soap_call_xml_type(host::in, port::in, method::in, uri::in,
+ xml::in, xml::out, io__state::di, io__state::uo) is det.
+
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module int, require.
+:- import_module stream.
+
+
+soap_call_mercury_type(Host, Port, Method, SOAPuri, Parameters,
+ Responses) -->
+ { generate_request(Host, Method, SOAPuri, Parameters, Request) },
+ tcp__connect(Host, Port, Result),
+ (
+ { Result = ok(TCP_Connect) },
+ service_connection(TCP_Connect, Request, XMLResponse)
+ ;
+ { Result = error(String) },
+ { error(String) }
+ ),
+ tcp__shutdown(TCP_Connect),
+ (
+ { Decode_Handler = decode_response(Method) },
+ { call(Decode_Handler, XMLResponse, Responses) }
+ ;
+ { error("Soap_call_mercury_type: Method not supported") }
+ ).
+
+
+ % Choose a corresponding predicate to decode response for
+ % a particular method.
+
+:- type decode_handler == pred(string, list(univ)).
+:- inst decode_handler == (pred(in, out) is det).
+
+:- func decode_response(string) = decode_handler.
+:- mode decode_response(in) = out(decode_handler) is semidet.
+
+ % XXX Add a handler for the new method here.
+
+decode_response("Hello") = decode_Hello_response.
+decode_response("GetStockPrice") = decode_SP_response.
+decode_response("Add3Ints") = decode_AddInt_response.
+decode_response("PurchaseBook") = decode_PB_response.
+
+
+%--------------------------------------------------------------------------%
+
+soap_call_xml_type(Host, Port, _Method, SOAPuri, XMLMesg, XMLResponse) -->
+ { generate_xml_request(Host, SOAPuri, XMLMesg, Request) },
+ tcp__connect(Host, Port, Result),
+ (
+ { Result = ok(TCP_Connect) },
+ service_connection(TCP_Connect, Request, Response)
+ ;
+ { Result = error(String) },
+ { error(String) }
+ ),
+ tcp__shutdown(TCP_Connect),
+ { retrieve_body(Response, XMLResponse) }.
+
+
+:- pred generate_xml_request(host::in, uri::in, xml::in, string::out)
+ is det.
+
+generate_xml_request(Host, SOAPuri, XMLMesg, Request) :-
+ generate_xml_body(XMLMesg, Body),
+ string__length(Body, Length),
+ generate_header(Host, Length, SOAPuri, Header),
+ Request = insert_cr(Header) ++ Body.
+
+:- pred generate_xml_body(xml::in, string::out) is det.
+
+generate_xml_body(XMLMesg, SOAPBody) :-
+ SOAPBody = "<Envelope><Body>" ++ XMLMesg ++ "</Body></Envelope>".
+
+:- pred retrieve_body(string::in, xml::out) is det.
+
+retrieve_body(Response, Body) :-
+ (
+ string__sub_string_search(Response, "\r\n<", Pos)
+ ->
+ string__length(Response, Length),
+ string__right(Response, Length - Pos, Body)
+ ;
+ error("error in retrieving body")
+ ).
+
+%-------------------------------------------------------------------------%
+
+ % Generates HTTP header information and SOAP message in the body.
+:- pred generate_request(host, method, uri, list(univ), string).
+:- mode generate_request(in, in, in, in, out) is det.
+
+generate_request(Host, Method, SOAPuri, Parameters, Request) :-
+ /*
+ (
+ Body_Handler = generate_body(Method),
+ call(Body_Handler, Method, Parameters, Body)
+
+ */
+ (
+ Method = "Hello"
+ ->
+ generate_Hello_body(Method, Parameters, Body)
+ ;
+ Method = "GetStockPrice"
+ ->
+ generate_SP_body(Method, Parameters, Body)
+ ;
+ Method = "Add3Ints"
+ ->
+ generate_AddInt_body(Method, Parameters, Body)
+ ;
+ Method = "PurchaseBook"
+ ->
+ generate_PB_body(Method, Parameters, Body)
+ ;
+ error("Generate message body failed.\n")
+ ),
+ string__length(Body, Length),
+ generate_header(Host, Length, SOAPuri, Header),
+ Request = insert_cr(Header) ++ Body.
+
+% XXX if I switch to use higher order instead, the following error occur
+%
+% Uncaught exception:
+% Software Error: Sorry, not implemented: determinism inference for
+% higher-order predicate terms
+% Stack dump not available in this grade.
+
+
+:- type body_handler == pred(string, list(univ), string).
+:- inst body_handler == (pred(in, in, out) is det).
+
+/*
+:- func generate_body(string) = body_handler.
+:- mode generate_body(in) = out(body_handler) is semidet.
+
+ % XXX Add a body handler for the new method here.
+
+generate_body("Hello") = generate_Hello_body.
+generate_body("GetStockPrice") = generate_SP_body.
+generate_body("Add3Ints") = generate_AddInt_body.
+generate_body("PurchaseBook") = generate_PB_body.
+
+*/
+
+%-------------------------------------------------------------------------%
+% Hello
+%-------------------------------------------------------------------------%
+
+ % Generates SOAP message.
+ % Hello pred has no input.
+:- pred generate_Hello_body(string, list(univ), string).
+:- mode generate_Hello_body(in, in, out).
+
+generate_Hello_body(MethodName, _Parameters, Body) :-
+ insert_envelope(MethodName, "", Body).
+
+:- pred decode_Hello_response(string::in, list(univ)::out) is det.
+
+decode_Hello_response(XMLResponse, Responses) :-
+ (
+ string__sub_string_search(XMLResponse, "<output>", Start),
+ string__sub_string_search(XMLResponse, "</output>", End)
+ ->
+ string__left(XMLResponse, End, Response0),
+ TagLength = 8, % <output>
+ string__right(Response0, End-Start-TagLength, Response1),
+ Responses = [univ(Response1)]
+ ;
+ error("decode error")
+ ).
+
+%--------------------------------------------------------------------------%
+% Add3Ints
+%--------------------------------------------------------------------------%
+
+ % Generate message body for Add3Ints.
+:- pred generate_AddInt_body(method::in, list(univ)::in, string::out)
+ is det.
+
+generate_AddInt_body(Method, Parameters, Body) :-
+ list__map(create_xml_parameter, Parameters, XMLList),
+ string__append_list(XMLList, XMLString),
+ insert_envelope(Method, XMLString, Body).
+
+:- pred create_xml_parameter(univ::in, string::out) is det.
+
+create_xml_parameter(ParameterAsUniv, ParameterAsXML) :-
+ det_univ_to_type(ParameterAsUniv, ParameterAsInt),
+ string__int_to_string(ParameterAsInt, ParameterAsString),
+ ParameterAsXML = "<int>" ++ ParameterAsString ++ "</int>".
+
+:- pred decode_AddInt_response(string::in, list(univ)::out) is det.
+
+decode_AddInt_response(XMLResponse, Responses) :-
+ (
+ string__sub_string_search(XMLResponse, "<result>", Start),
+ string__sub_string_search(XMLResponse, "</result>", End)
+ ->
+ string__left(XMLResponse, End, Response0),
+ TagLength = 8, % <result>
+ string__right(Response0, End-Start-TagLength, Response1),
+ (
+ string__to_int(Response1, ResponseAsInt)
+ ->
+ Responses = [univ(ResponseAsInt)]
+ ;
+ error("decode error")
+ )
+ ;
+ error("decode error")
+ ).
+
+%--------------------------------------------------------------------------%
+% GetStockPrice
+%--------------------------------------------------------------------------%
+
+ % Generates SOAP message body for GetStockPrice.
+ % XXX assume no namespace and client has a copy of the schema
+ % used in the server side to encode mercury types.
+:- pred generate_SP_body(method, list(univ), string).
+:- mode generate_SP_body(in, in, out).
+
+ % schema for GetStockPrice:
+ % <element name="stocknum" type="xsd:int">
+
+generate_SP_body(MethodName, Parameters, Body) :-
+ % since client knows that this function takes in only
+ % one parameter, there is no need to call list_foldl to
+ % translate the parameters.
+ list__index1_det(Parameters, 1, Parameter),
+ generate_SP_param(Parameter, ParamAsString),
+ insert_envelope(MethodName, ParamAsString, Body).
+
+
+:- pred generate_SP_param(univ, string).
+:- mode generate_SP_param(in, out) is det.
+
+generate_SP_param(ParamAsUniv, Tag) :-
+ det_univ_to_type(ParamAsUniv, ParamAsValue),
+ string__int_to_string(ParamAsValue, ParamAsString),
+ Tag = "<stocknum>" ++ ParamAsString ++ "</stocknum>".
+
+:- pred decode_SP_response(string::in, list(univ)::out) is det.
+
+decode_SP_response(XMLResponse, Responses) :-
+ (
+ string__sub_string_search(XMLResponse, "<price>", Start),
+ string__sub_string_search(XMLResponse, "</price>", End)
+ ->
+ string__left(XMLResponse, End, Response0),
+ TagLength = 7, % <price>
+ string__right(Response0, End - Start - TagLength, Response1),
+ (
+ string__to_int(Response1, ResponseAsInt)
+ ->
+ Response = ResponseAsInt
+ ;
+ error("decode error")
+ ),
+ Responses = [univ(Response)]
+ ;
+ error("decode error")
+ ).
+
+%-------------------------------------------------------------------------%
+% PurchaseBook
+%-------------------------------------------------------------------------%
+
+ % Generate message body for PurchaseBook.
+:- pred generate_PB_body(method::in, list(univ)::in, string::out) is det.
+generate_PB_body(Method, Parameters, Body) :-
+ generate_PB_parameters(Parameters, ParameterString0),
+ ParameterString = "<book>" ++ ParameterString0 ++ "</book>",
+ insert_envelope(Method, ParameterString, Body).
+
+:- pred generate_PB_parameters(list(univ)::in, string::out) is det.
+
+generate_PB_parameters(ParamList, Body):-
+ list__index1_det(ParamList, 1, TitleAsUniv),
+ det_univ_to_type(TitleAsUniv, TitleAsString),
+ Title = "<title>" ++ TitleAsString ++ "</title>",
+
+ list__index1_det(ParamList, 2, AuthorAsUniv),
+ det_univ_to_type(AuthorAsUniv, AuthorAsString),
+ (
+ string__sub_string_search(AuthorAsString, ",", Pos)
+ ->
+ string__left(AuthorAsString, Pos, Surname),
+ string__length(AuthorAsString, Length),
+ string__right(AuthorAsString, Length - (Pos + 1), Firstname)
+ ;
+ Surname = AuthorAsString,
+ Firstname = " "
+ ),
+ Author = "<author>" ++
+ "<surname>" ++ Surname ++ "</surname>" ++
+ "<firstname>" ++ Firstname ++ "</firstname>" ++
+ "</author>",
+ Body = Title ++ Author.
+
+:- pred decode_PB_response(string::in, list(univ)::out) is det.
+
+decode_PB_response(XMLResponse, Responses) :-
+ (
+ string__sub_string_search(XMLResponse, "<comment>", Start),
+ string__sub_string_search(XMLResponse, "</comment>", End)
+ ->
+ string__left(XMLResponse, End, Comment0),
+ TagLength = 9, % <comment>
+ string__right(Comment0, End - Start - TagLength, Comment1),
+ Comment = [univ(Comment1)]
+ ;
+ Comment = []
+ ),
+ (
+ string__sub_string_search(XMLResponse, "<price>", Start1),
+ string__sub_string_search(XMLResponse, "</price>", End1)
+ ->
+ string__left(XMLResponse, End1, Price0),
+ TagLength1 = 7, % <price>
+ string__right(Price0, End1 - Start1 - TagLength1, Price1),
+ Price = [univ("Price = " ++ Price1)]
+ ;
+ Price = []
+ ),
+ list__append(Comment, Price, Responses).
+
+
+%-------------------------------------------------------------------------%
+% Shared functions
+%-------------------------------------------------------------------------%
+
+ % Generates HTTP header.
+:- pred generate_header(host::in, int::in, uri::in, string::out) is det.
+
+generate_header(Host, Length, SOAPuri, Headers) :-
+ Header1 = "POST /libsoap_test_methods.so HTTP/1.1",
+ Header2 = "Host: " ++ Host,
+ Header3 = "Content-Type: text/xml",
+ string__int_to_string(Length, LengthAsString),
+ Header4 = "Content-Length: " ++ LengthAsString,
+ (
+ SOAPuri = "no value"
+ ->
+ Header5 = "SOAPAction:"
+ ;
+ Header5 = "SOAPAction: " ++ SOAPuri
+ ),
+ Headers = insert_cr(Header1) ++ insert_cr(Header2) ++
+ insert_cr(Header3) ++ insert_cr(Header4) ++
+ insert_cr(Header5).
+
+ % Generate SOAP Envelope
+
+:- pred insert_envelope(string::in, string::in, string::out).
+insert_envelope(MethodName, Parameters, Body) :-
+ Body = "<Envelope><Body><" ++ MethodName ++ ">" ++
+ Parameters ++ "</" ++ MethodName ++ ">" ++
+ "</Body></Envelope>".
+
+ % Insert carriage return into the line.
+:- func insert_cr(string) = string.
+insert_cr(Line) = Line ++ "\r\n".
+
+%------------------------------------------------------------------------%
+
+ % Sends request to server using HTTP and receives response
+ % from server.
+:- pred service_connection(tcp::in, string::in, string::out,
+ io__state::di, io__state::uo) is det.
+
+service_connection(TCP, Request, Response) -->
+ send_request(TCP, Request),
+ read_response(TCP, Response).
+
+ % Sends the request to the server side.
+:- pred send_request(S, string, io__state, io__state) <= stream__output(S).
+:- mode send_request(in, in, di, uo) is det.
+
+send_request(S, Requests) -->
+ stream__write_string(S, Requests).
+
+ % Reads responses from server.
+:- pred read_response(S, string, io__state, io__state) <= stream__input(S).
+:- mode read_response(in, out, di, uo) is det.
+
+read_response(S, Response) -->
+ stream__read_line(S, LineResult),
+ (
+ { LineResult = ok(Line) },
+ { string__from_char_list(Line, String) },
+ { Response = String ++ Response0 },
+ read_response(S, Response0)
+ ;
+ { LineResult = eof },
+ { Response = "" }
+ ;
+ { LineResult = error(Error) },
+ { error(string__format("read_response: %s.", [s(Error)])) }
+ ).
+
+%-------------------------------------------------------------------------%
|
