Libguestfs - Jan 2014 - [PATCH] builder: output translated notes

Output all the translations available for the notes in the "verbose"
output and the JSON output, while trying to match the system langauge in
the "show notes" output.

The JSON output is slightly changed to handle translations, with the
"untranslated" notes being matched as "C". The version is
not bumped
though, since there have been no stable releases with the former output
yet.
---
 builder/Makefile.am               |  5 ++++
 builder/index_parser.ml           | 11 ++++----
 builder/list_entries.ml           | 55 +++++++++++++++++++++++++++++++-----
 builder/setlocale-c.c             | 59 +++++++++++++++++++++++++++++++++++++++
 builder/setlocale.ml              | 29 +++++++++++++++++++
 builder/setlocale.mli             | 30 ++++++++++++++++++++
 builder/test-virt-builder-list.sh | 28 ++++++++++++++-----
 po/POTFILES                       |  1 +
 po/POTFILES-ml                    |  1 +
 9 files changed, 200 insertions(+), 19 deletions(-)
 create mode 100644 builder/setlocale-c.c
 create mode 100644 builder/setlocale.ml
 create mode 100644 builder/setlocale.mli

diff --git a/builder/Makefile.am b/builder/Makefile.am
index 4777619..2be495b 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -51,6 +51,9 @@ SOURCES = \
 	pxzcat.ml \
 	pxzcat.mli \
 	pxzcat-c.c \
+	setlocale.ml \
+	setlocale.mli \
+	setlocale-c.c \
 	sigchecker.mli \
 	sigchecker.ml
 
@@ -83,6 +86,8 @@ OBJECTS = \
 	index-parser-c.o \
 	pxzcat-c.o \
 	pxzcat.cmx \
