X-Git-Url: http://git.annexia.org/?p=virt-top.git;a=blobdiff_plain;f=src%2Fcsv_output.ml;h=f23d673cf14dc19e0f8fc4388400cae3ddfe8a8c;hp=cb373d5b6175279dd432a5ce59ac195207f58cdd;hb=HEAD;hpb=1aedabd0caf7a0562a3f314dddd13d49e0165c92

diff --git a/src/csv_output.ml b/src/csv_output.ml
index cb373d5..42fed9d 100644
--- a/src/csv_output.ml
+++ b/src/csv_output.ml
@@ -1,5 +1,5 @@
 (* 'top'-like tool for libvirt domains.
-   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   (C) Copyright 2007-2021 Richard W.M. Jones, Red Hat Inc.
    http://libvirt.org/
 
    This program is free software; you can redistribute it and/or modify
@@ -26,15 +26,97 @@ open Collect
 
 module C = Libvirt.Connect
 
-(* Hook for CSV support (see [opt_csv.ml]). *)
-let csv_write : (string list -> unit) ref =
-  ref (
-    fun _ -> ()
+let chan = ref None
+
+let csv_set_filename filename = chan := Some (open_out filename)
+
+(* This code is adapted from OCaml CSV, published under the LGPLv2+
+ * which is compatible with the license of virt-top.
+ *)
+
+let nl = Bytes.make 1 '\n'
+let comma = Bytes.make 1 ','
+let quote = Bytes.make 1 '"'
+let output_newline chan = output chan nl 0 1
+let output_comma chan = output chan comma 0 1
+let output_quote chan = output chan quote 0 1
+
+let is_space_or_tab c = c = ' ' || c = '\t'
+
+let must_escape = Array.make 256 false
+let () =
+  List.iter (fun c -> must_escape.(Char.code c) <- true)
+            ['\"'; '\\';  '\000'; '\b'; '\n'; '\r'; '\t'; '\026']
+
+let must_quote chan s len =
+  let quote = ref (is_space_or_tab (String.unsafe_get s 0)
+                   || is_space_or_tab (String.unsafe_get s (len - 1))) in
+  let n = ref 0 in
+  for i = 0 to len-1 do
+    let c = String.unsafe_get s i in
+    if c = ',' || c = '\n' || c = '\r' then quote := true
+    else if c = '"' then (
+      quote := true;
+      incr n
+    )
+  done;
+  if !quote then !n else -1
+
+let write_escaped chan field =
+  let len = String.length field in
+  if len > 0 then (
+    let n = must_quote chan field len in
+    if n < 0 then
+      output chan (Bytes.unsafe_of_string field) 0 len
+    else (
+      let field =
+        if n <= 0 then Bytes.unsafe_of_string field
+        else (* There are some quotes to escape *)
+          let s = Bytes.create (len + n) in
+          let j = ref 0 in
+          for i = 0 to len - 1 do
+            let c = String.unsafe_get field i in
+            if c = '"' then (
+              Bytes.unsafe_set s !j '"'; incr j;
+              Bytes.unsafe_set s !j '"'; incr j
+            )
+            else (Bytes.unsafe_set s !j c; incr j)
+          done;
+          s
+      in
+      output_quote chan;
+      output chan field 0 (Bytes.length field);
+      output_quote chan
+    )
   )
 
+let save_out chan = function
+  | [] -> output_newline chan
+  | [f] ->
+     write_escaped chan f;
+     output_newline chan
+  | f :: tl ->
+     write_escaped chan f;
+     List.iter (
+       fun f ->
+         output_comma chan;
+         write_escaped chan f
+     ) tl;
+     output_newline chan
+
+let csv_write row =
+  match !chan with
+  | None -> ()                  (* CSV output not enabled *)
+  | Some chan ->
+     save_out chan row;
+     (* Flush the output to the file immediately because we don't
+      * explicitly close the channel.
+      *)
+     flush chan
+
 (* Write CSV header row. *)
 let write_csv_header (csv_cpu, csv_mem, csv_block, csv_net) block_in_bytes =
-  (!csv_write) (
+  csv_write (
     [ "Hostname"; "Time"; "Arch"; "Physical CPUs";
       "Count"; "Running"; "Blocked"; "Paused"; "Shutdown";
       "Shutoff"; "Crashed"; "Active"; "Inactive";
@@ -121,4 +203,4 @@ let append_csv (_, _, _, _, _, node_info, hostname, _) (* setup *)
   ) doms in
   let domain_fields = List.flatten domain_fields in
 
-  (!csv_write) (summary_fields @ domain_fields)
+  csv_write (summary_fields @ domain_fields)