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