From: Ina C. <in...@st...> - 2001-02-21 00:44:37
|
Hi Fergus, I've modified the code lately. Can you review this one instead of the previous version that I've posted? Thanks. Ina =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D Estimated hours taken: 30 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 add a function to demonstrate the soap interface =09add example to parse list=20 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=09Tue Feb 20 16:37:57 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/21 00:37:57 @@ -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=09Tue Feb 20 16:37:57 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/21 00:37:57 @@ -23,20 +23,27 @@ :- 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. + +:- pred sum_list(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 +76,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,24 +121,47 @@ =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. :- mode inst_cast_book(in) =3D out is det. :- pragma c_code(inst_cast_book(X::in) =3D (Y::out), [will_not_call_mercury, thread_safe], "Y =3D X"). + +%---------------------------------------------------------------------% +% SumList +%---------------------------------------------------------------------% + +sum_list(ParamList, ResultAsUniv) :- +=09list__index1_det(ParamList, 1, ParamAsUniv), +=09Param0 =3D univ_value(ParamAsUniv), +=09Param =3D inst_cast_list(Param0),=20 +=09sumlist(Param, 0, Sum), +=09ResultAsUniv =3D univ(Sum). + +:- pred sumlist(list(int)::in, int::in, int::out) is det. +sumlist([], Acc, Acc).=20 +sumlist([H|T], Acc0, Acc) :- +=09sumlist(T, Acc0, Acc1),=20 +=09Acc =3D Acc1 + H. + +:- func inst_cast_list(T) =3D list(int). +:- mode inst_cast_list(in) =3D out is det. +:- pragma c_code(inst_cast_list(X::in) =3D (Y::out), + [will_not_call_mercury, thread_safe], "Y =3D X"). + 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/21 00:37:57 @@ -132,12 +132,23 @@ =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{ Request^name =3D "Sumlist" } +=09=09-> +=09=09=09call_list_pred(Handle, Filename, Request, +=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 +238,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 +408,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 +426,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 +435,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 +452,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 +461,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 +536,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 +565,154 @@ =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 + +=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_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"). + +%-----------------------------------------------------------------------% +% Sumlist=20 +%-----------------------------------------------------------------------% + +/* +schema: + <element name=3D"list" type=3D"tns:list"/> + <element name=3D"nil" type=3D"tns:nil"/> + <element name=3D"cons" type=3D"tns:cons"/> + + <complexType name=3D"list"> + <sequence> + <choice> + <element name=3D"nil" type=3D"tns:nil"/> + <element name=3D"cons" type=3D"tns:cons"/> + </choice> + </sequence> + </complexType> + + <complexType name=3D"nil> + <complexContent> + <restriction base=3D"xsd:anyType"> + </restriction> + </complexContent> + </complexType> + =20 + or <complexType name=3D"nil"> shorthand for complex content + </complexType> that restricts anyType + + <complexType name=3D"cons"> + <sequence> + <element name=3D"head" type=3D"xsd:anyType"> + <element name=3D"tail" type=3D"tns:list"/> + </sequence> + </complexType> +*/ + +:- pred call_list_pred(handle, string, web_method_request, +=09string, http_code, bool, io__state, io__state). +:- mode call_list_pred(in, in, in, out, out, out, di, uo) is det. + +call_list_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -= -> +=09{ GetListProc =3D mercury_proc(predicate, unqualified(Filename), +=09=09=09"sum_list", 2, 0) },=20 +=09dl__mercury_sym(Handle, GetListProc, MaybeListProc), +=09( +=09=09{ MaybeListProc =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{ MaybeListProc =3D ok(ListProc0) },=20 + +=09=09{ ListProc =3D inst_cast_list(ListProc0) }, +=09=09% parse the parameters to obtain a list of string +=09=09{ list__foldl(retrieve_list, Request^params, [], StringList) }, +=09=09% cast the list of string to list of int +=09=09{ type_cast_list("int", StringList, UnivList) },=09 +=09=09{ call(ListProc, [UnivList], ResultAsUniv) }, +=09=09{ det_univ_to_type(ResultAsUniv, ResultAsInt) }, +=09=09{ string__int_to_string(ResultAsInt, ResultAsString) }, +=09=09{ Response =3D "<sum>" ++ ResultAsString ++ "</sum>" },=20 +=09=09{ ErrorFlag =3D no }, +=09=09{ HttpCode =3D 200 } +=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). +:- pred retrieve_list(parameter::in, list(string)::in, list(string)::out)= =20 +=09is det. + +retrieve_list(Param, Acc0, Acc) :- =20 +=09( +=09=09Param^pName =3D "list", +=09=09Param^pFields =3D yes(Nil), +=09=09Nil =3D [parameter("nil", no, "", no, yes([]))] +=09-> +=09=09Acc =3D Acc0 +=09; +=09=09Param^pName =3D "list", +=09=09Param^pFields =3D yes(Cons) +=09-> +=09=09list__foldl(retrieve_list, Cons, Acc0, Acc1), +=09=09Acc =3D Acc1 =20 +=09; +=09=09Param^pName =3D "cons", +=09=09Param^pFields =3D yes(Head_Tail) +=09-> +=09=09list__foldl(retrieve_list, Head_Tail, Acc0, Acc) +=09; +=09=09Param^pName =3D "head", +=09=09Param^pValue =3D yes(Value) +=09-> +=09=09list__reverse(Acc0, RevAcc0), +=09=09RevAcc =3D [ Value | RevAcc0 ], +=09=09list__reverse(RevAcc, Acc) +=09; +=09=09Param^pName =3D "tail", +=09=09Param^pFields =3D yes(Tail) +=09-> +=09=09list__foldl(retrieve_list, Tail, Acc0, Acc) +=09; +=09=09error("decode list error") +=09). + +:- pred type_cast_list(string::in, list(string)::in, univ::out) is det. +type_cast_list(Type, List, UnivList) :- =20 + =09( + =09=09Type =3D "int", +=09=09list__map(string__to_int, List, ListAsInt) + =09-> +=09=09UnivList =3D univ(ListAsInt) + =09; +=09=09Type =3D "float", +=09=09list__map(string__to_float, List, ListAsFloat) +=09-> +=09=09UnivList =3D univ(ListAsFloat) +=09; +=09=09Type =3D "string" +=09-> +=09=09UnivList =3D univ(List) +=09; + =09=09require__error("Type cast list failed") + =09). +=09=09=09 =09=09 +=09% inst cast for list=20 +:- type list_pred =3D=3D pred(list(univ), univ). +:- inst list_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_list(list_pred) =3D list_pred. +:- mode inst_cast_list(in) =3D out(list_pred) is det. +:- pragma c_code(inst_cast_list(X::in) =3D (Y::out(list_pred)), =09[will_not_call_mercury, thread_safe], "Y=3DX"). =20 %-----------------------------------------------------------------------% |