# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
# Date 1262958466 0
# Node ID 67078f88291e9970dc3ca0c43ae3ba28c8c20a0a
# Parent  90fd186e17ef6bc1193681c157a6fa683be7b668
[rpc-light] Add a function to marshal and unmarshal XMLRPC to a bigbuffer

Signed-off-by: Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>

diff -r 90fd186e17ef -r 67078f88291e rpc-light/xmlrpc.ml
--- a/rpc-light/xmlrpc.ml	Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/xmlrpc.ml	Fri Jan 08 13:47:46 2010 +0000
@@ -77,6 +77,11 @@
 	add_value (Buffer.add_string buf) x;
 	Buffer.contents buf
 
+let to_a ~empty ~append x =
+	let buf = empty () in
+	add_value (fun s -> append buf s) x;
+	buf
+
 let string_of_call call =
 	let module B = Buffer in
 	let buf = B.create 1024 in
@@ -102,6 +107,15 @@
 	add (to_string v);
 	add "</param></params></methodResponse>";
 	B.contents buf
+
+let a_of_response ~empty ~append response =
+	let buf = empty () in
+	let add s = append buf s in
+	let v = if response.success then response.contents else Dict [ "failure", response.contents ] in
+	add "<?xml version=\"1.0\"?><methodResponse><params><param>";
+	add (to_string v);
+	add "</param></params></methodResponse>";
+	buf
 
 exception Parse_error of string * Xmlm.signal * Xmlm.input
 
@@ -141,8 +155,10 @@
 	aux [];
 	Buffer.contents buf
 
+let pretty_string_of_error (n,s,i) =
+	Printf.sprintf "Error: got '%s' while '%s' was expected when processing '%s'\n" (debug_signal s) n (debug_input i)
+
 let parse_error n s i =
-	Printf.eprintf "Error: got '%s' while '%s' was expected when processing '%s'\n" (debug_signal s) n (debug_input i);
 	raise (Parse_error (n,s,i))
 
 module Parser = struct
@@ -153,9 +169,13 @@
 		| `Data d -> d
 		| e       -> parse_error "..." e input
 
-	let open_tag input =
+	let rec open_tag input =
 		match Xmlm.input input with
 		| `El_start ((_,tag),_) -> tag
+		| `Data s
+			when s = " " 
+			|| s = "\n" 
+			|| s = "\t"         -> open_tag input
 		| e                     -> parse_error "<...>" e input
 
 	let close_tag input =
@@ -241,7 +261,16 @@
 	| `Dtd _ -> ignore (Xmlm.input input)
 	| _      -> () end;
 	Parser.of_xml ?callback [] input
-	
+
+let of_a ?callback ~next_char b =
+	let aux () =
+		try 
+			let c = next_char b in
+			int_of_char c
+		with _ -> raise End_of_file in
+	let input = Xmlm.make_input (`Fun aux) in
+	Parser.of_xml ?callback [] input
+
 let call_of_string ?callback str =
 	let input = Xmlm.make_input (`String (0, str)) in
 	begin match Xmlm.peek input with
diff -r 90fd186e17ef -r 67078f88291e rpc-light/xmlrpc.mli
--- a/rpc-light/xmlrpc.mli	Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/xmlrpc.mli	Fri Jan 08 13:47:46 2010 +0000
@@ -15,10 +15,14 @@
 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