[rpc-light] Add xmlrpc.mli and rewrite Xmlrpc.to_string to use buffers instead of...

diff --git a/rpc-light/Makefile b/rpc-light/Makefile
index 1fb2d83eee6a2727615ed6e5c98eee720a49c8ff..eca521fa995e7abf346ce75c1c61610ba46828ce 100644 (file)
--- a/rpc-light/Makefile
+++ b/rpc-light/Makefile
@@ -17,12 +17,15 @@ xmlrpc.cma: rpc.cmo xmlrpc.cmo
        $(OCAMLC) -a -o $@ $^
 
 
-xmlrpc.cmx: xmlrpc.ml
+xmlrpc.cmx: xmlrpc.ml xmlrpc.cmi
        $(OCAMLOPT) $(OCAMLFLAGS) -c -I ../xml-light2 -o $@ $<
 
-xmlrpc.cmo: xmlrpc.ml
+xmlrpc.cmo: xmlrpc.ml xmlrpc.cmi
        $(OCAMLC) $(OCAMLFLAGES) -c -I ../xml-light2 -o $@ $<
 
+xmlrpc.cmi: xmlrpc.mli
+       $(OCAMLOPT) $(OCAMLFLAGS) -c -I ../xml-light2 -o $@ $<
+
 
 rpc.cmx: rpc.ml
        $(OCAMLOPT) $(OCAMLFLAGS) -c -o $@ $<

diff --git a/rpc-light/xmlrpc.ml b/rpc-light/xmlrpc.ml
index 5575a467472f9a222c2b54176cdef0f68303558c..2d746247ab45f28d5ac315dc606373292d2c515b 100644 (file)
--- a/rpc-light/xmlrpc.ml
+++ b/rpc-light/xmlrpc.ml
@@ -5,16 +5,48 @@ let debug (fmt: ('a, unit, string, unit) format4) : 'a =
        kprintf (fun s -> if !debug then begin print_string s; print_newline (); flush stdout end) fmt
 
 (* marshalling/unmarshalling code *)
-let rec to_string = function
-       | Rpc.Int i  -> sprintf "<value><int>%i</int></value>" i
-       | Rpc.Bool b -> sprintf "<value><bool>%b</bool></value>" b
-       | Rpc.String s -> sprintf "<value><string>%s</string></value>" s
-       | Rpc.Double d -> sprintf "<value><double>%f</double></value>" d
-       | Rpc.Array a -> sprintf "<value><array><data>%s</data></array></value>" (String.concat "" (List.map to_string a))
+let rec buffer_add_value buf = function
+       | Rpc.Int i  ->
+               Buffer.add_string buf "<value><int>";
+               Buffer.add_string buf (string_of_int i);
+               Buffer.add_string buf "</int></value>"
+
+       | Rpc.Bool b ->
+               Buffer.add_string buf "<value><bool>";
+               Buffer.add_string buf (string_of_bool b);
+               Buffer.add_string buf "</bool></value>"
+
+       | Rpc.String s ->
+               Buffer.add_string buf "<value><string>";
+               Buffer.add_string buf s;
+               Buffer.add_string buf "</string></value>"
+
+       | Rpc.Double d ->
+               Buffer.add_string buf "<value><double>";
+               Buffer.add_string buf (string_of_float d);
+               Buffer.add_string buf "</double></value>"
+
+       | Rpc.Array a ->
+               Buffer.add_string buf "<value><array><data>";
+               List.iter (buffer_add_value buf) a;
+               Buffer.add_string buf "</data></array></value>"
+
        | Rpc.Struct f ->
-               let members =
-                       List.map (fun (name, value) -> sprintf "<member><name>%s</name>%s</member>" name (to_string value)) f in
-               sprintf "<value><struct>%s</struct></value>" (String.concat "" members)
+               let buffer_add_member (name, value) =
+                       Buffer.add_string buf "<member><name>";
+                       Buffer.add_string buf name;
+                       Buffer.add_string buf "</name>";
+                       buffer_add_value buf value;
+                       Buffer.add_string buf "</member>"
+               in
+               Buffer.add_string buf "<value><struct>";
+               List.iter buffer_add_member f;
+               Buffer.add_string buf "</struct></value>"
+
+let to_string x =
+       let buf = Buffer.create 128 in
+       buffer_add_value buf x;
+       Buffer.contents buf
 
 exception Parse_error of string * string
 

diff --git a/rpc-light/xmlrpc.mli b/rpc-light/xmlrpc.mli
index fb562f4c57d8be8f62ef714b886fdcd7fe74e2ad..3c7082c53391dd2931c3a8be73c4dce12203261e 100644 (file)
--- a/rpc-light/xmlrpc.mli
+++ b/rpc-light/xmlrpc.mli
@@ -1,28 +1,4 @@
-(*
- * Copyright (C) 2006-2009 Citrix Systems Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published
- * by the Free Software Foundation; version 2.1 only. with the special
- * exception on linking described in file LICENSE.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *)
+exception Parse_error of string * string
 
 val to_string : Rpc.t -> string
-val of_string : ?callback:Rpc.callback -> string -> Rpc.t
-
-val to_a : empty:(unit -> 'a) -> append:('a -> string -> unit) -> Rpc.t -> 'a
-val of_a : ?callback:Rpc.callback -> next_char:('a  -> char) -> 'a -> Rpc.t
-
-val string_of_call: Rpc.call -> string
-val call_of_string: ?callback:Rpc.callback -> string -> Rpc.call
-
-val string_of_response: Rpc.response -> string
-val a_of_response : empty:(unit -> 'a) -> append:('a -> string -> unit) -> Rpc.response -> 'a
-
-val response_of_string: ?callback:Rpc.callback -> string -> Rpc.response
-val response_of_in_channel: ?callback:Rpc.callback -> in_channel -> Rpc.response
+val of_string : string -> Rpc.t