|
From: Ina C. <in...@st...> - 2001-02-19 00:31:10
|
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=20
Estimated hours taken: 30=20
Add an interface between server and client such that the client
can send messages in mercury types to the server.
=20
/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
=09add a function to demonstrate the soap interface
Index: client_demo.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: client_demo.m
diff -N client_demo.m
--- /dev/null=09Mon Dec 11 17:26:27 2000
+++ client_demo.m=09Sun Feb 18 16:23:17 2001
@@ -0,0 +1,130 @@
+%-------------------------------------------------------------------------=
--%
+% 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 -->
+=09io__command_line_arguments(Args0),
+=09{ OptionOpts =3D option_ops(short_option, long_option, option_defaults)=
},
+=09{ getopt__process_options(OptionOpts, Args0, _Args, OptionsResult) },
+=09(
+=09 { OptionsResult =3D ok(OptTable) },
+=09 { getopt__lookup_bool_option(OptTable, help, Help) },
+=09 (
+=09=09{ Help =3D yes },
+=09=09options_help
+=09 ;
+=09=09{ Help =3D no },
+=09=09{ getopt__lookup_string_option(OptTable, host, Host) },
+=09=09{ getopt__lookup_int_option(OptTable, port, Port) },
+=09=09{ getopt__lookup_string_option(OptTable, method, Method) },
+=09=09{ getopt__lookup_string_option(OptTable, uri, URI) },
+=09=09{ getopt__lookup_string_option(OptTable, xml, XML) },
+=09=09(=20
+=09=09 { XML =3D "" }
+=09=09->
+=09=09 (
+=09=09=09{ Method =3D "GetStockPrice" }
+=09=09 ->
+=09=09=09{ getopt__lookup_int_option(OptTable, int, Int) },
+=09=09=09(
+=09=09=09=09{ Int =3D -1 }
+=09=09=09->
+=09=09=09=09io__write_string("Parameter not supplied.\n"),
+=09=09=09=09io__write_string("Program terminated.\n")
+=09=09=09;
+=09=09=09=09soap_call_mercury_type(Host, Port, Method,=20
+=09=09=09=09 URI, [univ(Int)], Responses),
+=09=09=09=09display_mercury_response("Stockprice =3D ",=20
+=09=09=09=09=09Responses)
+=09=09=09)
+=09=09 ;
+=09=09=09{ Method =3D "Hello" }
+=09 =09 ->
+=09=09=09soap_call_mercury_type(Host, Port, Method,
+=09=09=09=09URI, [], Responses),
+=09=09=09display_mercury_response("", Responses)
+=09=09 ;
+=09=09=09{ Method =3D "Add3Ints" }
+=09=09 ->
+=09=09=09{ getopt__lookup_int_option(OptTable, add1, X) },
+=09=09=09{ getopt__lookup_int_option(OptTable, add2, Y) },
+=09=09=09{ getopt__lookup_int_option(OptTable, add3, Z) },
+=09=09=09(
+=09=09=09=09% If some of the arguments are not supplied,=20
+=09=09=09=09% they are treated as 0. Only when all=20
+=09=09=09=09% arguments are not supplied, the program
+=09=09=09=09% terminates.
+=09=09=09=09{ X =3D 0 }, { Y =3D 0 }, { Z =3D 0 }=20
+=09=09=09->
+=09=09=09=09io__write_string("Parameter not supplied.\n"),
+=09=09=09=09io__write_string("Program terminated.\n")
+=09=09=09;
+=09=09=09=09soap_call_mercury_type(Host, Port, Method,=20
+=09=09=09=09 URI, [univ(X), univ(Y), univ(Z)], =20
+=09=09=09=09 Responses),
+=09=09=09=09display_mercury_response("Add3Ints =3D ",=20
+=09=09=09=09=09Responses)
+=09=09=09)
+=09=09 ;=09
+=09=09=09{ Method =3D "PurchaseBook" }
+=09=09 ->
+=09=09=09{ getopt__lookup_string_option(OptTable, title, T) },
+=09=09=09{ getopt__lookup_string_option(OptTable, author, A)},
+=09=09=09soap_call_mercury_type(Host, Port, Method, URI,
+=09=09=09=09[univ(T), univ(A)], Responses),
+=09=09=09display_mercury_response("", Responses)
+=09=09 ;
+=09=09=09io__write_string("Method not supported.\n"),
+=09=09=09io__write_string("Program terminated.\n")
+=09=09 )
+=09 =09;
+=09 =09 soap_call_xml_type(Host, Port, Method, URI, XML,
+=09=09 =09Responses),
+=09=09 io__write_string(Responses)=20
+=09=09)
+=09 )
+=09;
+ =09 { OptionsResult =3D error(OptionErrorString) },
+=09 io__write_string(OptionErrorString),
+=09 io__nl,
+=09 options_help
+=09).
+
+%-------------------------------------------------------------------------=
--%
+
+:- pred display_mercury_response(string::in, list(univ)::in, io__state::di=
,
+=09io__state::uo) is det.
+
+display_mercury_response(Message, Responses) --> =20
+=09io__write_string(Message),
+=09list__foldl((pred(X::in, di, uo) is det -->=20
+=09=09write(univ_value(X)), nl),=20
+=09=09Responses).
+
+
Index: options.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/quicksilver/webserver/server/options.m,v
retrieving revision 1.1
diff -u -r1.1 options.m
--- options.m=092000/11/27 10:02:58=091.1
+++ options.m=092001/02/19 00:23:17
@@ -26,6 +26,17 @@
=09=09;=09port
=09=09;=09root
=20
+=09% Client options
+=09=09;=09method
+=09=09;=09uri
+=09=09;=09xml
+=09=09;=09int=09=09% for GetStockPrice
+=09=09;=09add1=09=09% for Add3Ints
+=09=09;=09add2=09=09% for Add3Ints
+=09=09;=09add3=09=09% for Add3Ints
+=09=09;=09title=09=09% for PurchaseBook
+=09=09; =09author=09=09% for PurchaseBook
+
=09% Miscellaneous Options
=09=09;=09help.
=20
@@ -63,25 +74,55 @@
option_default(port,=09=09=09int(8080)).
option_default(root,=09=09=09string("/var/www")).
=20
+=09% General client options
+option_default(method, =09=09string("")).
+option_default(uri,=09=09string("no value")).
+=09=09% for uri, empty string means that the intent of the=20
+=09=09% SOAP message is provided by the HTTP Request-URI=20
+=09=09% whereas no value means that there is no indication
+=09=09% of the intent of the message.
+option_default(xml, =09=09string("")).
+option_default(int, =09=09int(-1)).
+option_default(add1,=09=09int(0)).
+option_default(add2,=09=09int(0)).
+option_default(add3,=09=09int(0)).
+option_default(title, =09=09string("")).
+option_default(author,=09=09string("")).
+
=09% Miscellaneous Options
option_default(help,=09=09bool(no)).
=20
=09% please keep this in alphabetic order
+short_option('a', =09=09=09author).
% short_option('f',=09=09=09config_file).
short_option('h', =09=09=09help).
short_option('H', =09=09=09host).
+short_option('i',=09=09=09int).
+short_option('m',=09=09=09method).
short_option('P', =09=09=09port).
short_option('R', =09=09=09root).
+short_option('t', =09=09=09title).
+short_option('u',=09=09=09uri).
short_option('v', =09=09=09verbose).
short_option('V', =09=09=09very_verbose).
+short_option('x', =09=09=09xml).
=20
% long_option("config-file",=09=09config_file).
+long_option("add1", =09=09=09add1).
+long_option("add2", =09=09=09add2).
+long_option("add3", =09=09=09add3).
+long_option("author", =09=09=09author).
long_option("help",=09=09=09help).
long_option("host",=09=09=09host).
+long_option("int", =09=09=09int).
+long_option("method",=09=09=09method).
long_option("port",=09=09=09port).
long_option("root",=09=09=09root).
+long_option("title",=09=09=09title).
+long_option("uri",=09=09=09uri).
long_option("verbose",=09=09=09verbose).
long_option("very-verbose",=09=09very_verbose).
+long_option("xml",=09=09=09xml).
=20
options_help -->
=09io__write_strings([
@@ -99,6 +140,26 @@
=09=09"\t\tWhich port quicksilver listens on.\n",
=09=09"\t-R, --root\n",
=09=09"\t\tThe root directory for the html files to be served.\n",
+
+=09=09"\nClient Options:\n",
+=09=09"\t-m, --method\n",
+=09=09"\t\tMethod Name to be called.\n",
+=09=09"\t-u, --uri\n",
+=09=09"\t\tURI of SOAPAction header.\n",
+=09=09"\t-x, --xml\n",
+=09=09"\t\tAn XML message for the RPC.\n",
+=09=09"\t-i, --int\n",
+=09=09"\t\tStocknum for GetStockPrice.\n",
+=09=09"\t--add1\n",
+=09=09"\t\tFirst integer parameter for Add3Ints.\n",
+=09=09"\t--add2\n",
+=09=09"\t\tSecond integer parameter for Add3Ints.\n",
+=09=09"\t--add3\n",
+=09=09"\t\tThird integer parameter for Add3Ints.\n",
+=09=09"\t-a, --author surname,firstname\n",
+=09=09"\t\tAuthor of the book.\n",
+=09=09"\t-t, --title\n",
+=09=09"\t\tTitle of the book.\n",
=20
=09=09"\nVerbosity Options:\n",
=09=09"\t-v, --verbose\n",
Index: soap_interface.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: soap_interface.m
diff -N soap_interface.m
--- /dev/null=09Mon Dec 11 17:26:27 2000
+++ soap_interface.m=09Sun Feb 18 16:23:17 2001
@@ -0,0 +1,461 @@
+%-------------------------------------------------------------------------=
--%
+% 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=20
+% 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 =3D=3D string.
+:- type uri =3D=3D string.
+:- type xml =3D=3D string.
+
+=09% Sends messages (in mercury types) to the SOAP server and returns
+=09% the response (in mercury types).
+=09% host and port specifies the host and port number that the client
+=09% connects to; method specifies the method name of the RPC;=20
+=09% uri indicates the intent of the SOAP HTTP request (see reference
+=09% section 6.1); lists of univ are the input parameters of RPC and
+=09% the output responses from the server.
+ =20
+:- pred soap_call_mercury_type(host::in, port::in, method::in,=20
+=09uri::in, list(univ)::in, list(univ)::out,=20
+=09io__state::di, io__state::uo) is det.
+
+=09% Sends messages (in XML format) to the SOAP server and returns
+=09% the response (in XML format).
+=09% host and port specifies the host and port number that the client
+=09% connects to; method specifies the method name of the RPC;=20
+=09% uri indicates the intent of the SOAP HTTP request (see reference
+=09% section 6.1); xmls are the message sends to the server and
+=09% the response receives from it.
+
+:- pred soap_call_xml_type(host::in, port::in, method::in, uri::in,=20
+=09xml::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,
+=09Responses) -->=20
+=09(
+=09=09{ Method =3D "GetStockPrice" }
+=09->
+=09 =09{ generate_SP_request(Host, Method, SOAPuri,=20
+=09=09=09Parameters, Request) }=20
+=09;
+=09=09{ Method =3D "Hello" }
+=09->
+=09=09{ generate_Hello_request(Host, Method, SOAPuri,
+=09=09=09Parameters, Request) }
+=09;
+=09=09{ Method =3D "Add3Ints" }
+=09->
+=09=09{ generate_AddInt_request(Host, Method, SOAPuri,
+=09=09=09Parameters, Request) }
+=09;
+=09=09{ Method =3D "PurchaseBook" }
+=09->
+=09=09{ generate_PB_request(Host, Method, SOAPuri,=20
+=09=09=09Parameters, Request) }
+=09;
+=09=09{ error("Encode: Method not supported") }
+=09),
+=09tcp__connect(Host, Port, Result),
+=09(
+=09=09{ Result =3D ok(TCP_Connect) },
+=09=09service_connection(TCP_Connect, Request, XMLResponse)
+=09;
+=09=09{ Result =3D error(String) },
+=09=09{ error(String) }
+=09),=20
+=09tcp__shutdown(TCP_Connect),
+=09{ decode_response(Method, XMLResponse, Responses) }.
+
+
+=09% Translates XML response to Mercury types.
+:- pred decode_response(string::in, string::in, list(univ)::out) is det.
+
+decode_response(Method, XMLResponse, Responses) :- =20
+=09(
+=09=09Method =3D "GetStockPrice"=20
+=09->
+=09=09decode_SP_response(XMLResponse, Responses)
+=09;
+=09=09Method =3D "Hello"
+=09->
+=09=09decode_Hello_response(XMLResponse, Responses)
+=09;
+=09=09Method =3D "Add3Ints"
+=09->
+=09=09decode_AddInt_response(XMLResponse, Responses)
+=09;
+=09=09Method =3D "PurchaseBook"
+=09->
+=09=09decode_PB_response(XMLResponse, Responses)
+=09;=09
+=09=09error("Decode: Method not supported")=20
+=09).
+
+%-------------------------------------------------------------------------=
-%
+
+soap_call_xml_type(Host, Port, _Method, SOAPuri, XMLMesg, XMLResponse) -->
+=09{ generate_xml_request(Host, SOAPuri, XMLMesg, Request) },=20
+=09tcp__connect(Host, Port, Result),
+=09(
+=09=09{ Result =3D ok(TCP_Connect) },
+=09=09service_connection(TCP_Connect, Request, Response)
+=09;
+=09=09{ Result =3D error(String) },
+=09=09{ error(String) }
+=09),=20
+=09tcp__shutdown(TCP_Connect),
+=09{ retrieve_body(Response, XMLResponse) }.
+=09
+
+:- pred generate_xml_request(host::in, uri::in, xml::in, string::out)=20
+=09is det.
+
+generate_xml_request(Host, SOAPuri, XMLMesg, Request) :-=20
+=09generate_xml_body(XMLMesg, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+=09
+:- pred generate_xml_body(xml::in, string::out) is det.
+
+generate_xml_body(XMLMesg, SOAPBody) :-
+ =09SOAPBody =3D "<Envelope><Body>" ++ XMLMesg ++ "</Body></Envelope>".
+
+:- pred retrieve_body(string::in, xml::out) is det.
+
+retrieve_body(Response, Body) :-=20
+=09(
+=09=09string__sub_string_search(Response, "\r\n<", Pos)
+=09->
+=09=09string__length(Response, Length),
+=09=09string__right(Response, Length - Pos, Body)=20
+=09;
+=09=09error("error in retrieving body")=20
+=09).
+
+%-------------------------------------------------------------------------=
%=20
+% Hello
+%-------------------------------------------------------------------------=
%=20
+=09
+=09% Generates HTTP header information and SOAP message in the body.=20
+:- pred generate_Hello_request(host, method, uri, list(univ), string).
+:- mode generate_Hello_request(in, in, in, in, out) is det.
+
+generate_Hello_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_Hello_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),=09
+=09Request =3D insert_cr(Header) ++ Body.
+
+=09% Generates SOAP message.
+=09% 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) :-
+=09Body =3D "<Envelope><Body><" ++ MethodName ++ ">" ++=20
+=09=09"</" ++ MethodName ++ "></Body></Envelope>".
+=09=09
+:- pred decode_Hello_response(string::in, list(univ)::out) is det.
+
+decode_Hello_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<output>", Start),
+=09=09string__sub_string_search(XMLResponse, "</output>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Response0),
+=09=09TagLength =3D 8,=09=09% <output>
+=09=09string__right(Response0, End-Start-TagLength, Response1),
+=09=09Responses =3D [univ(Response1)]
+=09;
+=09=09error("decode error")=20
+=09).
+
+%-------------------------------------------------------------------------=
-%
+% Add3Ints
+%-------------------------------------------------------------------------=
-%
+
+=09% Generates HTTP header information and SOAP message
+:- pred generate_AddInt_request(host, method, uri, list(univ), string).
+:- mode generate_AddInt_request(in, in, in, in, out) is det.
+
+generate_AddInt_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_AddInt_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+ =09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+=09
+
+:- pred generate_AddInt_body(method::in, list(univ)::in, string::out)
+=09is det.
+
+generate_AddInt_body(Method, Parameters, Body) :-
+=09list__map(create_xml_parameter, Parameters, XMLList),
+=09string__append_list(XMLList, XMLString),=20
+=09Body =3D "<Envelope><Body><" ++ Method ++ ">" ++ XMLString ++
+=09=09"</" ++ Method ++ "></Body></Envelope>".
+
+:- pred create_xml_parameter(univ::in, string::out) is det.
+
+create_xml_parameter(ParameterAsUniv, ParameterAsXML) :-
+=09det_univ_to_type(ParameterAsUniv, ParameterAsInt),
+=09string__int_to_string(ParameterAsInt, ParameterAsString),
+=09ParameterAsXML =3D "<int>" ++ ParameterAsString ++ "</int>".
+
+:- pred decode_AddInt_response(string::in, list(univ)::out) is det.
+
+decode_AddInt_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<result>", Start),
+=09=09string__sub_string_search(XMLResponse, "</result>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Response0),
+=09=09TagLength =3D 8,=09=09% <result>
+=09=09string__right(Response0, End-Start-TagLength, Response1),
+=09=09(
+=09=09 string__to_int(Response1, ResponseAsInt)
+=09=09->
+=09=09 Responses =3D [univ(ResponseAsInt)]
+=09=09;
+=09=09 error("decode error")
+=09=09)
+=09;
+=09=09error("decode error")=20
+=09).
+
+%-------------------------------------------------------------------------=
-%
+% GetStockPrice
+%-------------------------------------------------------------------------=
-%
+
+=09% Assume library file to be loaded in server is
+=09% libsoap_test_methods.so
+=09% client shouldn't need to know the library file name?
+
+=09% Generates HTTP header information and SOAP message in the body.=20
+:- pred generate_SP_request(host, method, uri, list(univ), string).
+:- mode generate_SP_request(in, in, in, in, out) is det.
+
+generate_SP_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_SP_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+
+=09% Generates SOAP message.
+=09% XXX=09assume no namespace and client has a copy of the schema
+=09% =09used in the server side to encode mercury types.
+:- pred generate_SP_body(method, list(univ), string).
+:- mode generate_SP_body(in, in, out).
+
+=09% schema for GetStockPrice:
+ % <element name=3D"stocknum" type=3D"xsd:int">
+
+generate_SP_body(MethodName, Parameters, Body) :-
+=09% since client knows that this function takes in only
+=09% one parameter, there is no need to call list_foldl to
+=09% translate the parameters.
+=09list__index1_det(Parameters, 1, Parameter),
+=09generate_SP_param(Parameter, ParamAsString),
+=09Body =3D "<Envelope><Body><" ++ MethodName ++ ">" ++=20
+=09=09ParamAsString ++ "</" ++ MethodName ++
+=09=09"></Body></Envelope>".
+
+:- pred generate_SP_param(univ, string).
+:- mode generate_SP_param(in, out) is det.
+
+generate_SP_param(ParamAsUniv, Tag) :- =20
+=09det_univ_to_type(ParamAsUniv, ParamAsValue),=09
+=09string__int_to_string(ParamAsValue, ParamAsString),
+=09Tag =3D "<stocknum>" ++ ParamAsString ++ "</stocknum>".
+
+:- pred decode_SP_response(string::in, list(univ)::out) is det.
+
+decode_SP_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<price>", Start),
+=09=09string__sub_string_search(XMLResponse, "</price>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Response0),
+=09=09TagLength =3D 7,=09=09% <price>
+=09=09string__right(Response0, End - Start - TagLength, Response1),
+=09=09(
+=09=09 string__to_int(Response1, ResponseAsInt)
+=09=09->
+=09=09 Response =3D ResponseAsInt
+=09=09;
+=09=09 error("decode error")
+=09=09),
+=09=09Responses =3D [univ(Response)]
+=09;
+=09=09error("decode error")=20
+=09).
+
+%-------------------------------------------------------------------------=
%
+% PurchaseBook
+%-------------------------------------------------------------------------=
%
+
+=09% Generates HTTP header information and SOAP message.=20
+:- pred generate_PB_request(host, method, uri, list(univ), string).
+:- mode generate_PB_request(in, in, in, in, out) is det.
+
+generate_PB_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_PB_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+
+:- pred generate_PB_body(method::in, list(univ)::in, string::out) is det.
+generate_PB_body(Method, Parameters, Body) :-
+=09generate_PB_parameters(Parameters, ParameterString),
+=09Body =3D "<Envelope><Body><" ++ Method ++ "><book>" ++=20
+=09=09ParameterString ++ "</book></" ++ Method ++=20
+=09=09"></Body></Envelope>".
+
+:- pred generate_PB_parameters(list(univ)::in, string::out) is det.
+
+generate_PB_parameters(ParamList, Body):-
+=09list__index1_det(ParamList, 1, TitleAsUniv),
+=09det_univ_to_type(TitleAsUniv, TitleAsString),
+=09Title =3D "<title>" ++ TitleAsString ++ "</title>",
+=09
+=09list__index1_det(ParamList, 2, AuthorAsUniv),
+=09det_univ_to_type(AuthorAsUniv, AuthorAsString),
+=09(
+=09=09string__sub_string_search(AuthorAsString, ",", Pos)
+=09->
+=09=09string__left(AuthorAsString, Pos, Surname),
+=09=09string__length(AuthorAsString, Length),
+=09=09string__right(AuthorAsString, Length - (Pos + 1), Firstname)
+=09;
+=09=09Surname =3D AuthorAsString,
+=09=09Firstname =3D ""
+=09),=09
+=09Author =3D "<author>" ++=20
+=09=09 "<surname>" ++ Surname ++ "</surname>" ++
+=09=09 "<firstname>" ++ Firstname ++ "</firstname>" ++
+=09=09 "</author>",
+=09Body =3D Title ++ Author.
+
+:- pred decode_PB_response(string::in, list(univ)::out) is det.
+
+decode_PB_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<comment>", Start),
+=09=09string__sub_string_search(XMLResponse, "</comment>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Comment0),
+=09=09TagLength =3D 9,=09=09% <comment>
+=09=09string__right(Comment0, End - Start - TagLength, Comment1),
+=09=09Comment =3D [univ(Comment1)]
+=09;
+=09=09Comment =3D []
+=09),
+=09(
+=09 string__sub_string_search(XMLResponse, "<price>", Start1),
+=09 string__sub_string_search(XMLResponse, "</price>", End1)
+=09->
+=09 string__left(XMLResponse, End1, Price0),
+=09 TagLength1 =3D 7,=09=09% <price>
+=09 string__right(Price0, End1 - Start1 - TagLength1, Price1),
+=09 Price =3D [univ("Price =3D " ++ Price1)]
+=09;
+=09 Price =3D []
+=09),
+=09list__append(Comment, Price, Responses).
+
+=09
+%-------------------------------------------------------------------------=
%
+% Shared functions
+%-------------------------------------------------------------------------=
%
+
+=09% Generates HTTP header.
+:- pred generate_header(host::in, int::in, uri::in, string::out) is det.
+
+generate_header(Host, Length, SOAPuri, Headers) :-
+=09Header1 =3D "POST /libsoap_test_methods.so HTTP/1.1",
+=09Header2 =3D "Host: " ++ Host,
+=09Header3 =3D "Content-Type: text/xml",=20
+=09string__int_to_string(Length, LengthAsString),
+=09Header4 =3D "Content-Length: " ++ LengthAsString,
+=09(
+=09=09SOAPuri =3D "no value"
+=09->
+=09=09Header5 =3D "SOAPAction:"=20
+=09;
+=09=09Header5 =3D "SOAPAction: " ++ SOAPuri
+=09),
+=09Headers =3D insert_cr(Header1) ++ insert_cr(Header2) ++
+=09=09 insert_cr(Header3) ++ insert_cr(Header4) ++
+=09=09 insert_cr(Header5).
+
+=09% Insert carriage return into the line.
+:- func insert_cr(string) =3D string.
+insert_cr(Line) =3D Line ++ "\r\n".=20
+
+%------------------------------------------------------------------------%
+=09
+=09% Sends request to server using HTTP and receives response=20
+=09% from server.=20
+:- pred service_connection(tcp::in, string::in, string::out,=20
+=09io__state::di, io__state::uo) is det.
+
+service_connection(TCP, Request, Response) -->
+=09send_request(TCP, Request),
+=09read_response(TCP, Response).
+
+=09% Sends the request to the server side.
+:- pred send_request(S, string, io__state, io__state) <=3D stream__output(=
S).
+:- mode send_request(in, in, di, uo) is det.
+
+send_request(S, Requests) -->
+=09stream__write_string(S, Requests).
+
+=09% Reads responses from server.
+:- pred read_response(S, string, io__state, io__state) <=3D stream__input(=
S).
+:- mode read_response(in, out, di, uo) is det.
+
+read_response(S, Response) -->
+=09stream__read_line(S, LineResult),
+=09(
+=09=09{ LineResult =3D ok(Line) },
+=09=09{ string__from_char_list(Line, String) },
+=09=09{ Response =3D String ++ Response0 },
+=09=09read_response(S, Response0)
+=09;
+=09=09{ LineResult =3D eof },
+=09=09{ Response =3D "" }
+=09;
+=09=09{ LineResult =3D error(Error) },
+=09=09{ error(string__format("read_response: %s.", [s(Error)])) }
+=09).
+=09=09
+%-------------------------------------------------------------------------=
%
+
Index: soap_test_methods.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v
retrieving revision 1.2
diff -u -r1.2 soap_test_methods.m
--- soap_test_methods.m=092001/02/09 05:15:42=091.2
+++ soap_test_methods.m=092001/02/19 00:23:17
@@ -23,20 +23,25 @@
:- interface.
:- import_module list, std_util.
=20
+ =09% Trivial testing predicate - print out "Hello world".
:- pred hello(univ::out) is det.
=20
+=09% Given a stock number, return its price.=20
:- pred get_sp(list(univ)::in, univ::out) is det.
=20
:- func get_stockprice(list(univ)) =3D univ.
=20
-% :- pred get_bookprice(book::in, univ::out) is det.
-:- pred get_bookprice(list(univ)::in, univ::out) is det.
+=09% Adding 3 integers.
+:- func add3Ints(list(univ)) =3D univ.
=20
+=09% Place a purchase order for a specific book.
+:- pred purchase_book(list(univ)::in, univ::out) is det.
+
:- type book
=09--->=09book(
=09=09=09title :: string,
-=09=09=09author :: author,
-=09=09=09intro :: string
+=09=09=09author :: author
+=09=09=09% intro :: string
=09=09).
=09
:- type author
@@ -69,6 +74,20 @@
=09ResultAsUniv =3D univ("<output>Hello, world</output>").
=20
%---------------------------------------------------------------------%
+% Add3Ints
+%---------------------------------------------------------------------%
+
+add3Ints(ParamList) =3D Result :-
+=09list__index1_det(ParamList, 1, XAsUniv),
+=09list__index1_det(ParamList, 2, YAsUniv),
+=09list__index1_det(ParamList, 3, ZAsUniv),
+=09det_univ_to_type(XAsUniv, X),=20
+=09det_univ_to_type(YAsUniv, Y),=20
+=09det_univ_to_type(ZAsUniv, Z),=20
+=09ResultAsUniv =3D X + Y + Z,
+=09Result =3D univ(ResultAsUniv).
+
+%---------------------------------------------------------------------%
% GetStockPrice=20
%---------------------------------------------------------------------%
=20
@@ -100,21 +119,21 @@
=09).
=20
%---------------------------------------------------------------------%
-% GetBookPrice
+% PurchaseBook
%---------------------------------------------------------------------%
=20
-get_bookprice(ParamList, ResultAsUniv) :-=20
+purchase_book(ParamList, ResultAsUniv) :-=20
=09list__index1_det(ParamList, 1, ParamAsUniv),
=09Param0 =3D univ_value(ParamAsUniv),
=09Param =3D inst_cast_book(Param0),=20
=09(
-=09=09Param =3D book("Hello world",=20
-=09=09=09=09author("Foo", "Bar"),=20
-=09=09=09=09"This is a book")=20
+=09=09Param =3D book("Hello world", =20
+=09=09=09=09author("Foo", "Bar"))
+=09=09=09=09% "This is a book")=20
=09->
=09=09ResultAsUniv =3D univ(100)
=09;
-=09=09ResultAsUniv =3D univ(50)
+=09=09ResultAsUniv =3D univ(0)
=09).
=20
:- func inst_cast_book(T) =3D book.
Index: web_methods.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v
retrieving revision 1.2
diff -u -r1.2 web_methods.m
--- web_methods.m=092001/02/09 05:15:42=091.2
+++ web_methods.m=092001/02/19 00:23:17
@@ -132,12 +132,18 @@
=09=09=09call_SP_func(Handle, Filename, Request,=20
=09=09=09=09Response0, HttpCode0, ErrorFlag0)=20
=09=09;
-=09=09=09% GetBookPrice takes in a struct
-=09=09=09{ Request^name =3D "GetBookPrice" }
+=09=09=09% Add3Ints has 3 parameters
+=09=09=09{ Request^name =3D "Add3Ints" }
=09=09->
-=09=09=09call_BP_pred(Handle, Filename, Request,=20
+=09=09=09call_AI_func(Handle, Filename, Request,=20
=09=09=09=09Response0, HttpCode0, ErrorFlag0)
=09=09;
+=09=09=09% PurchaseBook takes in a struct
+=09=09=09{ Request^name =3D "PurchaseBook" }
+=09=09->
+=09=09=09call_PB_pred(Handle, Filename, Request,=20
+=09=09=09=09Response0, HttpCode0, ErrorFlag0)
+=09=09;
=09=09=09{ Response0 =3D "Method requested not implemented." },=20
=09=09=09{ ErrorFlag0 =3D yes },
=09=09=09{ HttpCode0 =3D 501 }=09% 501 Not Implemented
@@ -227,6 +233,62 @@
[will_not_call_mercury, thread_safe], "Y =3D X").
=20
%-----------------------------------------------------------------------%
+% Add3Ints=20
+%-----------------------------------------------------------------------%
+
+:- pred call_AI_func(handle, string, web_method_request,=20
+=09string, http_code, bool, io__state, io__state).
+:- mode call_AI_func(in, in, in, out, out, out, di, uo) is det.
+
+call_AI_func(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
+=09{ AIProc =3D mercury_proc(function, unqualified(Filename),
+=09=09=09=09"add3Ints", 1, 0) },
+=09dl__mercury_sym(Handle, AIProc, MaybeAddInts),
+=09(
+=09=09{ MaybeAddInts =3D error(Msg) },
+=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) },
+=09=09{ Response =3D ErrorMsg },
+=09=09{ ErrorFlag =3D yes },
+=09=09{ HttpCode =3D 500 }=20
+=09;
+=09=09{ MaybeAddInts =3D ok(AIFunc0) },
+=09=09{ wrapper(AIFunc) =3D inst_cast_addInts(wrapper(AIFunc0)) },
+=09=09{ list__map(lookup_AI_schema, Request^params, UnivList) },
+=09=09{ ResultAsUniv =3D AIFunc(UnivList) },
+=09=09{ det_univ_to_type(ResultAsUniv, ResultAsInt) },
+=09=09{ string__int_to_string(ResultAsInt, ResultAsString) },
+=09=09{ Response =3D "<result>" ++ ResultAsString ++ "</result>" },
+=09=09{ ErrorFlag =3D no },
+=09=09{ HttpCode =3D 200 }
+=09).
+
+=09% schema=20
+=09% <element name=3D"int" type=3D"xsd:int">
+
+:- pred lookup_AI_schema(parameter::in, univ::out) is det.
+lookup_AI_schema(Param, ValueAsUniv) :-
+=09(
+=09=09Param^pName =3D "int",
+=09=09Param^pValue =3D yes(Value)
+=09->
+=09 =09type_cast_parameter("int", Value, ValueAsUniv)
+=09;
+=09=09string__append("Element Name not defined in schema: ",=20
+=09=09=09=09Param^pName, ErrorMsg),
+=09=09require__error(ErrorMsg)
+=09).
+
+=09% inst cast for add3Ints (function)
+:- type addInts =3D=3D (func(list(univ)) =3D univ ).
+:- type addInts_wrapper ---> wrapper(addInts).
+:- inst addInts_wrapper ---> wrapper(func(in) =3D out is det).
+
+:- func inst_cast_addInts(addInts_wrapper) =3D addInts_wrapper.
+:- mode inst_cast_addInts(in) =3D out(addInts_wrapper) is det.
+:- pragma c_code(inst_cast_addInts(X::in) =3D (Y::out(addInts_wrapper)),
+=09[will_not_call_mercury, thread_safe], "Y=3DX").
+
+%-----------------------------------------------------------------------%
% GetStockPrice=20
%-----------------------------------------------------------------------%
=20
@@ -341,7 +403,7 @@
=09[will_not_call_mercury, thread_safe], "Y=3DX").
=20
%-----------------------------------------------------------------------%
-% GetBookPrice
+% PurchaseBook
%-----------------------------------------------------------------------%
=20
/* see Section 3.4 Complex Type Definition Details=20
@@ -359,7 +421,7 @@
schema components across namespaces (=A76.2.3) for the use of component=20
identifiers when importing one schema into another.
*/
-=09% schema for GetBookPrice:
+=09% schema for PurchaseBook:
=09%
=09% <element name=3D"book" type=3D"tns:book"/>
=09% <element name=3D"author" base=3D"tns:author"/>
@@ -368,7 +430,7 @@
=09% <sequence>
=09% <element name=3D"title" type=3D"xsd:string"/>
=09% <element name=3D"author" type=3D"tns:author"/>
-=09% <element name=3D"intro" type=3D"xsd:string"/>
+=09% % <element name=3D"intro" type=3D"xsd:string"/>
=09% </sequence>
=09% </complexType>
=09% =20
@@ -385,7 +447,7 @@
=09%=09--->=09book(
=09%=09=09=09title =09:: string,
=09%=09=09=09author =09:: author,
-=09%=09=09=09intro=09:: string
+=09%=09=09%=09intro=09:: string
=09%=09=09).
=09%=09
=09% :- type author
@@ -394,64 +456,71 @@
=09%=09=09=09firstname :: string
=09%=09=09).
=20
-:- pred call_BP_pred(handle, string, web_method_request,
+:- pred call_PB_pred(handle, string, web_method_request,
=09string, http_code, bool, io__state, io__state).
-:- mode call_BP_pred(in, in, in, out, out, out, di, uo) is det.
+:- mode call_PB_pred(in, in, in, out, out, out, di, uo) is det.
=20
-call_BP_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
-=09{ GetBPProc =3D mercury_proc(predicate, unqualified(Filename),
-=09=09=09"get_bookprice", 2, 0) },=20
-=09dl__mercury_sym(Handle, GetBPProc, MaybeGetBookPrice),
+call_PB_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
+=09{ GetPBProc =3D mercury_proc(predicate, unqualified(Filename),
+=09=09=09"purchase_book", 2, 0) },=20
+=09dl__mercury_sym(Handle, GetPBProc, MaybePurchaseBook),
=09(
-=09=09{ MaybeGetBookPrice =3D error(Msg) },=20
+=09=09{ MaybePurchaseBook =3D error(Msg) },=20
=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) },
=09=09{ Response =3D ErrorMsg },
=09=09{ ErrorFlag =3D yes },
=09=09{ HttpCode =3D 500 }
=09;
-=09=09{ MaybeGetBookPrice =3D ok(BPProc0) },=20
+=09=09{ MaybePurchaseBook =3D ok(PBProc0) },=20
=20
=09=09% Cast the higher-order term that we obtained
=09=09% to the correct higher-order inst.
-=09=09{ BPProc =3D inst_cast_bp(BPProc0) },
+=09=09{ PBProc =3D inst_cast_pb(PBProc0) },
=20
=09=09% Convert parameters (string) to the corresponding types
-=09=09{ list__map(lookup_BP_schema, Request^params, UnivList) },
+=09=09{ list__map(lookup_PB_schema, Request^params, UnivList) },
=09=09
=09=09% Call the procedure whose address we just obtained
-=09=09{ call(BPProc, UnivList, BPUniv) },
+=09=09{ call(PBProc, UnivList, PBUniv) },
=20
-=09=09{ det_univ_to_type(BPUniv, BPInt) },=09
-=09=09{ string__int_to_string(BPInt, BPString) },
-
-=09=09{ string__append("<price>", BPString, BPresult0) },
-=09=09{ string__append(BPresult0, "</price>", BPresult) },
-=09=09{ Response =3D BPresult },
+=09=09{ det_univ_to_type(PBUniv, PBInt) },=09
+=09=09(=20
+=09=09 =09{ PBInt \=3D 0 }
+=09=09->
+=09=09=09{ string__int_to_string(PBInt, PBString) },
+=09=09=09{ Response =3D "<comment>Purchase order placed " ++
+=09=09=09=09 =09"successfully</comment>\n<price>" ++
+=09=09=09=09=09PBString ++ "</price>" }
+=09=09;
+=09=09=09{ Response =3D "<comment>No such book. Purchase " ++
+=09=09=09=09=09"order not placed.</comment>" }=09
+=09=09),
=09=09{ ErrorFlag =3D no },
=09=09{ HttpCode =3D 200 }
=09).
=20
=20
-:- pred lookup_BP_schema(parameter::in, univ::out) is det.
+:- pred lookup_PB_schema(parameter::in, univ::out) is det.
=20
-lookup_BP_schema(Param, ValueAsUniv) :- =20
+lookup_PB_schema(Param, ValueAsUniv) :- =20
=09(
=09=09Param^pName =3D "book",
=09=09Param^pFields =3D yes(FieldList)
=09->
-=09=09get_BP_param(FieldList, "title", Title0),
-=09=09lookup_BP_schema(Title0, TitleAsUniv),
+=09=09get_PB_param(FieldList, "title", Title0),
+=09=09lookup_PB_schema(Title0, TitleAsUniv),
=09=09det_univ_to_type(TitleAsUniv, Title),
=20
-=09=09get_BP_param(FieldList, "author", Author0),
-=09=09lookup_BP_schema(Author0, AuthorAsUniv),
+=09=09get_PB_param(FieldList, "author", Author0),
+=09=09lookup_PB_schema(Author0, AuthorAsUniv),
=09=09det_univ_to_type(AuthorAsUniv, Author),
=09
-=09=09get_BP_param(FieldList, "intro", Intro0),
-=09=09lookup_BP_schema(Intro0, IntroAsUniv),
-=09=09det_univ_to_type(IntroAsUniv, Intro),
+=09=09% get_PB_param(FieldList, "intro", Intro0),
+=09=09% lookup_PB_schema(Intro0, IntroAsUniv),
+=09=09% det_univ_to_type(IntroAsUniv, Intro),
=20
-=09=09ValueAsBook =3D book(Title, Author, Intro),
+=09=09% ValueAsBook =3D book(Title, Author, Intro),
+=09=09ValueAsBook =3D book(Title, Author),
=09=09ValueAsUniv =3D univ(ValueAsBook)
=09;=09
=09=09Param^pName =3D "title",
@@ -462,12 +531,12 @@
=09=09Param^pName =3D "author",
=09=09Param^pFields =3D yes(FieldList)
=09->
-=09=09get_BP_param(FieldList, "surname", Surname0),
-=09=09lookup_BP_schema(Surname0, SurnameAsUniv),
+=09=09get_PB_param(FieldList, "surname", Surname0),
+=09=09lookup_PB_schema(Surname0, SurnameAsUniv),
=09=09det_univ_to_type(SurnameAsUniv, Surname),
=20
-=09=09get_BP_param(FieldList, "firstname", Firstname0),
-=09=09lookup_BP_schema(Firstname0, FirstnameAsUniv),
+=09=09get_PB_param(FieldList, "firstname", Firstname0),
+=09=09lookup_PB_schema(Firstname0, FirstnameAsUniv),
=09=09det_univ_to_type(FirstnameAsUniv, Firstname),
=20
=09=09ValueAsAuthor =3D author(Surname, Firstname),
@@ -491,21 +560,21 @@
=09=09require__error("Element Structure not defined in schema.")
=09).
=20
-:- pred get_BP_param(list(parameter)::in, string::in, parameter::out) is d=
et.
+:- pred get_PB_param(list(parameter)::in, string::in, parameter::out) is d=
et.
=20
-get_BP_param(ParamList, SearchString, Parameter) :-
+get_PB_param(ParamList, SearchString, Parameter) :-
=09list__filter((pred(X::in) is semidet :-
=09=09X =3D parameter(SearchString,_,_,_,_)), ParamList, Result),
=09list__index1_det(Result, 1, Parameter).=09
=20
-=09% inst cast for get_bookprice=20
-:- type bp_pred =3D=3D pred(list(univ), univ).
-% :- type bp_pred =3D=3D pred(book, univ).
-:- inst bp_pred =3D=3D (pred(in, out) is det).
+=09% inst cast for purchase_book
+:- type pb_pred =3D=3D pred(list(univ), univ).
+% :- type pb_pred =3D=3D pred(book, univ).
+:- inst pb_pred =3D=3D (pred(in, out) is det).
=20
-:- func inst_cast_bp(bp_pred) =3D bp_pred.
-:- mode inst_cast_bp(in) =3D out(bp_pred) is det.
-:- pragma c_code(inst_cast_bp(X::in) =3D (Y::out(bp_pred)),
+:- func inst_cast_pb(pb_pred) =3D pb_pred.
+:- mode inst_cast_pb(in) =3D out(pb_pred) is det.
+:- pragma c_code(inst_cast_pb(X::in) =3D (Y::out(pb_pred)),
=09[will_not_call_mercury, thread_safe], "Y=3DX").
=20
%-----------------------------------------------------------------------%
|