Menu
▾
▴
[qs-dev] for review: using SOAP for RPC again
|
From: Ina C. <in...@st...> - 2001-01-23 07:19:45
|
Hi,
Since Tyson said it is very inconvenience to build ./server (due to
the links to the xml and dynamic_linking directories), I've copied those
directories to the webserver dir in my workspace and modified the
Mmakefile so that I only have to type
mmake GRADE=hlc.par.gc depend
mmake GRADE=hlc.par.gc
to build ./server.
Tyson is thinking about cvs adding those 2 directories to `/webserver'.
However, if anyone make changes to those 2 directories, it will cause
double maintenance problem. To avoid this, maybe I can modify
the makefile such that those directories are copied from the master
copies ( extra/xml and extra/dynamic_linking ), but that will depend
on the path of `/webserver' (Just like the Mmakefile in dynamic_linking,
the BROWSER_DIR path depends on the location of dynamic_linking). So,
what should I do?
Anyway, below is a new diff. The web_method_request and parameter structure
has changed after taking into account compound types as well.
Ina
========================================================================
? xml
? dynamic_linking
? temp
? concurrency/concurrency.init
? net/net.init
? server/data
? server/server
? server/test
? server/data1
? server/data2
? server/soap_test_methods.init
? stream/stream.init
Index: Mmakefile
===================================================================
RCS file: /cvsroot/quicksilver/webserver/Mmakefile,v
retrieving revision 1.2
diff -u -r1.2 Mmakefile
--- Mmakefile 2000/11/20 17:11:38 1.2
+++ Mmakefile 2001/01/23 06:40:32
@@ -7,12 +7,27 @@
MAIN_TARGET=server
MMAKEFLAGS=
-SUBDIRS=concurrency net stream server
+SUBDIRS=xml dynamic_linking concurrency net stream server
+# Use shared libraries, since they're needed for dynamic linking
+MGNUCFLAGS += --pic-reg
+MLFLAGS += --shared
+
+# Link in the `-ldl' library (this may not be needed on some systems)
+MLLIBS += -ldl
#----------------------------------------------------------------------#
.PHONY: depend
-depend: concurrency_depend stream_depend net_depend server_depend
+depend: xml_depend dynamic_linking_depend concurrency_depend \
+ stream_depend net_depend server_depend
+
+.PHONY: xml_depend
+xml_depend:
+ cd xml && mmake $(MMAKEFLAGS) depend
+
+.PHONY: dynamic_linking_depend
+dynamic_linking_depend:
+ cd dynamic_linking && mmake $(MMAKEFLAGS) depend
.PHONY: concurrency_depend
concurrency_depend:
@@ -32,6 +47,14 @@
#----------------------------------------------------------------------#
+.PHONY: xml
+xml:
+ cd xml && mmake $(MMAKEFLAGS)
+
+.PHONY: dynamic_linking
+dynamic_linking:
+ cd dynamic_linking && mmake $(MMAKEFLAGS)
+
.PHONY: concurrency
concurrency:
cd concurrency && mmake $(MMAKEFLAGS)
@@ -45,7 +68,7 @@
cd net && mmake $(MMAKEFLAGS)
.PHONY: server
-server: concurrency stream net
+server: xml dynamic_linking concurrency stream net
cd server && mmake $(MMAKEFLAGS)
#----------------------------------------------------------------------#
Index:concurrency/semaphore.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/concurrency/semaphore.m,v
retrieving revision 1.2
diff -u -r1.2 semaphore.m
--- concurrency/semaphore.m 2000/11/20 14:44:35 1.2
+++ concurrency/semaphore.m 2001/01/23 06:40:32
@@ -84,7 +84,7 @@
MR_Word sem_mem;
ME_Semaphore *sem;
- incr_hp(sem_mem, round_up(sizeof(ME_Semaphore), sizeof(MR_Word)));
+ MR_incr_hp(sem_mem, MR_round_up(sizeof(ME_Semaphore), sizeof(MR_Word)));
sem = (ME_Semaphore *) sem_mem;
sem->count = 0;
#ifndef MR_HIGHLEVEL_CODE
Index: server/Mmakefile
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/Mmakefile,v
retrieving revision 1.3
diff -u -r1.3 Mmakefile
--- server/Mmakefile 2000/11/24 14:21:17 1.3
+++ server/Mmakefile 2001/01/23 06:40:32
@@ -1,11 +1,23 @@
-MAIN_TARGET=server
+MAIN_TARGET=server libsoap_test_methods
-include ../Mmake.params
-VPATH=../concurrency:../net:../stream:$(MMAKE_VPATH)
-MCFLAGS+=-I ../concurrency -I ../net -I ../stream
-MGNUCFLAGS+=-I ../concurrency -I ../net -I ../stream
-MLLIBS=../net/libnet.$A ../stream/libstream.$A ../concurrency/libconcurrency.$A
+GRADE=hlc.par.gc
+VPATH=../xml:../dynamic_linking:../concurrency:../net:../stream:$(MMAKE_VPATH)
+MCFLAGS+=-I ../xml -I ../dynamic_linking -I ../concurrency -I \
+ ../net -I ../stream
+MGNUCFLAGS+= --pic-reg \
+ -I ../xml -I ../dynamic_linking -I ../concurrency \
+ -I ../net -I ../stream
+MLLIBS=../xml/libxml.$A ../dynamic_linking/libdl.$A ../net/libnet.$A \
+ ../stream/libstream.$A ../concurrency/libconcurrency.$A
-depend: server.depend
+# Use shared libraries, since they're needed for dynamic linking
+MLFLAGS += --shared
+
+# Link in the '-ldl' library (this may not be needed on some systems)
+MLLIBS += -ldl
+
+depend: server.depend soap_test_methods.depend
server: $(MLLIBS)
+
Index: server/server.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/server.m,v
retrieving revision 1.4
diff -u -r1.4 server.m
--- server/server.m 2000/11/27 10:02:58 1.4
+++ server/server.m 2001/01/23 06:40:32
@@ -21,9 +21,13 @@
:- import_module bool, char, exception, getopt.
:- import_module int, list, require, std_util, string.
+:- import_module soap.
+:- import_module web.
+:- import_module soap_test_methods.
+
main -->
io__command_line_arguments(Args0),
- { OptionOpts = option_ops(short_option, long_option, option_defaults)},
+ { OptionOpts = option_ops(short_option, long_option,
option_defaults)},
{ getopt__process_options(OptionOpts, Args0, _Args, OptionsResult) },
(
{ OptionsResult = ok(OptTable) },
@@ -76,7 +80,14 @@
{ parse_request(RequestLines, RequestOrResponse) },
(
{ RequestOrResponse = left(Request) },
- generate_response(Request, Response)
+ (
+ { Request^cmd = post },
+ get_soapmessage(TCP, Request, Request0)
+ ;
+ { Request^cmd = get },
+ { Request0 = Request }
+ ),
+ generate_response(Request0, Response)
;
{ RequestOrResponse = right(Response) }
),
@@ -115,12 +126,26 @@
:- type request
---> request(
- cmd :: string,
+ cmd :: cmd,
uri :: string,
version :: string,
- headers :: list(string)
+ headers :: list(header),
+ body :: maybe(body)
).
+:- type cmd
+ ---> get
+ ; post.
+
+:- type header
+ ---> header(
+ name :: string,
+ value :: string,
+ extra :: maybe(string)
+ ).
+
+:- type body == string.
+
:- pred parse_request(list(list(char))::in,
either(request, response)::out) is det.
@@ -131,12 +156,19 @@
three_words(Cmd, URI, HTTP_Version, RequestLine, _),
(
Cmd \= [], URI \= [], HTTP_Version \= []
- ->
- Request = request(string__from_char_list(Cmd),
+ ->
+ parse_headers(RequestLines, Headers),
+ (
+ Cmd = ['P','O','S','T']
+ ->
+ Command = post
+ ;
+ Command = get
+ ),
+ Request = request(Command,
string__from_char_list(URI),
string__from_char_list(HTTP_Version),
- list__map(string__from_char_list,
- RequestLines)),
+ Headers, no),
Either = left(Request)
;
Response = response(501, [], no_body, yes),
@@ -173,7 +205,91 @@
{ Word = [] }
).
+:- pred parse_headers(list(list(char))::in, list(header)::out) is det.
+
+parse_headers([RequestLine | RequestLines], Headers) :-
+ three_words(Name, Value, Extra, RequestLine, _),
+ (
+ Extra \= []
+ ->
+ Extra0 = yes(string__from_char_list(Extra))
+ ;
+ Extra0 = no
+ ),
+ Header = header(string__from_char_list(Name),
+ string__from_char_list(Value),
+ Extra0),
+ parse_headers(RequestLines, Headers0),
+ Headers = [Header | Headers0].
+
+
+%-----------------------------------------------------------------------------%+
+:- pred get_soapmessage(S, request, request, io__state, io__state)
+ <= stream__duplex(S).
+:- mode get_soapmessage(in, in, out, di, uo) is det.
+
+get_soapmessage(S, Request, Request0) -->
+ { get_content_length(Request^headers, Length) },
+ get_body(S, Length, SoapMessage),
+ { Request0 = request(Request^cmd,
+ Request^uri,
+ Request^version,
+ Request^headers,
+ yes(string__from_char_list(SoapMessage))) }.
+
+% XXX should error message be produced if content length = 0
+:- pred get_content_length(list(header)::in, int::out) is det.
+
+get_content_length([], 0).
+get_content_length([header(Name, Value, _) | Headers], Length) :-
+ (
+ is_content_length(Name),
+ string__to_int(Value, Length0)
+ ->
+ Length = Length0
+ ;
+ get_content_length(Headers, Length)
+ ).
+:- pred is_content_length(string::in) is semidet.
+is_content_length("Content-Length:").
+is_content_length("Content-length:").
+
+:- pred is_content_type(string::in) is semidet.
+is_content_type("Content-Type:").
+is_content_type("Content-type:").
+
+:- pred get_body(S, int, list(char), io__state, io__state)
+ <= stream__duplex(S).
+:- mode get_body(in, in, out, di, uo) is det.
+
+% XXX what happen if there are still characters when length = 0
+
+get_body(S, Length, RequestLines) -->
+ stream__read_char(S, CharResult),
+ { Length0 = Length - 1 },
+ (
+ { Length0 = 0 },
+ { CharResult = ok(Char) }
+ ->
+ { RequestLines = [Char] }
+ % stream__write_string( S, "length is 0\n")
+ ;
+ { CharResult = error(Error) }
+ ->
+ { error(string__format("get_request: %s.", [s(Error)])) }
+ ;
+ { CharResult = ok(Char) }
+ ->
+ get_body(S, Length0, RequestLines0),
+ { RequestLines = [Char | RequestLines0] }
+ ;
+ % what about if char = '\r' '\n'
+ %assume { CharResult = eof }
+ { RequestLines = [] }
+ ).
%-----------------------------------------------------------------------%
@@ -183,7 +299,7 @@
:- type response
---> response(
respCode :: int,
- respHeaders :: list(string),
+ respHeaders :: list(header),
% respCoding :: list(transfer_coding),
respBody :: response_body,
respSendBody :: bool
@@ -198,15 +314,56 @@
io__state::di, io__state::uo) is det.
generate_response(Request, Response) -->
- io__see(uri_to_filename(Request^uri), SeeResult),
(
- { SeeResult = ok },
- io__read_file_as_string(_Result, String),
- io__seen,
- { Response = response(200, [], string_body(String), yes) }
+ { Request^cmd = get },
+ io__see(uri_to_filename(Request^uri), SeeResult),
+ (
+ { SeeResult = ok },
+ io__read_file_as_string(_Result, String),
+ io__seen,
+ { Response = response(200, [],
+ string_body(String), yes) }
+ ;
+ { SeeResult = error(_) },
+ { Response = response(404, [], no_body, yes) }
+ )
;
- { SeeResult = error(_) },
- { Response = response(404, [], no_body, yes) }
+ { Request^cmd = post },
+ (
+ { Request^body = yes(Body) } ,
+ parse_soapmessage(Body, NsBody),
+ write(NsBody), nl, nl,
+
+ { get_procedure_call(NsBody, Proc) },
+ write(Proc), nl, nl,
+
+ { make_web_request(NsBody, Proc, WebRequest) },
+ write(WebRequest), nl, nl,
+
+ % { make_web_request(Proc, Params, Procedure) },
+ % write(Procedure), nl, nl,
+
+ load_dynamic_library("./libsoap_test_methods.so",
+ WebRequest, Result, HttpCode),
+ (
+ { Result = yes(Output) },
+ { generate_response_body(NsBody, Proc,
+ Output, ResBody0) },
+ { ResBody = string_body(ResBody0) }
+ ;
+ { Result = no },
+ { ResBody = no_body }
+ )
+ ;
+ % 200 - 299 is client request successful
+ % 400 = Bad Request
+ { Request^body = no },
+ { ResBody = no_body },
+ { HttpCode = 400 }
+ ),
+ { list__filter(filter, Request^headers, Headers) },
+ { Response = response(HttpCode, Headers,
+ ResBody, yes) }
).
:- func uri_to_filename(string) = string.
@@ -221,6 +378,10 @@
last_char(Str)
= string__unsafe_index(Str, string__length(Str) - 1).
+:- pred filter(header::in) is semidet.
+filter(header("Content-Length:", _, _)).
+filter(header("Content-Type:", _, _)).
+
%-----------------------------------------------------------------------------%
:- pred send_response(S, response, io__state, io__state) <= stream__output(S).
@@ -239,13 +400,24 @@
stream__write_string(S, string__format("HTTP/1.1 %d %s\r\n",
[i(HttpCode), s(reason(HttpCode))])).
-:- pred headers(S, list(string), io__state, io__state) <= stream__output(S).
+:- pred headers(S, list(header), io__state, io__state) <= stream__output(S).
:- mode headers(in, in, di, uo) is det.
headers(_, []) --> [].
headers(S, Headers) -->
- { Headers = [_ | _] },
- list__foldl(stream__write_string(S), Headers).
+ { Headers = [header(Name, Value, Other)|Tail] },
+ stream__write_string(S, Name),
+ stream__write_char(S, ' '),
+ stream__write_string(S, Value),
+ stream__write_char(S, ' '),
+ (
+ { Other = yes(String) } ->
+ stream__write_string(S, String)
+ ;
+ []
+ ),
+ stream__write_char(S, '\n'),
+ headers(S, Tail).
:- pred body(S, response_body, io__state, io__state) <= stream__output(S).
:- mode body(in, in, di, uo) is det.
Index: server/soap.m
===================================================================
RCS file: soap.m
diff -N soap.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ soap.m Mon Jan 22 22:40:32 2001
@@ -0,0 +1,419 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2000, 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% File: soap.m
+% Author: conway, inch
+%
+% This module translates SOAP messages from XML messages to namespace
+% aware XML messages. It also generates web requests and responses.
+%
+%---------------------------------------------------------------------------%
+
+:- module soap.
+:- interface.
+:- import_module io, list, string.
+:- import_module xml, xml:doc, xml:ns.
+:- import_module web.
+
+ % 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.
+
+ % Retrieves method name from the SOAP message.
+:- pred get_procedure_call(nsDocument, nsElement).
+:- mode get_procedure_call(in, out) is det.
+
+ % Retrieves parameters from the SOAP message and generates a
+ % web request.
+:- pred make_web_request(nsDocument, nsElement, web_method_request).
+:- mode make_web_request(in, in, out) is det.
+
+ % Generates response body in XML format.
+:- pred generate_response_body(nsDocument, nsElement, string, string).
+:- mode generate_response_body(in, in, in, out) is det.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module array, assoc_list, bool, char, map, require, std_util.
+:- import_module parsing, xml:cat, xml:doc, xml:encoding, xml:parse.
+
+%---------------------------------------------------------------------------%
+Parsing soap message
+%---------------------------------------------------------------------------%
+
+ % Parses soap message.
+ % NsDoc is namespace aware soap message.
+parse_soapmessage(SoapMessage, NsDoc) -->
+ pstate(mkEntity(SoapMessage), mkEncoding(utf8), init),
+ io((pred(Dirs0::out, di, uo) is det -->
+ get_environment_var("XML_DIRS", MStr),
+ (
+ { MStr = no },
+ { Str = "." }
+ ;
+ { MStr = yes(Str) }
+ ),
+ { split((':'), Str, Dirs0) }
+ ), Dirs),
+ set(gDirs, dirs(Dirs)),
+ { map__from_assoc_list([
+ "ASCII" - mkEncoding(ascii7),
+ "ascii" - mkEncoding(ascii7),
+ "Latin-1" - mkEncoding(latin1),
+ "Latin1" - mkEncoding(latin1),
+ "UTF-8" - mkEncoding(utf8),
+ "utf-8" - mkEncoding(utf8)
+ ], Encodings) },
+ set(gEncodings, encodings(Encodings)),
+ document,
+ finish(Res),
+ (
+ { Res = ok((_, Doc)) },
+ { nsTranslate(Doc, NsDoc) }
+ ;
+ { Res = error(_Err) },
+ { NsDoc = nsDoc([], 0, [], array([comment("test")])) }
+ ).
+
+
+
+:- pred split(char, string, list(string)).
+:- mode split(in, in, out) is det.
+
+split(C, Str0, Strs) :-
+ string__to_char_list(Str0, Chars),
+ split1(C, [], Strs0, Chars, _),
+ reverse(Strs0, Strs).
+
+:- pred split1(char, list(string), list(string), list(char), list(char)).
+:- mode split1(in, in, out, in, out) is det.
+
+split1(_C, Strs, Strs, [], []).
+split1(C, Strs0, Strs) -->
+ =([_|_]),
+ split2(C, [], Cs0),
+ { reverse(Cs0, Cs) },
+ ( { Cs \= [] } ->
+ { string__from_char_list(Cs, Str) },
+ { Strs1 = [Str|Strs0] }
+ ;
+ { Strs1 = Strs0 }
+ ),
+ split1(C, Strs1, Strs).
+
+:- pred split2(char, list(char), list(char), list(char), list(char)).
+:- mode split2(in, in, out, in, out) is det.
+
+split2(_C, Cs, Cs, [], []).
+split2(C, Cs0, Cs) -->
+ [C0],
+ ( { C = C0 } ->
+ { Cs = Cs0 }
+ ;
+ split2(C, [C0|Cs0], Cs)
+ ).
+
+
+%---------------------------------------------------------------------------%
+Getting method name
+%---------------------------------------------------------------------------%
+
+
+% XXX Assume only one procedure call per soap message
+
+ % Gets method name.
+get_procedure_call(NsDoc, Procedure) :-
+ get_procedure(NsDoc, [], Procedurelist),
+ get_first_element(Procedurelist, Procedure).
+
+:- pred get_first_element(list(T)::in, T::out) is det.
+
+get_first_element([], _) :- error("Procedure not found.").
+get_first_element([H|_], H).
+
+:- pred get_procedure(nsDocument, list(nsElement), list(nsElement)).
+:- mode get_procedure(in, in, out) is det.
+get_procedure(NsDoc, Acc0, Acc) :-
+ get_procedure(NsDoc^content, NsDoc^root, Acc0, Acc).
+
+:- pred get_procedure(array(nsContent), ref(nsContent), list(nsElement),
+ list(nsElement)).
+:- mode get_procedure(in, in, in, out) is det.
+
+get_procedure(ContentArray, ContentRef, Acc0, Acc) :-
+ lookup(ContentArray, ContentRef, Content),
+ (
+ Content = nsElement(Elem)
+ ->
+ (
+ not(is_envelope_body(Elem^eName^localName))
+ ->
+ Acc = [Elem]
+ ;
+ Kid = Elem^eContent,
+ elem_foldl(get_procedure, ContentArray, Kid,
+ Acc0, Acc)
+ )
+ ;
+ Acc = Acc0
+ ).
+:- pred elem_foldl(pred(array(nsContent), ref(nsContent),
+ list(nsElement), list(nsElement)), array(nsContent),
+ list(ref(nsContent)), list(nsElement), list(nsElement)).
+:- mode elem_foldl(pred(in, in, in, out) is det, in, in, in, out) is det.
+
+elem_foldl(_Pred, _, [], Acc, Acc).
+elem_foldl(Pred, ContentArray, [Ref|Refs], Acc0, Acc) :-
+ call(Pred, ContentArray, Ref, Acc0, Acc1),
+ elem_foldl(Pred, ContentArray, Refs, Acc1, Acc).
+
+
+%---------------------------------------------------------------------------%
+Generating web request
+%---------------------------------------------------------------------------%
+
+ % Filter out parameters (simple / compound types) from the
+ % SOAP message and generates a web request.
+make_web_request(NsDoc, Proc, Request) :-
+ Param_Index = Proc^eContent, % array index pointing to parameters
+ content_foldl(get_parameters, NsDoc^content, Param_Index, [],
+ Parameters),
+ Request = web_method_request(Proc^eName^localName, Parameters,
+ Proc^eName^nsURI).
+
+:- pred get_parameters(array(nsContent), ref(nsContent),
+ list(parameter), list(parameter)).
+:- mode get_parameters(in, in, in, out) is det.
+
+
+get_parameters(ContentArray, ContentRef, Acc0, Acc) :-
+ lookup(ContentArray, ContentRef, Content),
+ (
+ Content = nsElement(Elem)
+ ->
+ Name = Elem^eName^localName,
+ URI = Elem^eName^nsURI,
+
+ % search any defined `xsi:type' attribute
+ (
+ web__search_attributes(Elem^eAttrs, Type0)
+ ->
+ Type = yes(Type0)
+ ;
+ Type = no
+ ),
+
+ % message is parsed from bottom-up, therefore need
+ % to reverse the list to keep the parameters' order
+ RevKids = Elem^eContent,
+ list__reverse(RevKids, Kids),
+ (
+ % For case where Kids points to 1 data only
+ % Eg.
+ % <Author>Foo</Author>
+ list__length(Kids, 1),
+ Kids = [Ref],
+ lookup(ContentArray, Ref, Data),
+ Data = data(Value0)
+ ->
+ Value = yes(Value0),
+ Fields = no,
+ Acc = [parameter(Name, Type, URI, Value, Fields)|Acc0]
+ ;
+ % For case where Kids points to elements and data
+ % Eg.
+ % <Author>
+ % <surname>Foo</surname>
+ % <givenname>Bar</givenname>
+ % </Author>
+ Value = no,
+ content_foldl(get_parameters, ContentArray, Kids,
+ [], Acc1),
+ Fields = yes(Acc1),
+ Acc = [parameter(Name, Type, URI, Value, Fields)|Acc0]
+ )
+ ;
+ Acc = Acc0
+ ).
+
+:- pred content_foldl(pred(array(nsContent), ref(nsContent),
+ list(parameter), list(parameter)), array(nsContent),
+ list(ref(nsContent)), list(parameter), list(parameter)).
+:- mode content_foldl(pred(in, in, in, out) is det, in, in, in, out)
+ is det.
+
+content_foldl(_Pred, _, [], Acc, Acc).
+content_foldl(Pred, ContentArray, [Ref|Refs], Acc0, Acc) :-
+ call(Pred, ContentArray, Ref, Acc0, Acc1),
+ content_foldl(Pred, ContentArray, Refs, Acc1, Acc).
+
+
+%---------------------------------------------------------------------------%
+Generating Response Body
+%---------------------------------------------------------------------------%
+
+% assume Method has prefix or default namespace
+% eg. m:GetStockPrice or GetStockPrice
+
+generate_response_body(NsDoc, Method, Result, ResponseBody) :-
+ generate_res_body(NsDoc^content, NsDoc^root, Method, Result, [],
+ [], ResponseBodyList),
+ list__reverse(ResponseBodyList, ResponseBodyList0),
+ string__append_list(ResponseBodyList0, ResponseBody).
+
+:- pred generate_res_body(array(nsContent), ref(nsContent), nsElement,
+ string, nsList, list(string), list(string)).
+:- mode generate_res_body(in, in, in, in, in, in, out) is det.
+
+
+generate_res_body(ContentArray, ContentRef, Method, Result, URIList0,
+ Acc0, Acc) :-
+ lookup(ContentArray, ContentRef, Content),
+ (
+ Content = nsElement(Elem),
+ is_envelope_body(Elem^eName^localName)
+ ->
+ list__append(URIList0, Elem^eNamespaces, URIList),
+ assoc_list__reverse_members(URIList, URIListRev),
+ get_prefix(URIListRev, Elem^eName^nsURI, Elem^eName^localName,
+ ElementName),
+ string__append("<", ElementName, ElemName),
+
+ format_attrs(Elem^eAttrs, URIList, URIListRev, Attrs),
+ string__append_list(Attrs, AttrsString),
+ string__append(ElemName, AttrsString, Elem_Attrs),
+
+ Acc1 = [Elem_Attrs|Acc0],
+ (
+ not(is_body(Elem^eName^localName))
+ ->
+ Kids = Elem^eContent,
+ doc_foldl(generate_res_body, ContentArray, Kids,
+ Method, Result, URIList, Acc1, Acc2)
+ ;
+
+ generate_method_response(Method, Result, ResBody),
+ Acc2 = [ResBody|Acc1]
+ ),
+ make_end_tag(ElementName, EndTag),
+ Acc = [EndTag|Acc2]
+ ;
+ Acc = Acc0
+ ).
+
+
+:- pred is_envelope_body(string::in) is semidet.
+is_envelope_body("Envelope").
+is_envelope_body("Header").
+is_envelope_body("Body").
+
+:- pred is_body(string::in) is semidet.
+is_body("Body").
+
+:- pred get_prefix(nsList::in, nsURI::in, string::in, string::out) is det.
+
+get_prefix(URIListRev, URI, ElementName0, ElementName) :-
+ ( % element has prefix
+ % search_prefix(URIList, Elem^eName^nsURI, Prefix)
+ assoc_list__search(URIListRev, URI, Prefix)
+ ->
+ string__append(Prefix, ":", Name0),
+ string__append(Name0, ElementName0, ElementName)
+ ;
+ % element has default namespace
+ ElementName = ElementName0
+ ).
+
+:- pred format_attrs(list(nsAttribute), nsList, nsList, list(string)).
+:- mode format_attrs(in, in, in, out) is det.
+
+format_attrs([], _, _, [">\n"]).
+format_attrs([Attr|Attrs], URIList, URIListRev, StringList) :-
+
+ (
+ assoc_list__search(URIList, Attr^aName^localName, _URI)
+ ->
+ Prefix = "\nxmlns:"
+ ;
+ assoc_list__search(URIListRev, Attr^aName^nsURI, Prefix0)
+ ->
+ string__append(Prefix0, ":", Prefix)
+ ;
+ Prefix = "\n"
+ ),
+ string__append(Prefix, Attr^aName^localName, Attr1),
+ string__append(Attr1, "=\"", Attr2),
+ string__append(Attr2, Attr^aValue, Attr3),
+ string__append(Attr3, "\"", Attr4),
+ (
+ Attrs \= []
+ ->
+ string__append(Attr4, "\n", Attr5)
+ ;
+ Attr5 = Attr4
+ ),
+ % string__append(Attr4, "\n", Attr4)
+ StringList = [Attr5 | StringList0],
+ format_attrs(Attrs, URIList, URIListRev, StringList0).
+:- pred generate_method_response(nsElement, string, string).
+:- mode generate_method_response(in, in, out) is det.
+
+generate_method_response(Method, Result, ResBody) :-
+ assoc_list__reverse_members(Method^eNamespaces, URIListRev),
+ get_prefix(URIListRev, Method^eName^nsURI, Method^eName^localName,
+ ElementName),
+ string__append("<", ElementName, ResBody0),
+ string__append(ResBody0, "Response ", ResBody1),
+
+ format_attrs(Method^eAttrs, Method^eNamespaces, URIListRev, Attrs),
+ string__append_list(Attrs, AttrsString),
+
+ string__append(ResBody1, AttrsString, ResBody2),
+ string__append(ResBody2, Result, ResBody3),
+ string__append(ResBody3, "\n", ResBody4),
+
+ make_end_tag(ElementName, EndTag),
+
+ string__append(ResBody4, EndTag, ResBody).
+
+:- pred make_end_tag(string::in, string::out) is det.
+
+make_end_tag(ElementName, EndTag) :-
+ string__append("</", ElementName, EndTag0),
+ string__append(EndTag0, ">\n", EndTag).
+
+
+:- pred doc_foldl(pred(array(nsContent), ref(nsContent), nsElement,
+ string, nsList, list(string), list(string)),
+ array(nsContent), list(ref(nsContent)), nsElement, string, nsList,
+ list(string), list(string)).
+:- mode doc_foldl(pred(in, in, in, in, in, in, out) is det, in, in,
+ in, in, in, in, out) is det.
+
+doc_foldl(_Pred, _, [], _, _, _, Acc, Acc).
+ % get_first_element(ElemName0, FirstElem),
+ % string__append("</", ElemName, FirstElem1),
+ % string__append(FirstElem1, ">", FirstElem2),
+ % list__reverse(Acc0, Acc1),
+ % Acc = [FirstElem2|Acc0].
+ % list__reverse(Acc2, Acc),
+ % my_delete(ElemName0, ElemName).
+
+
+doc_foldl(Pred, ContentArray, [Ref|Refs], Method, Result, URIs,
+ Acc0, Acc) :-
+ doc_foldl(Pred, ContentArray, Refs, Method, Result, URIs,
+ Acc0, Acc1),
+ call(Pred, ContentArray, Ref, Method, Result, URIs,
+ Acc1, Acc).
+
+% :- pred insert_last(list(T)::in, T::in, list(T)::out) is det.
+% insert_last([], T, [T]).
+% insert_last([
+
+:- pred my_delete(list(T)::in, list(T)::out) is det.
+my_delete([], []).
+my_delete([_H|T], T).
Index: server/soap_test_methods.m
===================================================================
RCS file: soap_test_methods.m
diff -N soap_test_methods.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ soap_test_methods.m Mon Jan 22 22:40:32 2001
@@ -0,0 +1,84 @@
+%-------------------------------------------------------------------------%
+% Copyright (C) 2000-2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-------------------------------------------------------------------------%
+%
+% File: soap_test_methods.m
+% Author: inch
+%
+% This module contains the definitions of methods that are used to test
+% SOAP RPC calls.
+%
+% All predicates and functions take in a list of univ and return a univ.
+% Each list holds all parameters to each predicate / function.
+%
+% Assumption:
+% Since all parameters are being held inside a list, the order of parameters
+% are assumed to be sorted.
+%
+%-------------------------------------------------------------------------%
+
+:- module soap_test_methods.
+:- interface.
+:- import_module io, int, list, std_util.
+
+:- pred hello(state::di, state::uo) is det.
+
+:- pred get_sp(list(univ)::in, univ::out) is det.
+
+:- func get_stockprice(list(univ)) = univ.
+
+%-------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module require.
+
+ % remove_first_element(List, Elem, Rest)
+ % takes out first element of the List and gives back
+ % rest of the list
+:- pred remove_first_element(list(univ)::in, univ::out, list(univ)::out)
+ is semidet.
+
+remove_first_element([], _, _) :- fail.
+remove_first_element([Elem|Elems], Element, Rest) :-
+ Element = Elem,
+ Rest = Elems.
+
+%-------------------------------------------------------------------------%
+% For Hello
+%-------------------------------------------------------------------------%
+
+hello --> print("Hello, world\n").
+
+%-------------------------------------------------------------------------%
+% For GetStockPrice
+%-------------------------------------------------------------------------%
+
+ % get_sp has 1 parameter
+ % expect the parameter is of type int
+get_sp(ParamList, ResultAsUniv) :-
+ (
+ remove_first_element(ParamList, ParamAsUniv, _)
+ ->
+ det_univ_to_type(ParamAsUniv, ParamAsInt),
+ ResultAsInt = ParamAsInt + 1,
+ ResultAsUniv = univ(ResultAsInt)
+ ;
+ % XXX how to get rid of the require__error/1
+ % ie. how to improve remove_first_element so that
+ % I don't need to call error for every method ?
+ require__error("Error in get_sp")
+ ).
+
+get_stockprice(ParamList) = ResultAsUniv :-
+ (
+ remove_first_element(ParamList, ParamAsUniv, _)
+ ->
+ det_univ_to_type(ParamAsUniv, ParamAsInt),
+ ResultAsInt = ParamAsInt + 1,
+ ResultAsUniv = univ(ResultAsInt)
+ ;
+ require__error("Error in get_stockprice")
+ ).
+
Index: server/web.m
===================================================================
RCS file: web.m
diff -N web.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ web.m Mon Jan 22 22:40:32 2001
@@ -0,0 +1,480 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2000, 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% File: web.m
+% Author: inch
+%
+% Reference:
+% http://www.w3.org/TR/SOAP
+%
+% This module handles remote procedure calls using SOAP protocol and
+% generates corresponding responses. Depending on the name of the
+% procedure call, a different method will be called.
+%
+%---------------------------------------------------------------------------%
+
+:- module web.
+:- interface.
+:- import_module io, list, string, std_util.
+:- import_module http.
+:- import_module xml, xml:ns.
+
+:- type web_method_request
+ ---> web_method_request(
+ name :: string, % method name
+ params :: list(parameter), % list of parameters
+ uri :: nsURI % namespace (method)
+ ).
+
+:- type parameter
+ ---> parameter(
+ pName :: string, % parameter name
+ pType :: maybe(string), % type if any
+ pURI :: nsURI, % namespace (param)
+ % pValue :: string
+ pValue :: maybe(string), % data (simple type)
+ pFields :: maybe(list(parameter))
+ % Struct or Array
+ ).
+/* Ignore this
+
+ % Converts method name and parameters in xml.ns format to
+ % a web request.
+:- pred make_web_request(nsElement, list(parameter), web_method_request).
+:- mode make_web_request(in, in, out) is det.
+*/
+
+ % Loads library, invokes method call and generates corresponding
+ % response.
+:- pred load_dynamic_library(string::in, web_method_request::in,
+ maybe(string)::out, http_code::out, io__state::di, io__state::uo)
+ is det.
+
+:- pred search_attributes(list(nsAttribute)::in, string::out) is semidet.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module bool, int, require.
+:- import_module dl, name_mangle, soap_test_methods.
+
+ % XXX change that to command line argument
+:- func soap_library_file = string.
+soap_library_file = "soap_test_methods".
+
+/* Please ignore.
+
+% FYI : regard to make_web_request(Proc, Params, Request)
+%
+% Eg.
+% <m:GetStockPrice xmlns:m="some uri">
+% <stocknum xsi:type="xsd:int">1</stocksum>
+% <date>30</date>
+% </m:GetStockPrice>
+%
+% Proc will be:
+% nsElement(qName("GetStockPrice", "some uri"),
+% [nsAttribute(qName("m", "some uri"), "some uri")],
+% [2, 4, 5, 7, 8],
+% ["m" - "some uri"])
+%
+% Params will be:
+% [nsElement(nsElement(qName("date", ""), [], [6], [])),
+% data("1"),
+% nsElement(nsElement(qName("stocknum", ""),
+% [nsAttribute(qName("type", ""), "xsd:int")], [3], [])),
+% data("1"),
+%
+% XXX not sure what id is for
+% <SOAP-ENC:int id="int1">1</SOAP-ENC:int>
+% [nsElement(nsElement(qName("int", ""),
+% [nsAttribute(qName("id", ""), "int1")], [3], [])), data("1")]
+
+ % Generates a web request using method and parameters
+make_web_request(Proc, Params, Request) :-
+ Request^name = Proc^eName^localName,
+ Request^uri = Proc^eName^nsURI,
+ Request^params = Params.
+
+make_web_request(Proc, Params, Request) :-
+ Request^name = Proc^eName^localName,
+ Request^uri = Proc^eName^nsURI,
+ form_pair(Params, ParamsPair),
+ list__map(retrieve_params, ParamsPair, Request^params).
+
+ % Transform parameter list from [parameter, data, parameter, data ..]
+ % to [(parameter - data)] to distinguish elements
+:- pred form_pair(list(nsContent), list(pair(nsContent, nsContent))).
+:- mode form_pair(in, out) is det.
+
+
+form_pair(ParamList , PairList) :-
+ (
+ ParamList = []
+ ->
+ PairList = []
+ ;
+ ParamList = [Param, Data | Tail]
+ % list__split_list(2, ParamList, Start, End),
+ % Start = [Param, Data]
+ ->
+ PairList = [(Param - Data) | PairList0],
+ form_pair(Tail, PairList0)
+ ;
+ error("Incorrect Data Format")
+ ).
+
+
+ % Retrieve parameter name, uri, type if defined and data value.
+:- pred retrieve_params(pair(nsContent, nsContent), parameter).
+:- mode retrieve_params(in, out) is det.
+
+retrieve_params((Param0 - Data), Parameter) :-
+ (
+ Param0 = nsElement(Param),
+ Data = data(Value)
+ ->
+ Name = Param^eName^localName,
+ URI = Param^eName^nsURI,
+ (
+ search_attributes(Param^eAttrs, Type0)
+ ->
+ Type = yes(Type0)
+ ;
+ Type = no
+ ),
+ Parameter = parameter(Name, Type, Value, URI)
+ ;
+ error("Incorrect Data Format")
+ ).
+*/
+
+ % Types in XML can be defined either by using xsi:type attribute
+ % or by using schema. This predicate is used to search if
+ % any attribute contains `xsi:type'.
+ %
+ % For all attribute list, each list can only contain one
+ % `xsi:type' attribute.
+ % ie. <stocknum xsi:type="xsd:int">1</stocknum> is valid but
+ % <stocknum xsi:type="xsd:int" xsi:type="xsd:float">1</stocknum>
+ % is not valid
+ % The XML parser has no checking on this.
+
+
+search_attributes([], _) :- fail.
+search_attributes([Attr|Attrs], Type) :-
+ (
+ is_type(Attr^aName^localName),
+ check_attrs(Attrs)
+ ->
+ Type = Attr^aValue
+ ;
+ is_type(Attr^aName^localName),
+ not(check_attrs(Attrs))
+ ->
+ error("Invalid format: More than one xsi:type attribute
+ defined for one element")
+ ;
+ search_attributes(Attrs, Type0),
+ Type = Type0
+ ).
+
+:- pred is_type(string::in) is semidet.
+is_type("type").
+
+:- pred check_attrs(list(nsAttribute)::in) is semidet.
+
+check_attrs([]) :- true.
+check_attrs([Attr|Attrs]) :-
+ not(is_type(Attr^aName^localName)),
+ check_attrs(Attrs).
+
+%---------------------------------------------------------------------------%
+
+ % Opens library file, invokes desire function, and gets back
+ % corresponding response and http code.
+load_dynamic_library(L, Request, Response, HttpCode) -->
+ dl__open(L, lazy, local, MaybeHandle),
+ (
+ { MaybeHandle = error(OpenMsg) },
+ { string__append("dlopen failed: ", OpenMsg, OpenErrorMsg) },
+ { Response = yes(OpenErrorMsg) },
+ { HttpCode = 500 } % 500 Internal Server Error
+ ;
+ { MaybeHandle = ok(Handle) },
+ (
+ % GetStockPrice has 1 parameter
+ { Request^name = "GetStockPrice" }
+ ->
+ call_SP_func(Handle, Request, Response0, HttpCode0)
+ ;
+ % Hello has no parameter
+ { Request^name = "Hello" }
+ ->
+ call_Hello_pred(Handle, Request, Response0, HttpCode0)
+ ;
+
+ % GetBookPrice takes in a struct
+ % { Request^name = "GetBookPrice" }
+ % ->
+ % call_Hello_pred(Handle, Request, Response0, HttpCode0)
+ % ;
+
+ { Response0 = yes("Method requested not
+ implemented.") },
+ { HttpCode0 = 501 } % 501 Not Implemented
+ ),
+
+ dl__close(Handle, Result),
+ (
+ { Result = error(CloseMsg) },
+ { string__append("dlclose failed: ", CloseMsg,
+ CloseErrorMsg) },
+ { Response1 = yes(CloseErrorMsg) },
+ { HttpCode1 = 500 },
+ { ChangeHttpCode = yes }
+ ;
+ { Result = ok },
+ { Response1 = Response0 },
+ { HttpCode1 = HttpCode0 },
+ { ChangeHttpCode = no }
+ ),
+
+ (
+ { ChangeHttpCode = yes }
+ ->
+ { Response = Response1 },
+ { HttpCode = HttpCode1 }
+ ;
+ { Response = Response0 },
+ { HttpCode = HttpCode0 }
+ )
+ ).
+
+%---------------------------------------------------------------------------%
+% For Hello
+%---------------------------------------------------------------------------%
+
+:- pred call_Hello_pred(handle, web_method_request, maybe(string), http_code,
+ io__state, io__state).
+:- mode call_Hello_pred(in, in, out, out, di, uo) is det.
+
+call_Hello_pred(Handle, Request, Response, HttpCode) -->
+ { HelloProc = mercury_proc(predicate, unqualified(soap_library_file),
+ "hello", 2, 0) },
+ dl__mercury_sym(Handle, HelloProc, MaybeHello),
+ (
+ { MaybeHello = error(_Msg) },
+ { Response = no },
+ { HttpCode = 500 }
+ ;
+ { MaybeHello = ok(HelloPred0) },
+
+ % Cast the higher-order term that we obtained
+ % to the correct higher-order inst.
+ { HelloPred = inst_cast_hello(HelloPred0) },
+
+ % Call the procedure whose address
+ % we just obtained.
+ HelloPred,
+
+ { Response = yes("<output>Hello World</output>") },
+ { HttpCode = 200 }
+ ).
+
+% dl__mercury_sym returns a higher-order term with inst `ground'.
+% We need to cast it to the right higher-order inst, which for the
+% `hello' procedure is `pred(di, uo) is det', before we can actually
+% call it. The function inst_cast_hello/1 defined below does that.
+
+:- type io_pred == pred(io__state, io__state).
+:- inst io_pred == (pred(di, uo) is det).
+
+:- func inst_cast_hello(io_pred) = io_pred.
+:- mode inst_cast_hello(in) = out(io_pred) is det.
+:- pragma c_code(inst_cast_hello(X::in) = (Y::out(io_pred)),
+ [will_not_call_mercury, thread_safe], "Y = X").
+
+%---------------------------------------------------------------------------%
+% For GetStockPrice
+%---------------------------------------------------------------------------%
+
+% FYI: Format of Request
+%
+% Eg. 1 <stocknum>1</stocknum>
+% web_method_request("GetStockPrice",
+% [parameter("date", no, "1", ""),
+% parameter("stocknum", no, "1", "")], "some uri")
+%
+% Eg. 2 <stocknum xsi:type="xsd:int">1</stocknum>
+% web_method_request("GetStockPrice",
+% [parameter("stocknum", yes("xsd:int"), "", "1")], "some uri")
+%
+% Eg. 3 <SOAP-ENC:int xmlns:SOAP-ENC="uri" id="int1">1</SOAP-ENC:int>
+% web_method_request("GetStockPrice",
+% [parameter("int", no, "uri", "1")], "some uri")
+%
+%
+
+:- pred call_SP_func(handle, web_method_request, maybe(string), http_code,
+ io__state, io__state).
+:- mode call_SP_func(in, in, out, out, di, uo) is det.
+
+call_SP_func(Handle, Request, Response, HttpCode) -->
+
+ { list__length(Request^params, Arity) },
+
+ % XXX test for function
+ % { GetSPProc = mercury_proc(function, unqualified(soap_library_file),
+ % "get_stockprice", Arity, 0) },
+
+ % XXX test for predicate
+ { GetSPProc = mercury_proc(predicate, unqualified(soap_library_file),
+ "get_sp", 2, 0) },
+
+ dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice),
+ (
+ { MaybeGetStockPrice = error(_Msg1) },
+ { Response = no },
+ { HttpCode = 500 }
+ ;
+ { MaybeGetStockPrice = ok(SPProc0) },
+
+ % Cast the higher-order term that we obtained
+ % to the correct higher-order inst.
+ % XXX test for predicate
+ { SPProc = inst_cast_sp(SPProc0) },
+ % XXX test for function
+ % { wrapper(SPFunc) = inst_cast_stockprice(SPProc0) },
+
+ % message is parsed bottom up, therefore parameter
+ % list is in reverse order
+ % { list__reverse(Request^params, ParameterList) },
+
+ % Convert parameters (string) to the corresponding types
+ { list__map(lookup_SP_schema, Request^params, UnivList) },
+
+ % Call the procedure whose address we just obtained
+ % XXX test for predicate
+ { call(SPProc, UnivList, SPUniv) },
+ % XXX test for function
+ % { SPUniv = SPFunc(UnivList) },
+
+ { det_univ_to_type(SPUniv, SPInt) },
+ { string__int_to_string(SPInt, SPString) },
+
+ { string__append("<price>", SPString, SPresult0) },
+ { string__append(SPresult0, "</price>", SPresult) },
+ { Response = yes(SPresult) },
+ { HttpCode = 200 }
+ ).
+
+ % schema for GetStockPrice:
+ % <element name="stocknum" type="int"/>
+ % <element name="date" type="int">
+ % </element>
+
+ % Lookup element name in schema, find the corresponding type
+ % and type cast to that type.
+:- pred lookup_SP_schema(parameter::in, univ::out) is det.
+
+lookup_SP_schema(Param, ValueAsUniv) :-
+ (
+ Param^pName = "stocknum",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("int", Value, ValueAsUniv)
+ ;
+ Param^pName = "date",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("int", Value, ValueAsUniv)
+ ;
+ % assume Type must be simple type eg. int, float
+ % XXX type may contain prefix
+ % Eg. xsd:int, xsd:float
+
+ Param^pType = yes(Type),
+ Param^pValue = yes(Value)
+ ->
+ split_on_colon(Type, _Prefix, Suffix),
+ type_cast_parameter(Suffix, Value, ValueAsUniv)
+ ;
+ string__append("Element Name not defined in schema: ",
+ Param^pName, ErrorMsg),
+ require__error(ErrorMsg)
+ ).
+
+
+ % inst cast for get_sp (predicate)
+:- type sp_pred == pred(list(univ), univ).
+:- inst sp_pred == (pred(in, out) is det).
+
+:- func inst_cast_sp(sp_pred) = sp_pred.
+:- mode inst_cast_sp(in) = out(sp_pred) is det.
+:- pragma c_code(inst_cast_sp(X::in) = (Y::out(sp_pred)),
+ [will_not_call_mercury, thread_safe], "Y=X").
+
+
+ % inst cast for get_stockprice (function)
+:- type stockprice == (func(list(univ)) = univ ).
+:- type stockprice_wrapper ---> wrapper(stockprice).
+:- inst stockprice_wrapper ---> wrapper(func(in) = out is det).
+
+:- func inst_cast_stockprice(stockprice_wrapper) = stockprice_wrapper.
+:- mode inst_cast_stockprice(in) = out(stockprice_wrapper) is det.
+:- pragma c_code(inst_cast_stockprice(X::in) = (Y::out(stockprice_wrapper)),
+ [will_not_call_mercury, thread_safe], "Y=X").
+
+%---------------------------------------------------------------------------%
+% Shared functions
+%---------------------------------------------------------------------------%
+
+ % Separates prefix and suffix.
+:- pred split_on_colon(string::in, string::out, string::out) is det.
+
+split_on_colon(Name, Prefix, Suffix) :-
+ (
+ string__sub_string_search(Name, ":", Index)
+ ->
+ string__length(Name, Length),
+ string__right(Name, Length-(Index+1), Suffix),
+ string__left(Name, Index, Prefix)
+ ;
+ Suffix = Name,
+ Prefix = ""
+ ).
+
+ % Used to convert data value from string to the desire type
+ % and return it as a univ.
+:- pred type_cast_parameter(string::in, string::in, univ::out) is det.
+type_cast_parameter(Type, ValueAsString, ValueAsUniv) :-
+ (
+ Type = "int",
+ string__to_int(ValueAsString, ValueAsInt)
+ ->
+ ValueAsUniv = univ(ValueAsInt)
+ ;
+ Type = "float",
+ string__to_float(ValueAsString, ValueAsFloat)
+ ->
+ ValueAsUniv = univ(ValueAsFloat)
+ ;
+ Type = "string"
+ ->
+ ValueAsUniv = univ(ValueAsString)
+ ;
+ Type = "char",
+ string__index(ValueAsString, 0, ValueAsChar)
+ ->
+ ValueAsUniv = univ(ValueAsChar)
+ ;
+ require__error("Type cast failed")
+ ).
+
+
+
+
|
