[Pkg-ocaml-maint-commits] r1213 - trunk/tools/dh_ocaml

Stefano Zacchiroli zack@costa.debian.org
Wed, 06 Apr 2005 15:01:26 +0000


Author: zack
Date: 2005-04-06 15:01:26 +0000 (Wed, 06 Apr 2005)
New Revision: 1213

Modified:
   trunk/tools/dh_ocaml/ocaml-md5sums.ml
Log:
- implemented update action
- added registry iterator
- better command line syntax
- tested (and fixed) compute and dep actions
- added support for reading objects list from stdin
- added logging and verbosity
- added copyright information


Modified: trunk/tools/dh_ocaml/ocaml-md5sums.ml
===================================================================
--- trunk/tools/dh_ocaml/ocaml-md5sums.ml	2005-04-06 09:28:04 UTC (rev 1212)
+++ trunk/tools/dh_ocaml/ocaml-md5sums.ml	2005-04-06 15:01:26 UTC (rev 1213)
@@ -1,3 +1,24 @@
+(*
+ * ocaml-md5sums - use and maintain debian registry of ocaml md5sums
+ *
+ * Copyright (C) 2005, Stefano Zacchiroli <zack@debian.org>
+ *
+ * Created:        Wed, 06 Apr 2005 16:55:39 +0200 zack
+ * Last-Modified:  Wed, 06 Apr 2005 16:55:39 +0200 zack
+ *
+ * This is free software, you can redistribute it and/or modify it under the
+ * terms of the GNU General Public License version 2 as published by the Free
+ * Software Foundation.
+ *
+ * This program is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+ * details.
+ *
+ * You should have received a copy of the GNU General Public License along with
+ * this program; if not, write to the Free Software Foundation, Inc., 59 Temple
+ * Place, Suite 330, Boston, MA  02111-1307  USA
+ *)
 
 open Printf
 
@@ -11,31 +32,34 @@
 
 (** {2 Regular expressions, for parsing} *)
 
-let unit_name_RE =
-  Str.regexp "^[ \\t]*Unit[ \\t]+name[ \\t]*:[ \\t]*\\([a-zA-Z0-9_]+\\)[ \\t]*$"
-let md5sum_RE =
-  Str.regexp "^[ \\t]*\\([a-z0-9]+\\)[ \\t]+\\([a-zA-Z0-9_]+\\)[ \\t]*$"
-let blanks_RE = Str.regexp "[ \\t]+"
+let unit_name_line_RE =
+  Str.regexp "^[ \t]*Unit[ \t]+name[ \t]*:[ \t]*\\([a-zA-Z0-9_]+\\)[ \t]*$"
+let md5sum_line_RE =
+  Str.regexp "^[ \t]*\\([a-f0-9]+\\)[ \t]+\\([a-zA-Z0-9_]+\\)[ \t]*$"
+let blanks_RE = Str.regexp "[ \t]+"
+let md5sums_ext_RE = Str.regexp (sprintf "^.*%s$" (Str.quote md5sums_ext))
 
 (** {2 Argument parsing} *)
 
 let objects = ref []
 let pkg_version = ref ""
 let pkg_name = ref ""
+let verbosity = ref 0
 let action = ref None
 
 let usage_msg =
   "Use and maintain system registry of ocaml md5sums\n"
   ^ "Usage:\n"
-  ^ "  ocaml-md5sum compute --package [name] --version [version] object ...\n"
-  ^ "  ocaml-md5sum dep     --package [name] --version [version] object ...\n"
-  ^ "  ocaml-md5sum update\n"
+  ^ " ocaml-md5sum compute --package <name> --version <version> [options] file ...\n"
+  ^ " ocaml-md5sum dep     --package <name> --version <version> [options] file ...\n"
+  ^ " ocaml-md5sum update\n"
   ^ "Options:"
 let cmdline_spec = [
   "--package", Arg.Set_string pkg_name,
     "set package name (required by compute and dep actions)";
   "--version", Arg.Set_string pkg_version,
     "set package version (required by compute and dep actions)";
+  "-v", Arg.Unit (fun () -> incr verbosity), "increase verbosity";
 ]
 let die_usage () =
   Arg.usage cmdline_spec usage_msg;
