generator/wrappi_pr.ml

   1 (* wrappi
   2  * Copyright (C) 2011 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 open Unix
  20 open Printf
  21
  22 open Wrappi_utils
  23
  24 (* Output channel, 'pr' prints to this. *)
  25 let chan = ref Pervasives.stdout
  26
  27 (* Number of lines generated. *)
  28 let lines = ref 0
  29
  30 (* Name of each file generated. *)
  31 let files = ref []
  32
  33 (* Print-to-current-output function, used everywhere.  It has
  34  * printf-like semantics.
  35  *)
  36 let pr fs =
  37   ksprintf
  38     (fun str ->
  39        let i = count_chars '\n' str in
  40        lines := !lines + i;
  41        output_string !chan str
  42     ) fs
  43
  44 let output_to filename k a =
  45   files := filename :: !files;
  46
  47   let filename_new = filename ^ ".new" in
  48   chan := open_out filename_new;
  49   k a;
  50   close_out !chan;
  51   chan := Pervasives.stdout;
  52
  53   (* Is the new file different from the current file? *)
  54   if Sys.file_exists filename && files_equal filename filename_new then
  55     unlink filename_new                 (* same, so skip it *)
  56   else (
  57     (* different, overwrite old one *)
  58     (try chmod filename 0o644 with Unix_error _ -> ());
  59     rename filename_new filename;
  60     chmod filename 0o444;
  61     printf "written %s\n%!" filename;
  62   )
  63
  64 let get_lines_generated () =
  65   !lines
  66
  67 let get_files_generated () =
  68   List.rev !files