git.annexia.org
/
rpmdepsize.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
a88da71
)
Build both parents and children dependencies. 'current' -> 'opened'.
author
Richard Jones
<rjones@redhat.com>
Fri, 27 Mar 2009 14:56:23 +0000
(14:56 +0000)
committer
Richard Jones
<rjones@redhat.com>
Fri, 27 Mar 2009 14:56:23 +0000
(14:56 +0000)
rpmdepsize.ml
patch
|
blob
|
history
diff --git
a/rpmdepsize.ml
b/rpmdepsize.ml
index
47df458
..
9570da6
100644
(file)
--- 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.
*)
(* 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 = {
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 *)
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
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.
(* 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 =
* 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 (
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 (
) 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
) deps;
depsmap
@@
-162,8
+176,8
@@
let create_totals pkgs depsmap =
let total pkg =
let seen = ref StringMap.empty in
let rec _total = function
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
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 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
let rec build_tree = function
- |
Deps (pkg, { contents = children })
->
+ |
{ pkg = pkg; children = children }
->
(* Sort children by reverse total size. *)
(* 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
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
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 (
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 ", "
String.concat ", "
- (List.map (fun
(Deps (pkg, _)) -> pkg.nevra) !dep
s)
+ (List.map (fun
{ pkg = pkg } -> pkg.nevra) parent
s)
);
seen := StringMap.add pkg.nevra true !seen;
);
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);
)
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.
*)
(* 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 =
(* 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);
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. *)
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 !=
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
* 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 _ =
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
| 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 =
)
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
| None -> ()
| Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total) ->
real_motion root pkgs depsmap totalsmap tree depth top_total ev