configure: Fix info about virt-resize when OCaml bindings are disabled.
[libguestfs.git] / generator / generator_pr.ml
1 (* libguestfs
2  * Copyright (C) 2009-2010 Red Hat Inc.
3  *
4  * This program is free software; you can redistribute it and/or modify
5  * it under the terms of the GNU General Public License as published by
6  * the Free Software Foundation; either version 2 of the License, or
7  * (at your option) any later version.
8  *
9  * This program is distributed in the hope that it will be useful,
10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12  * GNU General Public License for more details.
13  *
14  * You should have received a copy of the GNU General Public License
15  * along with this program; if not, write to the Free Software
16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
17  *)
18
19 (* Please read generator/README first. *)
20
21 open Unix
22 open Printf
23
24 open Generator_utils
25
26 (* Output channel, 'pr' prints to this. *)
27 let chan = ref Pervasives.stdout
28
29 (* Number of lines generated. *)
30 let lines = ref 0
31
32 (* Name of each file generated. *)
33 let files = ref []
34
35 (* Print-to-current-output function, used everywhere.  It has
36  * printf-like semantics.
37  *)
38 let pr fs =
39   ksprintf
40     (fun str ->
41        let i = count_chars '\n' str in
42        lines := !lines + i;
43        output_string !chan str
44     ) fs
45
46 let output_to filename k =
47   files := filename :: !files;
48
49   let filename_new = filename ^ ".new" in
50   chan := open_out filename_new;
51   k ();
52   close_out !chan;
53   chan := Pervasives.stdout;
54
55   (* Is the new file different from the current file? *)
56   if Sys.file_exists filename && files_equal filename filename_new then
57     unlink filename_new                 (* same, so skip it *)
58   else (
59     (* different, overwrite old one *)
60     (try chmod filename 0o644 with Unix_error _ -> ());
61     rename filename_new filename;
62     chmod filename 0o444;
63     printf "written %s\n%!" filename;
64   )
65
66 let get_lines_generated () =
67   !lines
68
69 let get_files_generated () =
70   List.rev !files