[Pkg-ocaml-maint-commits] r6289 - in /trunk/tools/ocaml_transition_monitor: Makefile ocaml_transition_monitor.mll
glondu-guest at users.alioth.debian.org
glondu-guest at users.alioth.debian.org
Sat Feb 28 15:41:23 UTC 2009
Author: glondu-guest
Date: Sat Feb 28 15:41:23 2009
New Revision: 6289
URL: http://svn.debian.org/wsvn/?sc=1&rev=6289
Log:
Cache, topological sort, comments
* Add --use-cache option, to bypass the very long parsing stage
* Group packages by their level in the dependency graph
* Add some comments
Modified:
trunk/tools/ocaml_transition_monitor/Makefile
trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll
Modified: trunk/tools/ocaml_transition_monitor/Makefile
URL: http://svn.debian.org/wsvn/trunk/tools/ocaml_transition_monitor/Makefile?rev=6289&op=diff
==============================================================================
--- trunk/tools/ocaml_transition_monitor/Makefile (original)
+++ trunk/tools/ocaml_transition_monitor/Makefile Sat Feb 28 15:41:23 2009
@@ -4,7 +4,7 @@
@./ocaml_transition_monitor.byte --quiet
%.byte: %.ml
- ocamlfind ocamlc -package ocsigen.xhtml,str -linkpkg -o $@ $<
+ ocamlfind ocamlc -package ocsigen.xhtml,str,ocamlgraph -linkpkg -o $@ $<
%.ml: %.mll
ocamllex $<
Modified: trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll
URL: http://svn.debian.org/wsvn/trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll?rev=6289&op=diff
==============================================================================
--- trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll (original)
+++ trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll Sat Feb 28 15:41:23 2009
@@ -6,7 +6,7 @@
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
- Dependencies: wget, bzip2, ocsigen-dev.
+ Dependencies: wget, bzip2, ocsigen-dev, libocamlgraph-ocaml-dev.
*)
{
@@ -54,9 +54,28 @@
let skip_download = ref false
let quiet_mode = ref false
+ let use_cache = ref false
let progress x =
if !quiet_mode then ifprintf stderr x else fprintf stderr x
+
+ let find x xs =
+ try M.find x xs
+ with Not_found -> invalid_arg ("Not_found: "^x)
+
+ module G = struct
+ module V = struct
+ type t = string
+ let equal = (=)
+ let hash = Hashtbl.hash
+ end
+ type t = S.t M.t * S.t M.t
+ let iter_vertex f (_, deps) = M.iter (fun k _ -> f k) deps
+ let iter_succ f (deps, _) pkg = S.iter f (find pkg deps)
+ let in_degree (_, rdeps) pkg = S.cardinal (find pkg rdeps)
+ end
+
+ module Topological = Graph.Topological.Make(G)
}
let name = ['A'-'Z' 'a'-'z' '0'-'9' '-' '.' ':' '~' '+']+
@@ -91,6 +110,10 @@
| None -> invalid_arg ("Not_found: "^x)
| Some y -> y
+ (**
+ @param channel a Sources file
+ @return a [source_package M.t] indexed by source package names
+ *)
let parse_source channel =
let lexbuf = Lexing.from_channel channel in
let result = ref M.empty in
@@ -107,6 +130,54 @@
aux ()
in try aux () with End_of_file -> !result
+ (**
+ @param src a [source_package M.t]
+ @param bin a [string M.t] mapping binary packages to their source package
+ @return a [S.t M.t] mapping source packages to their build-dependencies
+ in terms of source packages
+ *)
+ let dep_graph src bin =
+ M.mapi
+ (fun k pkg ->
+ List.fold_left
+ (fun accu dep ->
+ try S.add (M.find dep bin) accu with Not_found -> accu)
+ S.empty pkg.sdeps)
+ src
+
+ let invert_dep_graph src =
+ M.mapi
+ (fun pkg _ ->
+ M.fold
+ (fun k deps accu -> if S.mem pkg deps then S.add k accu else accu)
+ src S.empty)
+ src
+
+ (**
+ @param dgraph [dep_graph] output
+ @return a [string list list] with topologically sorted source packages,
+ grouped by dependency level
+ *)
+ let topo_split dgraph =
+ let inverted = invert_dep_graph dgraph in
+ let (a, b) =
+ Topological.fold
+ (fun pkg (local, accu) ->
+ if S.exists (fun x -> S.mem x local) (find pkg dgraph) then
+ (* already a dependency in this level -> switch to next level *)
+ (S.add pkg S.empty, local::accu)
+ else
+ (* stay on the same level *)
+ (S.add pkg local, accu))
+ (inverted, dgraph)
+ (S.empty, [])
+ in
+ List.rev_map S.elements (a::b)
+
+ (**
+ @param channel a Packages file
+ @return a [binary_package M.t] indexed by binary package names
+ *)
let parse_binary channel =
let lexbuf = Lexing.from_channel channel in
let result = ref M.empty in
@@ -127,6 +198,10 @@
let runtime_ocaml_regexp = Str.regexp "^ocaml\\(-base\\)?\\(-nox\\)?-\\([0-9.]+\\)$"
let build_ocaml_regexp = Str.regexp "^ocaml\\(-nox\\)?$"
+ (**
+ @param x a binary package name
+ @return [Some v] if [x] depends on ABI [v], [None] otherwise
+ *)
let depends_on_ocaml x =
let rec aux = function
| [] -> None
@@ -159,8 +234,13 @@
close_out chan; res
with e -> close_out chan; raise e
- let get_arch_status arch =
- let binaries = with_in_file ("Packages."^arch) parse_binary in
+ let get_binaries arch =
+ let file = "Packages."^arch in
+ progress "Parsing %s...%!" file;
+ let r = with_in_file ("Packages."^arch) parse_binary in
+ progress "\n%!"; r
+
+ let get_arch_status binaries =
let runtime_versions = M.fold
(fun k pkg accu -> match depends_on_ocaml pkg with
| None -> accu
@@ -179,7 +259,9 @@
compiled_sources
let get_sources () =
+ progress "Parsing Packages.source...%!";
let sources = with_in_file "Packages.source" parse_source in
+ progress "\n%!";
let sources = M.fold
(fun k pkg accu ->
if build_depends_on_ocaml pkg
@@ -192,14 +274,14 @@
List.for_all
(fun arch ->
let url = sprintf "%s/dists/%s/%s/binary-%s/Packages.bz2" mirror suite section arch in
- let cmd = sprintf "wget -q -O- '%s' | bzcat > Packages.%s" url arch in
+ let cmd = sprintf "wget -q -O- '%s' | bzcat > Packages.new && mv Packages.new Packages.%s" url arch in
progress "Downloading Packages.%s...%!" arch;
let r = Sys.command cmd in
progress "\n%!";
r = 0)
architectures
&& (let url = sprintf "%s/dists/%s/%s/source/Sources.bz2" mirror suite section in
- let cmd = sprintf "wget -q -O- '%s' | bzcat > Packages.source" url in
+ let cmd = sprintf "wget -q -O- '%s' | bzcat > Packages.new && mv Packages.new Packages.source" url in
progress "Downloading Packages.source...%!";
let r = Sys.command cmd in
progress "\n%!";
@@ -217,18 +299,32 @@
in aux Unknown xs
let main () =
- let all_binaries = List.map get_arch_status architectures in
- let sources_map = get_sources () in
- let all_sources = List.sort compare
- (M.fold (fun k _ accu -> k::accu) sources_map [])
- in
+ let (sources_map, binaries) =
+ if !use_cache then begin
+ progress "Loading cache...%!";
+ let r = with_in_file "ocaml_transition_monitor.cache" Marshal.from_channel in
+ progress "\n%!"; r
+ end else begin
+ let x = (get_sources (), List.map get_binaries architectures) in
+ with_out_file "ocaml_transition_monitor.cache"
+ (fun chan -> Marshal.to_channel chan x []);
+ x
+ end
+ in
+ let all_binaries = List.map get_arch_status binaries in
+ let src_of_bin = M.fold
+ (fun src spkg accu ->
+ List.fold_left
+ (fun accu bin -> M.add bin src accu)
+ accu spkg.sbins)
+ sources_map M.empty in
+ let sections = topo_split (dep_graph sources_map src_of_bin) in
let status pkg = List.map
(fun x ->
try if M.find pkg x then Up_to_date else Outdated
with Not_found -> Unknown) all_binaries
in
- let status = List.map (fun pkg -> (pkg, status pkg)) all_sources in
- let all_sources = List.map
+ let format_section_body section = List.map
(fun (pkg, status) -> tr
(td ~a:[a_class [(class_of_status (source_status status))^" src"]; a_id pkg]
[a ~a:[a_href (uri_of_string ("http://packages.qa.debian.org/"^pkg))] [pcdata pkg];
@@ -247,13 +343,15 @@
(List.map (fun x ->
let x = class_of_status x and xx = string_of_status x
in td ~a:[a_class [x]] [small [pcdata xx]]) status))
- status
- in
- let summary = tablex
- ~thead:(thead (tr (th [pcdata "source"; span ~a:[a_id "count"] []]) (List.map (fun arch -> th [small [pcdata arch]]) architectures)) [])
- (match all_sources with x::xs -> tbody x xs | _ -> invalid_arg "there must be at least one package")
+ (List.map (fun pkg -> (pkg, status pkg)) section)
+ in
+ let thead = tr (th [pcdata "source"]) (List.map (fun arch -> th [small [pcdata arch]]) architectures) in
+ let summary_contents = List.fold_left
+ (fun accu section -> (thead::section)@accu)
[]
- in
+ (List.rev_map format_section_body sections)
+ in
+ let summary = match summary_contents with x::xs -> table x xs | _ -> assert false in
let page_title = "Monitoring OCaml transition to "^ocaml_version in
let date =
let chan = Unix.open_process_in "date -R" in
@@ -305,6 +403,7 @@
input ~a:[a_input_type `Checkbox; a_checked `Checked; a_id "bad"] ();
pcdata "bad ";
input ~a:[a_input_type `Checkbox; a_id "unknown"] (); pcdata "unknown";
+ span ~a:[a_id "count"] [];
];
div ~a:[a_class ["status"]] [summary];
div ~a:[a_class ["footer"]] footer])
@@ -315,9 +414,10 @@
let _ =
let speclist = [
"--skip-download", Arg.Set skip_download, "Skip downloading package list files";
+ "--use-cache", Arg.Set use_cache, "Load marshalled package informations";
"--quiet", Arg.Set quiet_mode, "Quiet mode";
] in
Arg.parse speclist (fun s -> raise (Arg.Bad s)) "Generates ocaml_transition_monitor.html";
- if not !skip_download && not (get_package_lists ()) then failwith "Error while downloading lists!";
+ if not !skip_download && not !use_cache && not (get_package_lists ()) then failwith "Error while downloading lists!";
main ()
}
More information about the Pkg-ocaml-maint-commits
mailing list