@@ -43,11 +67,12 @@
 
 (** {2 Auxiliary functions} *)
 
+let error   msg = prerr_endline ("Error: " ^ msg); exit 2
 let warning msg = prerr_endline ("Warning: " ^ msg)
+let info ?(level = 1) msg =
+  if !verbosity >= level then prerr_endline ("Info: " ^ msg)
 
-let error msg =
-  prerr_endline ("Error: " ^ msg);
-  exit 2
+module Strings = Set.Make (String)
 
 (** @param fnames list of *.cm[ao] file names
  * @return a pair of hash tables <defined_units, imported_units>. Both tables
@@ -57,17 +82,26 @@
   let (defined, imported) = (Hashtbl.create 1024, Hashtbl.create 1024) in
   List.iter
     (fun fname ->
+      info ("getting unit info from " ^ fname);
       let ic = Unix.open_process_in (sprintf "%s %s" ocamlobjinfo fname) in
-      let unit_name = ref "" in
+      let current_unit = ref "" in
       try
         while true do
-         let line = input_line ic in
-         if Str.string_match unit_name_RE line 0 then
-           unit_name := Str.matched_group 1 line
-         else if Str.string_match md5sum_RE line 0 then
-          let unit_name' = Str.matched_group 2 line in
-          let tbl = if unit_name' = !unit_name then defined else imported in
-          Hashtbl.replace tbl unit_name' (Str.matched_group 1 line)
+          let line = input_line ic in
+          if Str.string_match unit_name_line_RE line 0 then
+            current_unit := Str.matched_group 1 line
+          else if Str.string_match md5sum_line_RE line 0 then
+            let md5sum = Str.matched_group 1 line in
+            let unit_name = Str.matched_group 2 line in
+            if unit_name = !current_unit then begin
+              info ~level:2 (sprintf "defined unit %s with md5sum %s"
+                unit_name md5sum);
+              Hashtbl.replace defined unit_name md5sum
+            end else begin
+              info ~level:2 (sprintf "imported unit %s with md5sum %s"
+                unit_name md5sum);
+              Hashtbl.replace imported unit_name md5sum
+            end
         done
       with End_of_file -> close_in ic)
     fnames;
@@ -76,53 +110,98 @@
     defined;
   (defined, imported)
 
-(** @param fname file name of the registry file
- * @return an hashtbl mapping pairs <unit_name, md5sum> to pairs <package_name,
- * version_info>. E.g. ("Foo_bar", "74be7fa4320ebd9415f1c7cfc04c2d7b") ->
- * ("libfoo-ocaml-dev", ">= 1.2.3-4") *)
-let parse_registry fname =
-  let registry = Hashtbl.create 1024 in
+(** iter a function over the entries of a registry file
+ * @param f function to be executed for each entries, it takes 4 labeled
+ * arguments: ~md5sum ~unit_name ~package ~version
+ * @param fname file containining the registry *)
+let iter_registry f fname =
   let ic = open_in fname in
-  let n = ref 0 in
-  (try
+  info ("processing registry " ^ fname);
+  let lineno = ref 0 in
+  try
     while true do
-      incr n;
+      incr lineno;
       let line = input_line ic in
       (match Str.split blanks_RE line with
       | [ md5sum; unit_name; package; version ] ->
-          Hashtbl.replace registry (unit_name, md5sum) (package, version)
+          f ~md5sum ~unit_name ~package ~version
       | _ ->
-          warning (sprintf "ignoring registry entry (%s:%d)" registry_file !n))
+          warning (sprintf "ignoring registry entry (%s, line %d)"
+            fname !lineno))
     done
-  with End_of_file -> close_in ic);
+  with End_of_file -> close_in ic
+
+(** @param fname file name of the registry file
+ * @return an hashtbl mapping pairs <unit_name, md5sum> to pairs <package_name,
+ * version_info>. E.g. ("Foo_bar", "74be7fa4320ebd9415f1c7cfc04c2d7b") ->
+ * ("libfoo-ocaml-dev", ">= 1.2.3-4") *)
+let parse_registry fname =
+  let registry = Hashtbl.create 1024 in
+  iter_registry
+    (fun ~md5sum ~unit_name ~package ~version ->
+      Hashtbl.replace registry (unit_name, md5sum) (package, version))
+    fname;
   registry
 
