[Libguestfs] [PATCH v11 6/6] New tool: virt-builder-repository
Richard W.M. Jones
rjones at redhat.com
Mon Oct 9 12:12:06 UTC 2017
On Mon, Oct 09, 2017 at 11:05:03AM +0100, Richard W.M. Jones wrote:
> > +let osinfo_ids = ref None
> > +
> > +let osinfo_get_short_ids () =
> > + match !osinfo_ids with
> > + | Some ids -> ids
> > + | None -> (
> > + let set = ref StringSet.empty in
> > + Osinfo.iterate_db (
> > + fun filepath ->
> > + let doc = Xml.parse_file filepath in
> > + let xpathctx = Xml.xpath_new_context doc in
> > + let nodes = xpath_get_nodes xpathctx "/libosinfo/os/short-id" in
> > + List.iter (
> > + fun node ->
> > + let id = Xml.node_as_string node in
> > + set := StringSet.add id !set
> > + ) nodes
> > + );
> > + osinfo_ids := Some (!set);
> > + !set
> > + )
>
> If the Osinfo module implemented a ‘fold’ function (instead of iter)
> then you could write this much more conveniently. It would be
> something like:
>
> let set = Osinfo.fold (fun set filepath -> ...) StringSet.empty in
>
> where the ‘...’ bit non-imperatively updates ‘set’.
See attached for what I mean (only compiled, not tested).
Rich.
--
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines. Supports shell scripting,
bindings from many languages. http://libguestfs.org
-------------- next part --------------
>From 39ebc2d081139013e10ad3ac0e5266c4b1242b62 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones at redhat.com>
Date: Mon, 9 Oct 2017 13:11:35 +0100
Subject: [PATCH] builder: osinfo fold function
---
builder/osinfo.ml | 73 +++++++++++++++++++++-------------------------
builder/osinfo.mli | 6 ++--
builder/repository_main.ml | 34 ++++++++++-----------
3 files changed, 54 insertions(+), 59 deletions(-)
diff --git a/builder/osinfo.ml b/builder/osinfo.ml
index 9d89db510..69c5317ff 100644
--- a/builder/osinfo.ml
+++ b/builder/osinfo.ml
@@ -20,61 +20,56 @@ open Std_utils
open Tools_utils
open Osinfo_config
-let rec iterate_db fn =
- let locations = ref [] in
-
- (* (1) Try the shared osinfo directory, using either the
- * $OSINFO_SYSTEM_DIR envvar or its default value.
- *)
- let () =
+let rec fold fn base =
+ let locations =
+ (* (1) Try the shared osinfo directory, using either the
+ * $OSINFO_SYSTEM_DIR envvar or its default value.
+ *)
let dir =
try Sys.getenv "OSINFO_SYSTEM_DIR"
with Not_found -> "/usr/share/osinfo" in
- List.push_back locations ((dir // "os"), read_osinfo_db_three_levels)
- in
+ ((dir // "os"), read_osinfo_db_three_levels) ::
- (* (2) Try the libosinfo directory, using the newer three-directory
- * layout ($LIBOSINFO_DB_PATH / "os" / $group-ID / [file.xml]).
- *)
- let () =
- let path = Osinfo_config.libosinfo_db_path // "os" in
- List.push_back locations (path, read_osinfo_db_three_levels)
- in
+ (* (2) Try the libosinfo directory, using the newer three-directory
+ * layout ($LIBOSINFO_DB_PATH / "os" / $group-ID / [file.xml]).
+ *)
+ let path = Osinfo_config.libosinfo_db_path // "os" in
+ (path, read_osinfo_db_three_levels) ::
- (* (3) Try the libosinfo directory, using the old flat directory
- * layout ($LIBOSINFO_DB_PATH / "oses" / [file.xml]).
- *)
- let () =
- let path = Osinfo_config.libosinfo_db_path // "oses" in
- List.push_back locations (path, read_osinfo_db_flat)
- in
+ (* (3) Try the libosinfo directory, using the old flat directory
+ * layout ($LIBOSINFO_DB_PATH / "oses" / [file.xml]).
+ *)
+ let path = Osinfo_config.libosinfo_db_path // "oses" in
+ (path, read_osinfo_db_flat) :: [] in
- let rec loop = function
- | (path, f) :: paths ->
- if is_directory path then f fn path
- (* This is not an error: RHBZ#948324. *)
- else loop paths
- | [] -> ()
- in
+ let files =
+ List.flatten (
+ filter_map (
+ fun (path, f) ->
+ if is_directory path then Some (f path)
+ (* This is not an error: RHBZ#948324. *)
+ else None
+ ) locations
+ ) in
- loop !locations
+ List.fold_left fn base files
-and read_osinfo_db_three_levels fn path =
+and read_osinfo_db_three_levels path =
debug "osinfo: loading 3-level-directories database from %s" path;
let entries = Array.to_list (Sys.readdir path) in
let entries = List.map ((//) path) entries in
(* Iterate only on directories. *)
let entries = List.filter is_directory entries in
- List.iter (read_osinfo_db_directory fn) entries
+ List.flatten (List.map read_osinfo_db_directory entries)
-and read_osinfo_db_flat fn path =
+and read_osinfo_db_flat path =
debug "osinfo: loading flat database from %s" path;
- read_osinfo_db_directory fn path
+ read_osinfo_db_directory path
-and read_osinfo_db_directory fn path =
- let entries = Array.to_list (Sys.readdir path) in
+and read_osinfo_db_directory path =
+ let entries = Sys.readdir path in
+ let entries = Array.to_list entries in
let entries = List.filter (fun x -> Filename.check_suffix x ".xml") entries in
let entries = List.map ((//) path) entries in
let entries = List.filter is_regular_file entries in
- List.iter fn entries
-
+ entries
diff --git a/builder/osinfo.mli b/builder/osinfo.mli
index 949d776a9..bf60157fe 100644
--- a/builder/osinfo.mli
+++ b/builder/osinfo.mli
@@ -16,7 +16,7 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-val iterate_db : (string -> unit) -> unit
-(** [iterate_db fun] iterates over the osinfo-db/libosinfo database
- of OS definitions, invoking the specified [fun] on each XML file.
+val fold : ('a -> string -> 'a) -> 'a -> 'a
+(** [fold f base] folds function [f] over every file in the
+ osinfo-db/libosinfo database of OS definitions.
*)
diff --git a/builder/repository_main.ml b/builder/repository_main.ml
index 03a0ff4be..b02e37b54 100644
--- a/builder/repository_main.ml
+++ b/builder/repository_main.ml
@@ -132,25 +132,25 @@ let checksums_get_sha512 = function
let osinfo_ids = ref None
-let osinfo_get_short_ids () =
+let rec osinfo_get_short_ids () =
match !osinfo_ids with
| Some ids -> ids
- | None -> (
- let set = ref StringSet.empty in
- Osinfo.iterate_db (
- fun filepath ->
- let doc = Xml.parse_file filepath in
- let xpathctx = Xml.xpath_new_context doc in
- let nodes = xpath_get_nodes xpathctx "/libosinfo/os/short-id" in
- List.iter (
- fun node ->
- let id = Xml.node_as_string node in
- set := StringSet.add id !set
- ) nodes
- );
- osinfo_ids := Some (!set);
- !set
- )
+ | None ->
+ osinfo_ids :=
+ Some (
+ Osinfo.fold (
+ fun set filepath ->
+ let doc = Xml.parse_file filepath in
+ let xpathctx = Xml.xpath_new_context doc in
+ let nodes = xpath_get_nodes xpathctx "/libosinfo/os/short-id" in
+ List.fold_left (
+ fun set node ->
+ let id = Xml.node_as_string node in
+ StringSet.add id set
+ ) set nodes
+ ) StringSet.empty
+ );
+ osinfo_get_short_ids ()
let compress_to file outdir =
let outimg = outdir // (Filename.basename file) ^ ".xz" in
--
2.13.2
More information about the Libguestfs
mailing list