From f14eece7d150fd85f965dd59f392c4d57a183032 Mon Sep 17 00:00:00 2001
From: Thomas Gazagnaire <thomas.gazagnaire@citrix.com>
Date: Wed, 16 Sep 2009 16:10:49 +0100
Subject: [PATCH] [rpc-light] Add xmlrpc.mli and rewrite Xmlrpc.to_string to
 use buffers instead of concatenating strings.

---
 rpc-light/Makefile   |  7 +++++--
 rpc-light/xmlrpc.ml  | 50 ++++++++++++++++++++++++++++++++++++--------
 rpc-light/xmlrpc.mli | 28 ++-----------------------
 3 files changed, 48 insertions(+), 37 deletions(-)

diff --git a/rpc-light/Makefile b/rpc-light/Makefile
index 1fb2d83..eca521f 100644
--- 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 5575a46..2d74624 100644
--- 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 fb562f4..3c7082c 100644
--- 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
-- 
2.39.5