+(** read until the end of standard input
+ * @return the list of lines read from stdin, without trailing "\n" *)
+let read_stdin () =
+  let lines = ref [] in
+  try
+    while true do lines := input_line stdin :: !lines done;
+    []  (* dummy value *)
+  with End_of_file -> List.rev !lines
+
 (** {2 Main functions, one for each command line action} *)
 
-let compute ~package ~version () =
-  if (package = "" || version = "") then die_usage ();
-  let defined, _ = unit_info !objects in
+(** compute registry entry for a set of ocaml objects *)
+let compute ~package ~version objects () =
+  let defined, _ = unit_info objects in
   Hashtbl.iter
     (fun unit_name md5sum ->
       printf "%s %s %s %s\n" md5sum unit_name package version)
     defined
 
-let dep ~package ~version () =
-  if (package = "" || version = "") then die_usage ();
-  let _, imported = unit_info !objects in
+(** compute package dependencies for a set of ocaml objects *)
+let dep ~package ~version objects () =
+  let _, imported = unit_info objects in
   let registry = parse_registry registry_file in
-  Hashtbl.iter
-    (fun unit_name md5sum ->
-      try
-        let (package, version) = Hashtbl.find registry (unit_name, md5sum) in
-        printf "%s %s\n" package version
-      with Not_found -> ())
-    imported
+  let deps =
+    Hashtbl.fold
+      (fun unit_name md5sum deps ->
+        try
+          let (package, version) = Hashtbl.find registry (unit_name, md5sum) in
+          Strings.add (sprintf "%s %s" package version) deps
+        with Not_found -> deps)
+      imported
+      Strings.empty
+  in
+  Strings.iter print_endline deps
 
-let update () = failwith "not implemented"  (* TODO *)
+(** update debian registry of ocaml md5sums *)
+let update () =
+  info (sprintf "updating registry %s using info from %s/"
+    registry_file md5sums_dir);
+  let registry = open_out registry_file in
+  let dir = Unix.opendir md5sums_dir in
+  try
+    while true do
+      let fname = sprintf "%s/%s" md5sums_dir (Unix.readdir dir) in
+      if (Str.string_match md5sums_ext_RE fname 0)
+        && ((Unix.stat fname).Unix.st_kind = Unix.S_REG)
+      then
+        iter_registry
+          (fun ~md5sum ~unit_name ~package ~version ->
+            fprintf registry "%s %s %s %s\n" md5sum unit_name package version)
+          fname
+    done
+  with End_of_file ->
+    Unix.closedir dir;
+    close_out registry
 
 (** {2 Main} *)
 
+(** main *)
 let main () =
   Arg.parse cmdline_spec
     (fun s ->
@@ -131,13 +210,21 @@
       else
         objects := s :: !objects)
     usage_msg;
-  objects := List.rev !objects;
-  let package, version = !pkg_name, !pkg_version in
   match !action with
-  | Some "compute" -> compute ~package ~version ()
-  | Some "dep" -> dep ~package ~version ()
   | Some "update" -> update ()
-  | _ -> die_usage ()
+  | Some action ->
+      let package, version = !pkg_name, !pkg_version in
+      if (package = "" || version = "") then die_usage ();
+      let objects =
+        match !objects with
+        | [] -> read_stdin ()
+        | objects -> List.rev objects
+      in
+      (match action with
+      | "compute" -> compute ~package ~version objects ()
+      | "dep" -> dep ~package ~version objects ()
+      | _ -> die_usage ())
+  | None -> die_usage ()
 
-let _ = main ()
+let _ = Unix.handle_unix_error main ()