add functions to parse/unparse xml structures from/to bigbuffers.

diff --git a/stdext/Makefile b/stdext/Makefile
index ce277859ddaa718e910f7fe00875d79b782f7b6f..2a39928b843e3816ad82ba246328d1759564f2cd 100644 (file)
--- a/stdext/Makefile
+++ b/stdext/Makefile
@@ -16,7 +16,7 @@ OCAMLDESTDIR ?= $(OCAMLLIBDIR)
 OCAML_TEST_INC = -I $(shell ocamlfind query oUnit)
 OCAML_TEST_LIB = $(shell ocamlfind query oUnit)/oUnit.cmxa
 
-STDEXT_OBJS = filenameext stringext arrayext hashtblext listext pervasiveext threadext ring qring fring opt unixext range bigbuffer vIO trie
+STDEXT_OBJS = filenameext stringext arrayext hashtblext listext pervasiveext threadext ring qring fring opt bigbuffer unixext range vIO trie
 INTF = $(foreach obj, $(STDEXT_OBJS),$(obj).cmi)
 LIBS = stdext.cma stdext.cmxa
 

diff --git a/stdext/bigbuffer.ml b/stdext/bigbuffer.ml
index 0de8bf8f9a231e317d44b5c2049068e89013dffc..051fb02f0a01e108c79f1d29670236df66f0abee 100644 (file)
--- a/stdext/bigbuffer.ml
+++ b/stdext/bigbuffer.ml
@@ -15,6 +15,13 @@ let make () = { cells = Array.make default_array_len None; index = 0L }
 
 let length bigbuf = bigbuf.index
 
+let get bigbuf n =
+       let array_offset = Int64.to_int (Int64.div n (Int64.of_int cell_size)) in
+       let cell_offset = Int64.to_int (Int64.rem n (Int64.of_int cell_size)) in
+       match bigbuf.cells.(array_offset) with
+       | None -> "".[0]
+       | Some buf -> buf.[cell_offset]
+
 let rec append_substring bigbuf s offset len =
        let array_offset = Int64.to_int (Int64.div bigbuf.index (Int64.of_int cell_size)) in
        let cell_offset = Int64.to_int (Int64.rem bigbuf.index (Int64.of_int cell_size)) in

diff --git a/stdext/bigbuffer.mli b/stdext/bigbuffer.mli
index fe734589c0f8e321150198b61a379d3d1ede37ac..1f541d73372516505bbaefa05814297f4a71ade5 100644 (file)
--- a/stdext/bigbuffer.mli
+++ b/stdext/bigbuffer.mli
@@ -1,6 +1,7 @@
 type t
 val make : unit -> t
 val length : t -> int64
+val get : t -> int64 -> char
 val append_substring : t -> string -> int -> int -> unit
 val to_fct : t -> (string -> unit) -> unit
 val to_string : t -> string

diff --git a/stdext/unixext.ml b/stdext/unixext.ml
index 9183cf042e131d4a5d6d8454abeb1c2e47dee1ba..6689cc86bf0770070fee2261f4b4f3c73ba15de9 100644 (file)
--- a/stdext/unixext.ml
+++ b/stdext/unixext.ml
@@ -320,6 +320,18 @@ let really_read_string fd length =
   really_read fd buf 0 length;
   buf
 
+let really_read_bigbuffer fd bigbuf n =
+       let chunk = 4096 in
+       let s = String.make chunk '\000' in
+       let written = ref 0L in
+       while !written < n do
+               let remaining = Int64.sub n !written in
+               let to_write = min remaining (Int64.of_int chunk) in
+               really_read fd s 0 (Int64.to_int to_write);
+               Bigbuffer.append_substring bigbuf s 0 (Int64.to_int to_write);
+               written := Int64.add !written to_write;
+       done
+
 let really_write fd string off n =
        let written = ref 0 in
        while !written < n

diff --git a/stdext/unixext.mli b/stdext/unixext.mli
index 2b7beeac051363a95f5ce06074fe80f6cbca6642..0ff60d0f0910cf1ea550247df59bd015ec8296a7 100644 (file)
--- a/stdext/unixext.mli
+++ b/stdext/unixext.mli
@@ -44,6 +44,7 @@ val make_endpoint : Unix.file_descr -> endpoint
 val proxy : Unix.file_descr -> Unix.file_descr -> unit
 val really_read : Unix.file_descr -> string -> int -> int -> unit
 val really_read_string : Unix.file_descr -> int -> string
+val really_read_bigbuffer : Unix.file_descr -> Bigbuffer.t -> int64 -> unit
 val really_write : Unix.file_descr -> string -> int -> int -> unit
 val really_write_string : Unix.file_descr -> string -> unit
 exception Timeout

diff --git a/xml-light2/xml.ml b/xml-light2/xml.ml
index e4c480ba1641ff23ec3c524e3da759ba83ed9da5..a8d6059b099a18cbe33f5e1167f3fd99774475fc 100644 (file)
--- a/xml-light2/xml.ml
+++ b/xml-light2/xml.ml
@@ -91,6 +91,17 @@ let parse_string s =
        let i = Xmlm.input_of_string s in
        parse i
 
+let parse_bigbuffer b =
+       let n = ref Int64.zero in
+       let aux () =
+               try 
+                       let c = Bigbuffer.get b !n in
+                       n := Int64.add !n Int64.one;
+                       int_of_char c
+               with _ -> raise End_of_file in
+       let i = Xmlm.input_of_fun aux in
+       parse i
+
 (* common output function *)
 let substitute list s =
        s

diff --git a/xml-light2/xml.mli b/xml-light2/xml.mli
index f969579264408dd45fa882e4c0eab79f81507195..efc8f581ac7509a87a7fd07422aa5446db37e836 100644 (file)
--- a/xml-light2/xml.mli
+++ b/xml-light2/xml.mli
@@ -14,6 +14,7 @@ val error : error -> string
 val parse_file : string -> xml
 val parse_in : in_channel -> xml
 val parse_string : string -> xml
+val parse_bigbuffer : Bigbuffer.t -> xml
 
 (** output functions *)
 val to_fct : xml -> (string -> unit) -> unit