From d86eee19536e3a18caa17f1f56807f4ec6c533c9 Mon Sep 17 00:00:00 2001 From: Richard Jones Date: Fri, 27 Mar 2009 14:56:23 +0000 Subject: [PATCH] Build both parents and children dependencies. 'current' -> 'opened'. --- rpmdepsize.ml | 70 +++++++++++++++++++++++++++++++++++------------------------ 1 file changed, 42 insertions(+), 28 deletions(-) diff --git a/rpmdepsize.ml b/rpmdepsize.ml index 47df458..9570da6 100644 --- a/rpmdepsize.ml +++ b/rpmdepsize.ml @@ -29,25 +29,34 @@ open Printf (* This corresponds to the sexpr that we write out from the * Python code. OCaml will type-check it. *) -type root_packages = string * packages +type root_packages = nevra * packages and packages = pkg list and pkg = { - nevra : string; (* name-[epoch:]version-release.arch *) + nevra : nevra; name : string; epoch : int; version : string; release : string; arch : string; size : int64; (* installed size, excl. dirs *) - deps : string list; + deps : nevra list; } +and nevra = string (* Name-[Epoch:]Version-Release.Arch *) with sexp (* Full dependency representation. This is actually a graph because - * it contains dependency loops. 'deps list' is a ref because we - * update it as we are building it. + * it contains dependency loops. The only difference from the pkg + * structure is that we have resolved the nevra strings into direct + * links, so we can quickly recurse over the tree. + * + * Parents/deps are mutable only because we want to modify these + * lists when creating this graph in 'create_deps'. *) -type deps = Deps of pkg * deps list ref +type deps = { + pkg : pkg; (* the package *) + mutable children : deps list; (* dependencies of this package (below) *) + mutable parents : deps list; (* parents of this package (above) *) +} (* Final tree representation, loops removed, and everything we want to * display stored in the nodes. @@ -138,16 +147,21 @@ sys.stdout.write (\"))\") # suppress trailing newline" in * StringMap of nevra -> deps. *) let create_deps pkgs = - let deps = List.map (fun pkg -> Deps (pkg, ref [])) pkgs in + let deps = + List.map (fun pkg -> { pkg = pkg; children = []; parents = [] }) pkgs in let depsmap = List.fold_left ( - fun map (Deps (pkg, _) as deps) -> - StringMap.add pkg.nevra deps map + fun map ({pkg = pkg} as deps) -> StringMap.add pkg.nevra deps map ) StringMap.empty deps in List.iter ( - fun (Deps (pkg, deps)) -> - let deps' = List.map (fun n -> StringMap.find n depsmap) pkg.deps in - deps := List.append !deps deps' + fun dep -> + List.iter ( + fun nevra -> + let dep' = StringMap.find nevra depsmap in + (* dep.pkg is parent of dep'.pkg *) + dep.children <- dep' :: dep.children; + dep'.parents <- dep :: dep'.parents + ) dep.pkg.deps; ) deps; depsmap @@ -162,8 +176,8 @@ let create_totals pkgs depsmap = let total pkg = let seen = ref StringMap.empty in let rec _total = function - | Deps (pkg, _) when StringMap.mem pkg.nevra !seen -> 0L - | Deps (pkg, { contents = children }) -> + | { pkg = pkg } when StringMap.mem pkg.nevra !seen -> 0L + | { pkg = pkg; children = children } -> seen := StringMap.add pkg.nevra true !seen; pkg.size +^ sum (List.map _total children) in @@ -190,12 +204,12 @@ let create_tree root depsmap totalsmap = let seen = StringMap.empty in let seen = StringMap.add root true seen in let seen = ref seen in - let mark_seen (Deps (pkg, _))= seen := StringMap.add pkg.nevra true !seen in - let not_seen (Deps (pkg, _)) = not (StringMap.mem pkg.nevra !seen) in + let mark_seen { pkg = pkg } = seen := StringMap.add pkg.nevra true !seen in + let not_seen { pkg = pkg } = not (StringMap.mem pkg.nevra !seen) in let rec build_tree = function - | Deps (pkg, { contents = children }) -> + | { pkg = pkg; children = children } -> (* Sort children by reverse total size. *) - let cmp (Deps (p1, _)) (Deps (p2, _)) = + let cmp { pkg = p1 } { pkg = p2 } = let t1 = StringMap.find p1.nevra totalsmap in let t2 = StringMap.find p2.nevra totalsmap in compare t2 t1 @@ -288,17 +302,17 @@ let debug_deps root depsmap = if !debug_flag then ( let seen = ref StringMap.empty in let rec display ?(indent=0) = function - | Deps (pkg, deps) -> + | { pkg = pkg; children = children; parents = parents } -> if StringMap.mem pkg.nevra !seen then eprintf "%s%s -> ...\n" (spaces indent) pkg.nevra else ( - eprintf "%s%s -> [%s]\n" - (spaces indent) pkg.nevra ( + eprintf "%s%s ->\n%sparents:[%s]\n" + (spaces indent) pkg.nevra (spaces (indent+2)) ( String.concat ", " - (List.map (fun (Deps (pkg, _)) -> pkg.nevra) !deps) + (List.map (fun { pkg = pkg } -> pkg.nevra) parents) ); seen := StringMap.add pkg.nevra true !seen; - List.iter (display ~indent:(indent+2)) !deps + List.iter (display ~indent:(indent+2)) children ) in display (StringMap.find root depsmap); @@ -380,7 +394,7 @@ let open_window pkgstr = (* This is the currently open package, or None if nothing has * opened by the user yet. *) - let current = ref None in + let opened = ref None in (* Called from the "Open package" menu entry and other places. *) let open_package pkgstr = @@ -416,7 +430,7 @@ let open_window pkgstr = let Tree (_, top_total, top_increm, _, _) = tree in assert (top_total = top_increm); - current := + opened := Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total); (* Update the window title. *) @@ -428,7 +442,7 @@ let open_window pkgstr = in (* If the user selected something on the command line (pkgstr != - * None) then set up an idle event to populate 'current' as soon as + * None) then set up an idle event to populate 'opened' as soon as * the window gets drawn on the screen. *) (match pkgstr with @@ -711,7 +725,7 @@ Tot: %.1f%% %s" pkg.name draw_tree 0. 0 tree and repaint _ = - (match !current with + (match !opened with | None -> () | Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total) -> real_repaint root pkgs depsmap totalsmap tree depth top_total @@ -758,7 +772,7 @@ Total: %.1f%% %s (%Ld bytes)" pkg.nevra ) and motion ev = - (match !current with + (match !opened with | None -> () | Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total) -> real_motion root pkgs depsmap totalsmap tree depth top_total ev -- 1.8.3.1