virt-ctrl/vc_helpers.ml

   1 (* virt-ctrl: A graphical management tool.
   2    (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4
   5    This program is free software; you can redistribute it and/or modify
   6    it under the terms of the GNU General Public License as published by
   7    the Free Software Foundation; either version 2 of the License, or
   8    (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful,
  11    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13    GNU General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18 *)
  19
  20 open Virt_ctrl_gettext.Gettext
  21
  22 module C = Libvirt.Connect
  23 module D = Libvirt.Domain
  24 module N = Libvirt.Network
  25
  26 (* Given two lists, xs and ys, return a list of items which have been
  27  * added to ys, items which are the same, and items which have been
  28  * removed from ys.
  29  * Returns a triplet (list of added, list of same, list of removed).
  30  *)
  31 let differences xs ys =
  32   let rec d = function
  33     | [], [] -> (* Base case. *)
  34         ([], [], [])
  35     | [], ys -> (* All ys have been added. *)
  36         (ys, [], [])
  37     | xs, [] -> (* All xs have been removed. *)
  38         ([], [], xs)
  39     | (x :: xs), (y :: ys) when x = y -> (* Not added or removed. *)
  40         let added, unchanged, removed = d (xs, ys) in
  41         added, x :: unchanged, removed
  42     | (x :: xs), ((y :: _) as ys) when x < y -> (* x removed. *)
  43         let added, unchanged, removed = d (xs, ys) in
  44         added, unchanged, x :: removed
  45     | ((x :: _) as xs), (y :: ys) (* when x > y *) -> (* y added. *)
  46         let added, unchanged, removed = d (xs, ys) in
  47         y :: added, unchanged, removed
  48   in
  49   d (List.sort compare xs, List.sort compare ys)
  50
  51 let string_of_domain_state = function
  52   | D.InfoNoState -> s_ "unknown"
  53   | D.InfoRunning -> s_ "running"
  54   | D.InfoBlocked -> s_ "blocked"
  55   | D.InfoPaused -> s_ "paused"
  56   | D.InfoShutdown -> s_ "shutdown"
  57   | D.InfoShutoff -> s_ "shutoff"
  58   | D.InfoCrashed -> s_ "crashed"
  59
  60 (* Filter top level rows (only) in a tree_store.  If function f returns
  61  * true then the row remains, but if it returns false then the row is
  62  * removed.
  63  *)
  64 let rec filter_top_level_rows (model : GTree.tree_store) f =
  65   match model#get_iter_first with
  66   | None -> ()
  67   | Some iter -> filter_rows model f iter
  68
  69 (* Filter rows in a tree_store at a particular level. *)
  70 and filter_rows model f row =
  71   let keep = f row in
  72   let iter_still_valid =
  73     if not keep then model#remove row else model#iter_next row in
  74   if iter_still_valid then filter_rows model f row
  75
  76 (* Find the first top level row matching predicate f and return it. *)
  77 let rec find_top_level_row (model : GTree.tree_store) f =
  78   match model#get_iter_first with
  79   | None -> raise Not_found (* no rows *)
  80   | Some row -> find_row model f row
  81
  82 (* Find the first row matching predicate f at a particular level. *)
  83 and find_row model f row =
  84   if f row then row
  85   else if model#iter_next row then find_row model f row
  86   else raise Not_found
  87
  88 (* Iterate over top level rows (only) in a tree_store. *)
  89 let rec iter_top_level_rows (model : GTree.tree_store) f =
  90   match model#get_iter_first with
  91   | None -> ()
  92   | Some iter -> iter_rows model f iter
  93
  94 (* Iterate over rows in a tree_store at a particular level. *)
  95 and iter_rows model f row =
  96   f row;
  97   if model#iter_next row then iter_rows model f row