Author: glondu-guest
Date: Sun Mar 1 16:33:32 2009
New Revision: 6295
URL: http://svn.debian.org/wsvn/?sc=1&rev=6295
Log:
Refactoring to uncouple computations and XHTML generation
Modified:
trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll
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=6295&op=diff
==============================================================================
--- trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll (original)
+++ trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll Sun Mar
1 16:33:32 2009
@@ -81,6 +81,27 @@
end
module Topological = Graph.Topological.Make(G)
+
+ let with_in_file file f =
+ let chan = open_in_bin file in
+ try
+ let res = f chan in
+ close_in chan; res
+ with e -> close_in chan; raise e
+
+ let with_out_file file f =
+ let chan = open_out_bin file in
+ try
+ let res = f chan in
+ close_out chan; res
+ with e -> close_out chan; raise e
+
+ let get_rfc2822_date () =
+ let chan = Unix.open_process_in "date -R" in
+ let r = input_line chan in
+ match Unix.close_process_in chan with
+ | Unix.WEXITED 0 -> r
+ | _ -> failwith "unexpected return of date"
}
let name = ['A'-'Z' 'a'-'z' '0'-'9' '-' '.' ':' '~' '+']+
@@ -141,7 +162,7 @@
@return a [S.t M.t] mapping source packages to their build-dependencies
in terms of source packages
*)
- let dep_graph src bin =
+ let get_dep_graph src bin =
M.mapi
(fun k pkg ->
List.fold_left
@@ -159,7 +180,7 @@
src
(**
- @param dgraph [dep_graph] output
+ @param dgraph [get_dep_graph] output
@return a [string list list] with topologically sorted source packages,
grouped by dependency level
*)
@@ -207,7 +228,7 @@
@param x a binary package name
@return [Some v] if [x] depends on ABI [v], [None] otherwise
*)
- let depends_on_ocaml x =
+ let runtime_depends_on_ocaml x =
let rec aux = function
| [] -> None
| x::xs ->
@@ -225,43 +246,11 @@
else aux xs
in aux x.sdeps
- let with_in_file file f =
- let chan = open_in_bin file in
- try
- let res = f chan in
- close_in chan; res
- with e -> close_in chan; raise e
-
- let with_out_file file f =
- let chan = open_out_bin file in
- try
- let res = f chan in
- close_out chan; res
- with e -> close_out chan; raise e
-
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
- | Some version ->
- begin try
- let (_, cur_version) = M.find k accu in
- if cur_version <> ocaml_version then accu else M.add k (pkg,
version) accu
- with
- | Not_found -> M.add k (pkg, version) accu
- end)
- binaries M.empty in
- let compiled_sources = M.fold
- (fun k (pkg, version) accu ->
- M.add pkg.bsrc (version = ocaml_version) accu)
- runtime_versions M.empty in
- compiled_sources
let get_sources () =
progress "Parsing Packages.source...%!";
@@ -295,7 +284,32 @@
let a_link href contents =
a ~a:[a_href (uri_of_string href)] [pcdata contents]
- let source_status xs =
+ let get_binary_status pkg =
+ match runtime_depends_on_ocaml pkg with
+ | None -> Unknown
+ | Some version -> if version = ocaml_version then Up_to_date else
Outdated
+
+ (**
+ @param binaries a [status M.t] mapping binary packages to their status
+ @param source a [source_package]
+ @return the worst status among all binary packages of [source]
+ *)
+ let get_source_status_on_arch binaries source =
+ let rec aux accu = function
+ | [] -> accu
+ | x::xs ->
+ let x = try M.find x binaries with Not_found -> Unknown in
+ match x with
+ | Outdated -> Outdated
+ | Up_to_date -> aux Up_to_date xs
+ | Unknown -> aux accu xs
+ in aux Unknown source.sbins
+
+ (**
+ @param xs outputs of [get_source_status_on_arch]
+ @return the best status among all architectures
+ *)
+ let get_source_status xs =
let rec aux accu = function
| [] -> accu
| Up_to_date::_ -> Up_to_date
@@ -304,7 +318,7 @@
in aux Unknown xs
let main () =
- let (sources_map, binaries) =
+ let (sources, binaries) =
let cache = basename^".cache" in
if !use_cache then begin
progress "Loading cache...%!";
@@ -316,60 +330,65 @@
x
end
in
- let all_binaries = List.map get_arch_status binaries in
- let src_of_bin = M.fold
+ let binaries_status = List.map (M.map get_binary_status) binaries in
+ let sources_status = M.map
+ (fun pkg -> List.map (fun x -> get_source_status_on_arch x pkg)
binaries_status)
+ sources
+ in
+ let summary_status = M.map get_source_status sources_status in
+ let src_of_bin_map = 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 dgraph = dep_graph sources_map src_of_bin in
- let sections = topo_split dgraph 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 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));
- a_title
- (let deps = S.elements (M.find pkg dgraph) in
- if deps <> [] then
- "dependencies: "^(String.concat ", " deps)
- else
- "no dependencies")] [pcdata pkg];
- small [
- pcdata " [ ";
- a_link
("http://buildd.debian.org/~luk/status/package.php?p="^pkg) "buildd";
- pcdata " ] "
- ];
- small [
- pcdata " ( ";
- a_link
- (sprintf
"http://packages.debian.org/changelogs/pool/main/%c/%s/current/changelog";
pkg.[0] pkg)
- (M.find pkg sources_map).sversion;
- pcdata " ) ";
- ];
- ])
- (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))
- (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
+ sources M.empty in
+ let dep_graph = get_dep_graph sources src_of_bin_map in
+ (* a section is a level in the dependency graph *)
+ let sections = topo_split dep_graph in
+ progress "Generating XHTML...%!";
+ let format_package pkg = tr
+ (td
+ ~a:[a_class [(class_of_status (M.find pkg summary_status))^" src"];
a_id pkg]
+ [a
+ ~a:[a_href (uri_of_string ("http://packages.qa.debian.org/"^pkg));
+ a_title
+ (let deps = S.elements (M.find pkg dep_graph) in
+ if deps <> [] then
+ "dependencies: "^(String.concat ", " deps)
+ else
+ "no dependencies");
+ ]
+ [pcdata pkg];
+ small [
+ pcdata " [ ";
+ a_link ("http://buildd.debian.org/~luk/status/package.php?p="^pkg)
"buildd";
+ pcdata " ] "
+ ];
+ small [
+ pcdata " ( ";
+ a_link
+ (sprintf
"http://packages.debian.org/changelogs/pool/main/%c/%s/current/changelog";
pkg.[0] pkg)
+ (M.find pkg sources).sversion;
+ pcdata " ) ";
+ ];
+ ])
+ (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]])
+ (M.find pkg sources_status))
+ in
+ let format_section section =
+ let thead = tr (th [pcdata "source"]) (List.map (fun arch -> th [small
[pcdata arch]]) architectures) in
+ thead::(List.map format_package section)
+ in
let summary_contents = List.fold_left
- (fun accu section -> (thead::section)@accu)
- []
- (List.rev_map format_section_body sections)
+ (fun accu section -> sect...@accu)
+ [] (List.rev_map format_section 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
- let r = input_line chan in
- close_in chan; r in
+ let date = get_rfc2822_date () in
let footer = [
p [pcdata "Last generated: ";
span ~a:[a_class ["timestamp"]] [pcdata date];
@@ -420,7 +439,8 @@
div ~a:[a_class ["footer"]] footer])
in
with_out_file (basename^".html")
- (fun chan -> pretty_print (fun s -> fprintf chan "%s%!" s) html)
+ (fun chan -> pretty_print (fun s -> fprintf chan "%s%!" s) html);
+ progress "\n%!"
let _ =
let speclist = [
_______________________________________________
Pkg-ocaml-maint-commits mailing list
Pkg-ocaml-maint-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/mailman/listinfo/pkg-ocaml-maint-commits