+	setlocale-c.o \
+	setlocale.cmx \
 	get_kernel.cmx \
 	downloader.cmx \
 	sigchecker.cmx \
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index d5b48ae..2d4a642 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -91,11 +91,12 @@ let print_entry chan (name, { printable_name =
printable_name;
   | None -> ()
   | Some lvexpand -> fp "lvexpand=%s\n" lvexpand
   );
-  (match notes with
-  | ("", notes) :: _ -> fp "notes=%s\n" notes
-  | _ :: _
-  | [] -> ()
-  );
+  List.iter (
+    fun (lang, notes) ->
+      match lang with
+      | "" -> fp "notes=%s\n" notes
+      | lang -> fp "notes[%s]=%s\n" lang notes
+  ) notes;
   if hidden then fp "hidden=true\n"
 
 (* Types returned by the C index parser. *)
diff --git a/builder/list_entries.ml b/builder/list_entries.ml
index b947cc8..2f47231 100644
--- a/builder/list_entries.ml
+++ b/builder/list_entries.ml
@@ -21,6 +21,23 @@ open Common_utils
 
 open Printf
 
+let split_locale loc +  let regex = Str.regexp
"^\\([A-Za-z]+\\)\\(_\\([A-Za-z]+\\)\\)?\\(\\.\\([A-Za-z0-9-]+\\)\\)?\\(@\\([A-Za-z]+\\)\\)?$"
in
+  let l = ref [] in
+  if Str.string_match regex loc 0 then (
+    let match_or_empty n +      try Str.matched_group n loc with
+      | Not_found -> "" in
+    let lang = Str.matched_group 1 loc in
+    let territory = match_or_empty 3 in
+    (match territory with
+    | "" -> ()
+    | territory -> l := (lang ^ "_" ^ territory) :: !l);
+    l := lang :: !l;
+  );
+  l := "" :: !l;
+  List.rev !l
+
 let rec list_entries ~list_format ~sources index    match list_format with
   | `Short -> list_entries_short index
@@ -45,6 +62,10 @@ and list_entries_short index    ) index
 
 and list_entries_long ~sources index +  let langs = match Setlocale.setlocale
Setlocale.LC_MESSAGES None with
+  | None -> [""]
+  | Some locale -> split_locale locale in
+
   List.iter (
     fun (source, fingerprint) ->
       printf (f_"Source URI: %s\n") source;
@@ -70,11 +91,21 @@ and list_entries_long ~sources index          | Some size
->
           printf "%-24s %s\n" (s_"Download size:")
(human_size size);
         );
-        (match notes with
-        | ("", notes) :: _ ->
+        let notes = List.fold_left (
+          fun acc lang ->
+            match List.filter (
+              fun (langkey, _) ->
+                match langkey with
+                | "C" -> lang = ""
+                | langkey -> langkey = lang
+            ) notes with
+            | (_, noteskey) :: _ -> noteskey :: acc
+            | [] -> acc
+        ) [] langs in
+        (match List.rev notes with
+        | notes :: _ ->
           printf "\n";
           printf (f_"Notes:\n\n%s\n") notes
-        | _ :: _
         | [] -> ()
         );
         printf "\n"
@@ -108,10 +139,20 @@ and list_entries_json ~sources index      | Some n ->
       printf "    \"%s\": \"%Ld\",\n" key n in
   let print_notes = function
-    | ("", notes) :: _ ->
-      printf "    \"notes\": \"%s\",\n"
(json_string_escape notes)
-    | _ :: _
-    | _ -> () in
+    | [] -> ()
+    | notes ->
+      printf "    \"notes\": {\n";
+      iteri (
+        fun i (lang, langnotes) ->
+          let lang +            match lang with
+            | "" -> "C"
+            | x -> x in
+          printf "      \"%s\": \"%s\"%s\n"
+            (json_string_escape lang) (json_string_escape langnotes)
+            (trailing_comma i (List.length notes))
+      ) notes;
+      printf "    },\n" in
 
   printf "{\n";
   printf "  \"version\": %d,\n" 1;
diff --git a/builder/setlocale-c.c b/builder/setlocale-c.c
new file mode 100644
index 0000000..e1ad75d
--- /dev/null
+++ b/builder/setlocale-c.c
@@ -0,0 +1,59 @@
+/* virt-builder
+ * Copyright (C) 2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * 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 General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA.
+ */
+
+#include <config.h>
+
+#include <locale.h>
+
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+static const int lc_string_table[7] = {
+  LC_ALL,
+  LC_CTYPE,
+  LC_NUMERIC,
+  LC_TIME,
+  LC_COLLATE,
+  LC_MONETARY,
+  LC_MESSAGES
+};
+
+#define Val_none (Val_int (0))
+
+value
+virt_builder_setlocale (value val_category, value val_name)
+{
+  CAMLparam2 (val_category, val_name);
+  CAMLlocal2 (rv, rv2);
+  char *ret, *locstring;
+  int category;
+
+  category = lc_string_table[Int_val (val_category)];
+  locstring = val_name == Val_none ? NULL : String_val (Field (val_name, 0));
+  ret = setlocale (category, locstring);
+  if (ret) {
+    rv2 = caml_copy_string (ret);
+    rv = caml_alloc (1, 0);
+    Store_field (rv, 0, rv2);
+  } else
+    rv = Val_none;
+
+  CAMLreturn (rv);
+}
diff --git a/builder/setlocale.ml b/builder/setlocale.ml
new file mode 100644
index 0000000..9b3289d
--- /dev/null
+++ b/builder/setlocale.ml
@@ -0,0 +1,29 @@
+(* virt-builder
+ * Copyright (C) 2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * 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 General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+type localecategory +  | LC_ALL
+  | LC_CTYPE
+  | LC_NUMERIC
+  | LC_TIME
+  | LC_COLLATE
+  | LC_MONETARY
+  | LC_MESSAGES
+;;
+
+external setlocale : localecategory -> string option -> string option =
"virt_builder_setlocale"
diff --git a/builder/setlocale.mli b/builder/setlocale.mli
new file mode 100644
index 0000000..1e34204
--- /dev/null
+++ b/builder/setlocale.mli
@@ -0,0 +1,30 @@
+(* virt-builder
+ * Copyright (C) 2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * 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 General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+type localecategory +  | LC_ALL
+  | LC_CTYPE
+  | LC_NUMERIC
+  | LC_TIME
+  | LC_COLLATE
+  | LC_MONETARY
+  | LC_MESSAGES
+;;
+
+val setlocale : localecategory -> string option -> string option
+(** [setlocale category newlocale] Tiny wrapper to the C [setlocale]. *)
diff --git a/builder/test-virt-builder-list.sh
b/builder/test-virt-builder-list.sh
index c3b791f..634254d 100755
--- a/builder/test-virt-builder-list.sh
+++ b/builder/test-virt-builder-list.sh
@@ -119,49 +119,63 @@ if [ "$json_list" != "{
     \"os-version\": \"phony-debian\",
     \"full-name\": \"Phony Debian\",
     \"size\": 536870912,
-    \"notes\": \"Phony Debian look-alike used for
testing.\",
+    \"notes\": {
+      \"C\": \"Phony Debian look-alike used for testing.\"
+    },
     \"hidden\": false
   },
   {
     \"os-version\": \"phony-fedora\",
     \"full-name\": \"Phony Fedora\",
     \"size\": 1073741824,
-    \"notes\": \"Phony Fedora look-alike used for
testing.\",
+    \"notes\": {
+      \"C\": \"Phony Fedora look-alike used for testing.\"
+    },
     \"hidden\": false
   },
   {
     \"os-version\": \"phony-fedora-qcow2\",
     \"full-name\": \"Phony Fedora qcow2\",
     \"size\": 1073741824,
-    \"notes\": \"Phony Fedora look-alike used for
testing.\",
+    \"notes\": {
+      \"C\": \"Phony Fedora look-alike used for testing.\"
+    },
     \"hidden\": false
   },
   {
     \"os-version\": \"phony-fedora-qcow2-uncompressed\",
     \"full-name\": \"Phony Fedora qcow2 uncompressed\",
     \"size\": 1073741824,
-    \"notes\": \"Phony Fedora look-alike used for
testing.\",
+    \"notes\": {
+      \"C\": \"Phony Fedora look-alike used for testing.\"
+    },
     \"hidden\": false
   },
   {
     \"os-version\": \"phony-fedora-no-format\",
     \"full-name\": \"Phony Fedora\",
     \"size\": 1073741824,
-    \"notes\": \"Phony Fedora look-alike used for
testing.\",
+    \"notes\": {
+      \"C\": \"Phony Fedora look-alike used for testing.\"
+    },
     \"hidden\": false
   },
   {
     \"os-version\": \"phony-ubuntu\",
     \"full-name\": \"Phony Ubuntu\",
     \"size\": 536870912,
-    \"notes\": \"Phony Ubuntu look-alike used for
testing.\",
+    \"notes\": {
+      \"C\": \"Phony Ubuntu look-alike used for testing.\"
+    },
     \"hidden\": false
   },
   {
     \"os-version\": \"phony-windows\",
     \"full-name\": \"Phony Windows\",
     \"size\": 536870912,
-    \"notes\": \"Phony Windows look-alike used for
testing.\",
+    \"notes\": {
+      \"C\": \"Phony Windows look-alike used for testing.\"
+    },
     \"hidden\": false
   }
   ]
diff --git a/po/POTFILES b/po/POTFILES
index 7ded4c4..c0d20f0 100644
--- a/po/POTFILES
+++ b/po/POTFILES
@@ -5,6 +5,7 @@ builder/index-scan.c
 builder/index-struct.c
 builder/index-validate.c
 builder/pxzcat-c.c
+builder/setlocale-c.c
 cat/cat.c
 cat/filesystems.c
 cat/ls.c
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index ea73c8b..cd869fb 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -5,6 +5,7 @@ builder/get_kernel.ml
 builder/index_parser.ml
 builder/list_entries.ml
 builder/pxzcat.ml
+builder/setlocale.ml
 builder/sigchecker.ml
 mllib/common_gettext.ml
 mllib/common_utils.ml
-- 
1.8.3.1

On Thu, Jan 30, 2014 at 02:44:12PM +0100, Pino Toscano
wrote:
> +  let l = ref [] in
'xs' is a bit more natural for lists of things than 'l'.
> +  if Str.string_match regex loc 0 then (
> +    let match_or_empty n > +      try Str.matched_group n loc with
> +      | Not_found -> "" in
My preference is to put 'in' on a separate line if you're defining a
function (as here), and 'in' at the end of the line if you're
defining
a value.

So I would have written this:

  let match_or_empty n     try Str.matched_group n loc with Not_found ->
""
   in
> +        let notes = List.fold_left (
> +          fun acc lang ->
> +            match List.filter (
> +              fun (langkey, _) ->
> +                match langkey with
> +                | "C" -> lang = ""
> +                | langkey -> langkey = lang
> +            ) notes with
> +            | (_, noteskey) :: _ -> noteskey :: acc
> +            | [] -> acc
> +        ) [] langs in
I've noticed you like to put huge expressions between match .. with!

Let bindings can be nested arbitrarily, and are scoped to just the
current level, so this might be easier to read:

  fun acc lang ->
    let notes = List.filter (
      function
      | ("C", _) -> lang = ""
      | (langkey, _) -> lang = langkey
    ) notes in
    match notes with
    ...etc...

Rest seems fine so ACK.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
virt-df lists disk usage of guests without needing to install any
software inside the virtual machine.  Supports Linux and Windows.
http://people.redhat.com/~rjones/virt-df/

On Thursday 30 January 2014 15:52:05 Richard W.M. Jones
wrote:
> On Thu, Jan 30, 2014 at 02:44:12PM +0100, Pino Toscano wrote:
> > +  let l = ref [] in
> 
> 'xs' is a bit more natural for lists of things than 'l'.
> 
> > +  if Str.string_match regex loc 0 then (
> > +    let match_or_empty n > > +      try Str.matched_group n loc
with
> > +      | Not_found -> "" in
> 
> My preference is to put 'in' on a separate line if you're
defining a
> function (as here), and 'in' at the end of the line if you're
defining
> a value.
> 
> So I would have written this:
> 
>   let match_or_empty n >     try Str.matched_group n loc with Not_found
-> ""
>    in
Ah OK.
> > +        let notes = List.fold_left (
> > +          fun acc lang ->
> > +            match List.filter (
> > +              fun (langkey, _) ->
> > +                match langkey with
> > +                | "C" -> lang = ""
> > +                | langkey -> langkey = lang
> > +            ) notes with
> > +            | (_, noteskey) :: _ -> noteskey :: acc
> > +            | [] -> acc
> > +        ) [] langs in
> 
> I've noticed you like to put huge expressions between match .. with!
You are right, it started with less stuff, and then I didn't realize how 
big it became :) I just split as you hinted above, and also for the 
List.rev notes.
> Rest seems fine so ACK.
Fixed and pushed, thanks.

-- 
Pino Toscano