From d525103c8621f6ff0293311a8e8f9ac0c3580805 Mon Sep 17 00:00:00 2001 From: Richard Jones Date: Wed, 30 Sep 2009 15:32:41 +0100 Subject: [PATCH] OCaml viewer: Use ocamlduce to replace xpath code. --- ocaml/examples/LICENSE | 3 ++ ocaml/examples/Makefile.am | 6 ++-- ocaml/examples/viewer.ml | 57 ++++++++------------------------------ ocaml/examples/xmllight_loader.ml | 16 +++++++++++ ocaml/examples/xmllight_loader.mli | 2 ++ 5 files changed, 36 insertions(+), 48 deletions(-) create mode 100644 ocaml/examples/xmllight_loader.ml create mode 100644 ocaml/examples/xmllight_loader.mli diff --git a/ocaml/examples/LICENSE b/ocaml/examples/LICENSE index 990daef..78d360e 100644 --- a/ocaml/examples/LICENSE +++ b/ocaml/examples/LICENSE @@ -4,3 +4,6 @@ copied without any restrictions. The files 'Throbber.png' and 'Throbber.gif' come from the source to Firefox, and you should check the Firefox license before redistributing those files. + +The files 'xmllight_loader.ml' and 'xmllight_loader.mli' come from +http://yquem.inria.fr/~frisch/ocamlcduce/samples/xmllight/ diff --git a/ocaml/examples/Makefile.am b/ocaml/examples/Makefile.am index d088c4a..b516647 100644 --- a/ocaml/examples/Makefile.am +++ b/ocaml/examples/Makefile.am @@ -13,11 +13,11 @@ if BUILD_OCAML_VIEWER noinst_SCRIPTS += viewer -viewer: throbber.ml viewer.ml - $(OCAMLFIND) ocamlopt \ +viewer: throbber.ml xmllight_loader.mli xmllight_loader.ml viewer.ml + ocamlducefind opt \ -warn-error A \ -thread \ - -package libvirt,lablgtk2,extlib,xml-light,threads -I .. \ + -package libvirt,lablgtk2,extlib,xml-light,ocamlduce,threads -I .. \ -predicates init,threads \ -linkpkg mlguestfs.cmxa gtkThread.cmx \ $^ -o $@ diff --git a/ocaml/examples/viewer.ml b/ocaml/examples/viewer.ml index ef6627b..eeff525 100644 --- a/ocaml/examples/viewer.ml +++ b/ocaml/examples/viewer.ml @@ -10,6 +10,7 @@ * - extlib (http://code.google.com/p/ocaml-extlib/) * - lablgtk2 (http://wwwfun.kurims.kyoto-u.ac.jp/soft/lsl/lablgtk.html * - xml-light (http://tech.motion-twin.com/xmllight.html) + * - cduce and ocamlduce (http://cduce.org/) * - ocaml-libvirt (http://libvirt.org/ocaml) * - ocaml-libguestfs * @@ -314,52 +315,18 @@ end = struct (match !dom with Some dom -> D.free dom | None -> ()); dom := None - (* This would be much simpler if OCaml had either a decent XPath - * implementation, or if ocamlduce was stable enough that we - * could rely on it being available. So this is *not* an example - * of either good OCaml or good programming. XXX - *) and get_devices_from_xml xml = - let xml = Xml.parse_string xml in - let devices = - match xml with - | Xml.Element ("domain", _, children) -> - let devices = - List.filter_map ( - function - | Xml.Element ("devices", _, devices) -> Some devices - | _ -> None - ) children in - List.concat devices - | _ -> - failwith "get_xml_desc didn't return " in - let rec source_dev_of = function - | [] -> None - | Xml.Element ("source", attrs, _) :: rest -> - (try Some (List.assoc "dev" attrs) - with Not_found -> source_dev_of rest) - | _ :: rest -> source_dev_of rest - in - let rec source_file_of = function - | [] -> None - | Xml.Element ("source", attrs, _) :: rest -> - (try Some (List.assoc "file" attrs) - with Not_found -> source_file_of rest) - | _ :: rest -> source_file_of rest - in - let devs = - List.filter_map ( - function - | Xml.Element ("disk", _, children) -> source_dev_of children - | _ -> None - ) devices in - let files = - List.filter_map ( - function - | Xml.Element ("disk", _, children) -> source_file_of children - | _ -> None - ) devices in - devs @ files + (* Lengthy discussion of the merits or otherwise of this code here: + * http://groups.google.com/group/fa.caml/browse_thread/thread/48e05d49b0f21b8a/5296bceb31ebfff3 + *) + let xml = Xmllight_loader.from_string xml in + let xs = {{ [xml] }} in + let xs = {{ (((xs.(_)) / .(_)) / .(_)) / }} in + let xs = {{ map xs with + | _ + | _ -> [s] + | _ -> [] }} in + {: xs :} end (* End of slave thread code. *) (*----------------------------------------------------------------------*) diff --git a/ocaml/examples/xmllight_loader.ml b/ocaml/examples/xmllight_loader.ml new file mode 100644 index 0000000..46dd77f --- /dev/null +++ b/ocaml/examples/xmllight_loader.ml @@ -0,0 +1,16 @@ +open Xml +open Ocamlduce.Load + + +let from_xml ?ns xml = + let l = make ?ns () in + let rec aux = function + | Element (tag, attrs, child) -> + start_elem l tag attrs; List.iter aux child; end_elem l () + | PCData s -> + text l s in + aux xml; + get l + +let from_file ?ns s = from_xml ?ns (parse_file s) +let from_string ?ns s = from_xml ?ns (parse_string s) diff --git a/ocaml/examples/xmllight_loader.mli b/ocaml/examples/xmllight_loader.mli new file mode 100644 index 0000000..6c7bbe9 --- /dev/null +++ b/ocaml/examples/xmllight_loader.mli @@ -0,0 +1,2 @@ +val from_file : ?ns:bool -> string -> Ocamlduce.Load.anyxml +val from_string : ?ns:bool -> string -> Ocamlduce.Load.anyxml -- 1.8.3.1