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 (* 'pr' prints to the current output file. *)
  27 let chan = ref Pervasives.stdout
  28 let lines = ref 0
  29 let pr fs =
  30   ksprintf
  31     (fun str ->
  32        let i = count_chars '\n' str in
  33        lines := !lines + i;
  34        output_string !chan str
  35     ) fs
  36
  37 let output_to filename k =
  38   let filename_new = filename ^ ".new" in
  39   chan := open_out filename_new;
  40   k ();
  41   close_out !chan;
  42   chan := Pervasives.stdout;
  43
  44   (* Is the new file different from the current file? *)
  45   if Sys.file_exists filename && files_equal filename filename_new then
  46     unlink filename_new                 (* same, so skip it *)
  47   else (
  48     (* different, overwrite old one *)
  49     (try chmod filename 0o644 with Unix_error _ -> ());
  50     rename filename_new filename;
  51     chmod filename 0o444;
  52     printf "written %s\n%!" filename;
  53   )
  54
  55 let get_lines_generated () =
  56   !lines