Optional:
OCaml gettext
OCaml xml-light
-OCaml CSV
OCaml Calendar, version 2 is preferred
perldoc
msgfmt
dnl Check for optional OCaml packages.
AC_CHECK_OCAML_PKG(calendar)
-AC_CHECK_OCAML_PKG(csv)
AC_CHECK_OCAML_PKG(gettext)
AC_CHECK_OCAML_PKG(xml-light)
AM_CONDITIONAL([HAVE_PKG_CALENDAR], [test "x$OCAML_PKG_calendar" != "xno"])
-AM_CONDITIONAL([HAVE_PKG_CSV], [test "x$OCAML_PKG_csv" != "xno"])
AM_CONDITIONAL([HAVE_PKG_GETTEXT], [test "x$OCAML_PKG_gettext" != "xno"])
AM_CONDITIONAL([HAVE_PKG_XML_LIGHT],[test "x$OCAML_PKG_xml_light" != "xno"])
opt_calendar.cmx : \
top.cmx \
opt_gettext.cmx
-opt_csv.cmo : \
- top.cmi \
- opt_gettext.cmo \
- csv_output.cmi
-opt_csv.cmx : \
- top.cmx \
- opt_gettext.cmx \
- csv_output.cmx
opt_gettext.cmo :
opt_gettext.cmx :
opt_xml.cmo : \
dummy.c \
main.ml \
opt_calendar.ml \
- opt_csv.ml \
opt_gettext.ml \
opt_xml.ml \
redraw.ml \
BOBJS += opt_xml.cmo
OCAMLPACKAGES += -package xml-light
endif
-if HAVE_PKG_CSV
-BOBJS += opt_csv.cmo
-OCAMLPACKAGES += -package csv
-endif
if HAVE_PKG_CALENDAR
BOBJS += opt_calendar.cmo
OCAMLPACKAGES += -package calendar
The reason for having it in a separate file is so that we
don't depend on xml-light.
- opt_csv.ml
-
- Any code which needs the optional ocaml-csv library goes
- in here.
-
opt_calendar.ml
Any code which needs the optional ocaml-calendar library
main.ml
This is just a small bit of code to glue the modules together
- Top + Opt_xml? + Opt_csv? + Opt_calendar?
+ Top + Opt_xml? + Opt_calendar?
The man-page is generated from the single file:
(* '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
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";
) doms in
let domain_fields = List.flatten domain_fields in
- (!csv_write) (summary_fields @ domain_fields)
+ csv_write (summary_fields @ domain_fields)
(* '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
(** CSV output functions. *)
-(* Hook for [Opt_csv] to override (if present). *)
-val csv_write : (string list -> unit) ref
+val csv_set_filename : string -> unit
val write_csv_header : bool * bool * bool * bool -> bool -> unit
+++ /dev/null
-(* 'top'-like tool for libvirt domains.
- (C) Copyright 2007-2009 Richard W.M. Jones, Red Hat Inc.
- http://libvirt.org/
-
- 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., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- This file contains all code which requires CSV support.
-*)
-
-open Opt_gettext.Gettext
-
-(* Output channel, or None if CSV output not enabled. *)
-let chan = ref None ;;
-
-Top.csv_start :=
- fun filename ->
- chan := Some (open_out filename) ;;
-
-Csv_output.csv_write :=
- fun row ->
- match !chan with
- | None -> () (* CSV output not enabled. *)
- | Some chan ->
- Csv.save_out chan [row];
- (* Flush the output to the file immediately because we don't
- * explicitly close this file.
- *)
- flush chan
let rcfile = ".virt-toprc"
-(* Hooks for CSV support (see [opt_csv.ml]). *)
-let csv_start : (string -> unit) ref =
- ref (
- fun _ -> failwith (s_"virt-top was compiled without support for CSV files")
- )
-
(* Hook for calendar support (see [opt_calendar.ml]). *)
let parse_date_time : (string -> float) ref =
ref (
and set_net_mode () = display_mode := NetDisplay
and set_block_mode () = display_mode := BlockDisplay
and set_csv filename =
- (!csv_start) filename;
+ Csv_output.csv_set_filename filename;
csv_enabled := true
and no_init_file () = init_file := NoInitFile
and set_init_file filename = init_file := InitFile filename
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)
-(* Hook for [Opt_csv] to override (if present). *)
-val csv_start : (string -> unit) ref
-
(* Hook for [Opt_calendar] to override (if present). *)
val parse_date_time : (string -> float) ref
virt-top (but the column headers will stay the same, so you can use
those to process the CSV file).
-Not every version of virt-top supports CSV output - it depends how the
-program was compiled (see I<README> file in the source distribution
-for details).
-
To save space you can compress your CSV files (if your shell supports
this feature, eg. I<bash>):
git.annexia.org / virt-top.git / commitdiff