From: rjones Date: Wed, 25 Mar 2009 18:44:27 +0000 (+0000) Subject: Nice OCaml version. X-Git-Url: http://git.annexia.org/?p=rpmdepsize.git;a=commitdiff_plain;h=31504dfb9c6d92468da431c3f6df3c894d446043 Nice OCaml version. --- diff --git a/.cvsignore b/.cvsignore index c5b14ab..8c7f741 100644 --- a/.cvsignore +++ b/.cvsignore @@ -1,3 +1,6 @@ +*.cmi +*.cmo +*.cmx Makefile.in Makefile aclocal.m4 diff --git a/Makefile.am b/Makefile.am index 5e26a55..f30effe 100644 --- a/Makefile.am +++ b/Makefile.am @@ -17,33 +17,16 @@ # # Written by Richard W.M. Jones -bin_SCRIPTS = \ - rpmdepsize repodeps +ACLOCAL_AMFLAGS = -I m4 -rpmdepsize: rpmdepsize.ml - ocamlfind ocamlopt -package sexplib,unix,extlib,sexplib.syntax -syntax camlp4o -linkpkg $< -o $@ - -repodeps: repodeps.py - rm -f $@ - sed 's,PYTHON,$(PYTHON),' < $< > $@-t - chmod 0555 $@-t - mv $@-t $@ - -man_MANS = \ - rpmdepsize.1 +CLEANFILES = rpmdepsize -if HAVE_PERLDOC +bin_SCRIPTS = rpmdepsize -rpmdepsize.1: rpmdepsize.pl - pod2man \ - --section 1 \ - -c "Virtualization Support" \ - --release "$(PACKAGE_NAME)-$(PACKAGE_VERSION)" \ - $< > $@ - -endif - -EXTRA_DIST = \ - rpmdepsize.1 \ - rpmdepsize.sh \ - repodeps.py +rpmdepsize: rpmdepsize.ml + $(OCAMLFIND) $(OCAMLBEST) \ + -package lablgtk2,sexplib,unix,extlib,sexplib.syntax \ + -syntax camlp4o \ + -linkpkg \ + gtkInit.cmx \ + $< -o $@ diff --git a/README b/README index 4e21920..e3e9d20 100644 --- a/README +++ b/README @@ -12,17 +12,18 @@ Please read the manual page rpmdepsize(1) for full details. Requirements ---------------------------------------------------------------------- - perl + ocaml >= 3.10 + - and the following OCaml packages: + * findlib + * extlib + * sexplib310 + * type-conv + * lablgtk2 python yum - - perldoc - - graphviz - - repoquery + - including the Python libraries, which come by default Build ---------------------------------------------------------------------- diff --git a/autogen.sh b/autogen.sh index 7218c6f..9c7f535 100755 --- a/autogen.sh +++ b/autogen.sh @@ -3,5 +3,6 @@ set -e set -v export AUTOMAKE='automake --foreign --add-missing' +aclocal -I m4 autoreconf ./configure "$@" diff --git a/configure.ac b/configure.ac index 6df2e9d..72a9f10 100644 --- a/configure.ac +++ b/configure.ac @@ -20,30 +20,38 @@ dnl Written by Richard W.M. Jones AC_INIT(rpmdepsize,1.0) AM_INIT_AUTOMAKE -AC_PATH_PROG(PERL,[perl],[no]) -if test "x$PERL" = "xno" ; then - AC_MSG_FAILURE([perl not found]) -fi +AC_CONFIG_MACRO_DIR([m4]) -AC_PATH_PROG(PYTHON,[python],[no]) -if test "x$PYTHON" = "xno" ; then - AC_MSG_FAILURE([python not found]) +AC_PROG_OCAML +if test "$OCAMLC" = "no"; then + AC_MSG_ERROR([You must install the OCaml compiler]) +fi +AC_PROG_FINDLIB +if test "$OCAMLFIND" = "no"; then + AC_MSG_ERROR([You must install OCaml findlib (the ocamlfind command)]) fi -AC_CHECK_PROG(PERLDOC,[perldoc],[perldoc],[no]) -if test "x$PERLDOC" = "xno" ; then - AC_MSG_WARN([perldoc not found - install perl to make man pages]) +AC_CHECK_OCAML_PKG([extlib]) +if test "$OCAML_PKG_extlib" = "no"; then + AC_MSG_ERROR([You must install OCaml library 'extlib']) +fi +AC_CHECK_OCAML_PKG([sexplib]) +if test "$OCAML_PKG_sexplib" = "no"; then + AC_MSG_ERROR([You must install OCaml library 'sexplib']) +fi +AC_CHECK_OCAML_PKG([lablgtk2]) +if test "$OCAML_PKG_lablgtk2" = "no"; then + AC_MSG_ERROR([You must install OCaml library 'lablgtk2']) fi -AM_CONDITIONAL(HAVE_PERLDOC,[test "$perldoc" != "no"]) -AC_CHECK_PROG(DOT,[dot],[dot],[no]) -if test "x$DOT" = "xno" ; then - AC_MSG_FAILURE([graphviz not found]) +AC_CHECK_PROG(PYTHON,[python],[python],[no]) +if test "x$PYTHON" = "xno" ; then + AC_MSG_FAILURE([You must install Python]) fi -AC_CHECK_PROG(REPOQUERY,[repoquery],[repoquery],[no]) -if test "x$REPOQUERY" = "xno" ; then - AC_MSG_FAILURE([repoquery not found]) +AC_CHECK_PROG(YUM,[yum],[yum],[no]) +if test "x$YUM" = "xno" ; then + AC_MSG_FAILURE([You must install Yum]) fi AC_CONFIG_HEADERS([config.h]) diff --git a/m4/ocaml.m4 b/m4/ocaml.m4 new file mode 100644 index 0000000..4b6e964 --- /dev/null +++ b/m4/ocaml.m4 @@ -0,0 +1,186 @@ +dnl autoconf macros for OCaml +dnl by Olivier Andrieu +dnl extensively modified by Richard W.M. Jones +dnl from a configure.in by Jean-Christophe Filliâtre, +dnl from a first script by Georges Mariano + +dnl For documentation, please read the ocaml.m4 man page. + +AC_DEFUN([AC_PROG_OCAML], +[dnl + # checking for ocamlc + AC_CHECK_TOOL(OCAMLC,ocamlc,no) + + if test "$OCAMLC" != "no"; then + OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p'` + AC_MSG_RESULT(OCaml version is $OCAMLVERSION) + OCAMLLIB=`$OCAMLC -where 2>/dev/null || $OCAMLC -v|tail -1|cut -d ' ' -f 4` + AC_MSG_RESULT(OCaml library path is $OCAMLLIB) + + AC_SUBST(OCAMLVERSION) + AC_SUBST(OCAMLLIB) + + # checking for ocamlopt + AC_CHECK_TOOL(OCAMLOPT,ocamlopt,no) + OCAMLBEST=byte + if test "$OCAMLOPT" = "no"; then + AC_MSG_WARN(Cannot find ocamlopt; bytecode compilation only.) + else + TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` + if test "$TMPVERSION" != "$OCAMLVERSION" ; then + AC_MSG_RESULT(versions differs from ocamlc; ocamlopt discarded.) + OCAMLOPT=no + else + OCAMLBEST=opt + fi + fi + + AC_SUBST(OCAMLBEST) + + # checking for ocamlc.opt + AC_CHECK_TOOL(OCAMLCDOTOPT,ocamlc.opt,no) + if test "$OCAMLCDOTOPT" != "no"; then + TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` + if test "$TMPVERSION" != "$OCAMLVERSION" ; then + AC_MSG_RESULT(versions differs from ocamlc; ocamlc.opt discarded.) + else + OCAMLC=$OCAMLCDOTOPT + fi + fi + + # checking for ocamlopt.opt + if test "$OCAMLOPT" != "no" ; then + AC_CHECK_TOOL(OCAMLOPTDOTOPT,ocamlopt.opt,no) + if test "$OCAMLOPTDOTOPT" != "no"; then + TMPVERSION=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` + if test "$TMPVERSION" != "$OCAMLVERSION" ; then + AC_MSG_RESULT(version differs from ocamlc; ocamlopt.opt discarded.) + else + OCAMLOPT=$OCAMLOPTDOTOPT + fi + fi + fi + + AC_SUBST(OCAMLOPT) + fi + + AC_SUBST(OCAMLC) + + # checking for ocamldep + AC_CHECK_TOOL(OCAMLDEP,ocamldep,no) + + # checking for ocamlmktop + AC_CHECK_TOOL(OCAMLMKTOP,ocamlmktop,no) + + # checking for ocamlmklib + AC_CHECK_TOOL(OCAMLMKLIB,ocamlmklib,no) + + # checking for ocamldoc + AC_CHECK_TOOL(OCAMLDOC,ocamldoc,no) +]) + + +AC_DEFUN([AC_PROG_OCAMLLEX], +[dnl + # checking for ocamllex + AC_CHECK_TOOL(OCAMLLEX,ocamllex,no) + if test "$OCAMLLEX" != "no"; then + AC_CHECK_TOOL(OCAMLLEXDOTOPT,ocamllex.opt,no) + if test "$OCAMLLEXDOTOPT" != "no"; then + OCAMLLEX=$OCAMLLEXDOTOPT + fi + fi + AC_SUBST(OCAMLLEX) +]) + +AC_DEFUN([AC_PROG_OCAMLYACC], +[dnl + AC_CHECK_TOOL(OCAMLYACC,ocamlyacc,no) + AC_SUBST(OCAMLYACC) +]) + + +AC_DEFUN([AC_PROG_CAMLP4], +[dnl + AC_REQUIRE([AC_PROG_OCAML])dnl + + # checking for camlp4 + AC_CHECK_TOOL(CAMLP4,camlp4,no) + if test "$CAMLP4" != "no"; then + TMPVERSION=`$CAMLP4 -v 2>&1| sed -n -e 's|.*version *\(.*\)$|\1|p'` + if test "$TMPVERSION" != "$OCAMLVERSION" ; then + AC_MSG_RESULT(versions differs from ocamlc) + CAMLP4=no + fi + fi + AC_SUBST(CAMLP4) +]) + + +AC_DEFUN([AC_PROG_FINDLIB], +[dnl + AC_REQUIRE([AC_PROG_OCAML])dnl + + # checking for ocamlfind + AC_CHECK_TOOL(OCAMLFIND,ocamlfind,no) + AC_SUBST(OCAMLFIND) +]) + + +dnl Thanks to Jim Meyering for working this next bit out for us. +dnl XXX We should define AS_TR_SH if it's not defined already +dnl (eg. for old autoconf). +AC_DEFUN([AC_CHECK_OCAML_PKG], +[dnl + AC_REQUIRE([AC_PROG_FINDLIB])dnl + + AC_MSG_CHECKING([for OCaml findlib package $1]) + + if $OCAMLFIND query $1 >/dev/null 2>/dev/null; then + AC_MSG_RESULT([found]) + AS_TR_SH([OCAML_PKG_$1])=yes + else + AC_MSG_RESULT([not found]) + AS_TR_SH([OCAML_PKG_$1])=no + fi + + AC_SUBST(AS_TR_SH([OCAML_PKG_$1])) +]) + + +AC_DEFUN([AC_CHECK_OCAML_MODULE], +[dnl + AC_MSG_CHECKING(for OCaml module $2) + + cat > conftest.ml <&5 2>&5 ; then + found=yes + break + fi + done + + if test "$found" ; then + AC_MSG_RESULT($$1) + else + AC_MSG_RESULT(not found) + $1=no + fi + AC_SUBST($1) +]) + + +dnl XXX Cross-compiling +AC_DEFUN([AC_CHECK_OCAML_WORD_SIZE], +[dnl + AC_MSG_CHECKING(for OCaml compiler word size) + cat > conftest.ml < -# Heavily derived from a script by Seth Vidal. - -import yum -import yum.misc -import sys - -yb = yum.YumBase () - -basepkg = yb.pkgSack.returnPackages (patterns=[sys.argv[1]])[0] -deps = dict ({basepkg:False}) - -# Recursively find all the dependencies. -stable = False -while not stable: - stable = True - for pkg in deps.keys(): - if deps[pkg] == False: - deps[pkg] = [] - stable = False - for r in pkg.requires: - ps = yb.whatProvides (r[0], r[1], r[2]) - best = yb._bestPackageFromList (ps.returnPackages ()) - if best.name != pkg.name: - deps[pkg].append (best) - if not deps.has_key (best): - deps[best] = False - deps[pkg] = yum.misc.unique (deps[pkg]) - -# Get the data out of python as fast as possible so we can -# use a serious language for analysis of the tree. -print "(%s (" % basepkg -for pkg in deps.keys(): - print "((nevra %s) (name %s) (epoch %s) (version %s) (release %s) (arch %s) (size %s)" % (pkg, pkg.name, pkg.epoch, pkg.version, pkg.release, pkg.arch, pkg.installedsize) - print "(deps (" - for p in deps[pkg]: - print "%s " % p, - print ")))" -sys.stdout.write ("))") # suppress trailing \n - -# # Function to get the total size of a dependency (ie. size of -# # package + size of all dependencies). -# def total(pkg, seen=None): -# if seen is None: -# seen = dict() -# if not seen.has_key (pkg): -# seen[pkg] = True -# sum = pkg.installedsize -# for p in deps[pkg]: -# sum = sum + total (p, seen) -# return sum -# else: -# return 0 - -# # To speed things up, calculate the total size of each package. -# totals = dict () -# for pkg in deps.keys(): -# totals[pkg] = total (pkg) - -# # Sort the lists of dependencies by total size (largest first). -# def sort_by_totals(a, b): -# if totals[a] > totals[b]: -# return -1 -# if totals[a] == totals[b]: -# return 0 -# if totals[a] < totals[b]: -# return 1 - -# for pkg in deps.keys(): -# deps[pkg].sort (cmp=sort_by_totals) - -# # Iterate over the tree and print out the package details. -# def pr(pkg, indent=0, seen=None): -# if seen is None: -# seen = dict() -# if not seen.has_key (pkg): -# seen[pkg] = True -# print '%s%s %s/%s' % (" "*indent, pkg, pkg.installedsize, totals[pkg]) -# for p in deps[pkg]: -# pr (p, indent+2, seen) - -# pr (basepkg) diff --git a/rpmdepsize.ml b/rpmdepsize.ml index d55ec36..92ab20b 100644 --- a/rpmdepsize.ml +++ b/rpmdepsize.ml @@ -25,6 +25,8 @@ open ExtList open Unix open Printf +let debug = true + (* This corresponds to the sexpr that we write out from the * Python code. OCaml will type-check it. *) @@ -51,17 +53,63 @@ type deps = Deps of pkg * deps list ref (* Final tree representation, loops removed, and everything we want to * display stored in the nodes. *) -type tree = Tree of pkg * int64 * int64 * tree list +type tree = Tree of pkg * int64 * int64 * GDraw.color * tree list module StringMap = Map.Make (String) let (+^) = Int64.add let sum = List.fold_left (+^) 0L let spaces n = String.make n ' ' +(* Python has privileged access to the yum repodata, so we have to use + * this Python snippet to pull the data that we need out. This is the + * part of the program that takes ages to run, because Python is as + * slow as a fat snake that's just eaten a huge lunch. We can't help that. + *) +let repoquery_py = " +import yum +import yum.misc +import sys + +yb = yum.YumBase () + +basepkg = yb.pkgSack.returnPackages (patterns=[sys.argv[1]])[0] +deps = dict ({basepkg:False}) + +# Recursively find all the dependencies. +stable = False +while not stable: + stable = True + for pkg in deps.keys(): + if deps[pkg] == False: + deps[pkg] = [] + stable = False + for r in pkg.requires: + ps = yb.whatProvides (r[0], r[1], r[2]) + best = yb._bestPackageFromList (ps.returnPackages ()) + if best.name != pkg.name: + deps[pkg].append (best) + if not deps.has_key (best): + deps[best] = False + deps[pkg] = yum.misc.unique (deps[pkg]) + +# Get the data out of python as fast as possible so we can +# use a serious language for analysis of the tree. +print \"(%s (\" % basepkg +for pkg in deps.keys(): + print \"((nevra %s) (name %s) (epoch %s) (version %s) (release %s) (arch %s) (size %s)\" % (pkg, pkg.name, pkg.epoch, pkg.version, pkg.release, pkg.arch, pkg.installedsize) + print \"(deps (\" + for p in deps[pkg]: + print \"%s \" % p, + print \")))\" +sys.stdout.write (\"))\") # suppress trailing newline" + let () = + printf "getting repository information (this can take a few seconds ...)\n%!"; + (* Run the Python program and read in the generated sexpr. *) let cmd = - sprintf "./repodeps %s" (Filename.quote Sys.argv.(1)) in + sprintf "python -c %s %s" + (Filename.quote repoquery_py) (Filename.quote Sys.argv.(1)) in let chan = open_process_in cmd in ignore (input_line chan); (* drop "Loaded plugins" *) let root, pkgs = @@ -126,23 +174,313 @@ let () = seen := StringMap.add pkg.nevra true !seen; let children = List.filter_map build_tree children in let total = StringMap.find pkg.nevra totalsmap in - let childadditional = + let increm = let rec sum_child_sizes = function - | Tree (pkg, _, _, children) -> + | Tree (pkg, _, _, _, children) -> List.fold_left ( fun size child -> size +^ sum_child_sizes child ) pkg.size children in - sum_child_sizes (Tree (pkg, 0L, 0L, children)) in - Some (Tree (pkg, total, childadditional, children)) + sum_child_sizes (Tree (pkg, 0L, 0L, `WHITE, children)) in + Some (Tree (pkg, total, increm, `WHITE, children)) in Option.get (build_tree (StringMap.find root depsmap)) in - (* Display tree. *) - let rec display ?(indent=0) = function - | Tree (pkg, total, childadditional, children) -> - printf "%s%s %Ld/%Ld/%Ld\n" - (spaces indent) pkg.nevra pkg.size childadditional total; - List.iter (display ~indent:(indent+2)) children + if debug then ( + let rec display ?(indent=0) = function + | Tree (pkg, total, increm, _, children) -> + printf "%s%s %Ld/%Ld/%Ld\n%!" + (spaces indent) pkg.nevra pkg.size increm total; + List.iter (display ~indent:(indent+2)) children + in + display tree + ); + + (* Max depth of the tree. *) + let depth = + let rec depth = function + | Tree (pkg, _, _, _, children) -> + List.fold_left (fun d c -> max d (1 + depth c)) 1 children + in + depth tree in + + (* Allocate a colour to each node in the tree based on its parent. The + * single top node is always light grey. The second level nodes are + * primary colours. + *) + let tree = + let Tree (pkg, total, increm, _, level2) = tree in + let level2 = + let pcols = [ + `RGB (55000, 0, 0); + `RGB (0, 55000, 0); + `RGB (0, 0, 55000); + `RGB (55000, 55000, 0); + `RGB (0, 55000, 55000); + ] in + let rec colour_level2 cols = function + | [] -> [] + | Tree (pkg, total, increm, _, level3) :: level2 -> + let col, cols = match cols with + | [] -> List.hd pcols, List.tl pcols + | col :: cols -> col, cols in + let level3 = colour_level3 col (List.length level3) 0 level3 in + Tree (pkg, total, increm, col, level3) + :: colour_level2 cols level2 + and colour_level3 col n i = function + | [] -> [] + | Tree (pkg, total, increm, _, leveln) :: level3 -> + let col = scale_colour col n i in + let leveln = colour_level3 col (List.length leveln) 0 leveln in + Tree (pkg, total, increm, col, leveln) + :: colour_level3 col n (i+1) level3 + and scale_colour col n i = + let r, g, b = match col with + | `RGB (r, g, b) -> float r, float g, float b + | _ -> assert false in + let i = float i and n = float n in + let scale = 0.8 +. i/.(5.*.n) in + let r = r *. scale in + let g = g *. scale in + let b = b *. scale in + `RGB (int_of_float r, int_of_float g, int_of_float b) + in + colour_level2 pcols level2 in + Tree (pkg, total, increm, `RGB (55000, 55000, 55000), level2) in + + (* Open the window. *) + let title = root ^ " - Fedora RPM dependency size viewer" in + let window = + GWindow.window ~width:800 ~height:600 ~title ~allow_shrink:true () in + + ignore (window#connect#destroy ~callback:GMain.quit); + + let da = GMisc.drawing_area ~packing:window#add () in + da#misc#realize (); + let draw = new GDraw.drawable da#misc#window in + + (* Pango contexts used to draw large and small text. *) + let pango_large_context = da#misc#create_pango_context in + pango_large_context#set_font_description (Pango.Font.from_string "Sans 12"); + let pango_small_context = da#misc#create_pango_context in + pango_small_context#set_font_description (Pango.Font.from_string "Sans 8"); + + let repaint _ = + (* Get the canvas size and fill the background with white. *) + let width, height = draw#size in + draw#set_background `WHITE; + draw#set_foreground `WHITE; + draw#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); + + (* Calculate the scales so we can fit everything into the window. *) + let Tree (_, top_total, top_increm, _, _) = tree in + assert (top_total = top_increm); + let rowheight = float height /. float depth in + let scale = float width /. Int64.to_float top_increm in + + (* Now draw the tree. *) + let rec draw_tree y x = function + | Tree (pkg, total, increm, colour, children) -> + (* Draw pkg at (x, y). *) + let width = scale *. Int64.to_float increm in + let pkgsizewidth = scale *. Int64.to_float pkg.size in + draw_pkg x y width pkgsizewidth rowheight colour pkg total increm; + + (* Draw the children of pkg at (i, y + rowheight), where + * i starts as x and increments for each child. + *) + let y = y +. rowheight in + let rec loop x = function + | [] -> () + | child :: children -> + draw_tree y x child; + let Tree (_, _, increm, _, _) = child in + let childwidth = scale *. Int64.to_float increm in + loop (x +. childwidth) children + in + loop x children + + (* Draw a single package. *) + and draw_pkg x y width pkgsizewidth height colour pkg total increm = + let x = int_of_float x in + let y = int_of_float y in + let width = int_of_float width in + let pkgsizewidth = int_of_float pkgsizewidth in + let height = int_of_float height in + + if width > 8 then ( + draw_pkg_outline x y width pkgsizewidth height colour; + draw_pkg_label x y width height colour pkg total increm + ) + else if width >= 4 then + draw_pkg_narrow x y width height colour + (* else nothing *) + + and draw_pkg_outline x y width pkgsizewidth height colour = + draw#set_foreground colour; + draw#rectangle ~x:(x+2) ~y:(y+2) + ~width:(width-4) ~height:(height-4) + ~filled:true (); + if pkgsizewidth > 2 then ( + draw#set_foreground (darken colour); + draw#rectangle ~x:(x+2) ~y:(y+2) + ~width:(pkgsizewidth-2) ~height:(height-4) + ~filled:true (); + draw#set_foreground (choose_contrasting_colour colour); + draw#set_line_attributes ~style:`ON_OFF_DASH (); + draw#line (x+pkgsizewidth) (y+2) (x+pkgsizewidth) (y+height-2); + draw#set_line_attributes ~style:`SOLID () + ); + draw#set_foreground (`BLACK); + draw#rectangle ~x:(x+2) ~y:(y+2) + ~width:(width-4) ~height:(height-4) + ~filled:false () + + and draw_pkg_label x y width height colour pkg total increm = + (* How to write text in a drawing area, in case it's not + * obvious, which it certainly is not: + * http://www.math.nagoya-u.ac.jp/~garrigue/soft/olabl/lablgtk-list/120.txt + *) + let txt1 = lazy ( + let txt = pango_large_context#create_layout in + Pango.Layout.set_text txt ( + sprintf "%s +Package: %.1f%% %s (%Ld bytes) +Incremental: %.1f%% %s (%Ld bytes) +Total: %.1f%% %s (%Ld bytes)" pkg.nevra +(display_percent pkg.size) (display_size pkg.size) pkg.size +(display_percent increm) (display_size increm) increm +(display_percent total) (display_size total) total + ); + txt + ) + and txt2 = lazy ( + let txt = pango_small_context#create_layout in + Pango.Layout.set_text txt ( + sprintf "%s +Package: %.1f%% %s (%Ld bytes) +Incremental: %.1f%% %s (%Ld bytes) +Total: %.1f%% %s (%Ld bytes)" pkg.nevra +(display_percent pkg.size) (display_size pkg.size) pkg.size +(display_percent increm) (display_size increm) increm +(display_percent total) (display_size total) total + ); + txt + ) + and txt3 = lazy ( + let txt = pango_small_context#create_layout in + Pango.Layout.set_text txt ( + sprintf "%s +Pkg: %.1f%% %s (%Ld bytes) +Incr: %.1f%% %s (%Ld bytes) +Tot: %.1f%% %s (%Ld bytes)" pkg.name +(display_percent pkg.size) (display_size pkg.size) pkg.size +(display_percent increm) (display_size increm) increm +(display_percent total) (display_size total) total + ); + txt + ) + and txt4 = lazy ( + let txt = pango_small_context#create_layout in + Pango.Layout.set_text txt ( + sprintf "%s +Pkg: %.1f%% %s +Incr: %.1f%% %s +Tot: %.1f%% %s" pkg.name +(display_percent pkg.size) (display_size pkg.size) +(display_percent increm) (display_size increm) +(display_percent total) (display_size total) + ); + txt + ) + and txt5 = lazy ( + let txt = pango_small_context#create_layout in + Pango.Layout.set_text txt ( + sprintf "%s\nPkg: %.1f%%\nIncr: %.1f%%\nTot: %.1f%%" + pkg.name + (display_percent pkg.size) + (display_percent increm) + (display_percent total) + ); + txt + ) + and txt6 = lazy ( + let txt = pango_small_context#create_layout in + Pango.Layout.set_text txt ( + sprintf "%s Pkg: %.1f%% %s Incr: %.1f%% %s Tot: %.1f%% %s" pkg.name + (display_percent pkg.size) (display_size pkg.size) + (display_percent increm) (display_size increm) + (display_percent total) (display_size total) + ); + txt + ) + and txt7 = lazy ( + let txt = pango_small_context#create_layout in + Pango.Layout.set_text txt ( + sprintf "%s %.1f%% %.1f%% %.1f%%" pkg.name + (display_percent pkg.size) + (display_percent increm) + (display_percent total) + ); + txt + ) + and txt8 = lazy ( + let txt = pango_small_context#create_layout in + Pango.Layout.set_text txt ( + sprintf "%s" pkg.name + ); + txt + ) in + let txts = [ txt1; txt2; txt3; txt4; txt5; txt6; txt7; txt8 ] in + + let fore = choose_contrasting_colour colour in + + let rec loop = function + | [] -> () + | txt :: txts -> + let txt = Lazy.force txt in + let { Pango.width = txtwidth; + Pango.height = txtheight } = + Pango.Layout.get_pixel_extent txt in + (* Now with added fudge-factor. *) + if width >= txtwidth + 8 && height >= txtheight + 8 then + draw#put_layout ~x:(x+4) ~y:(y+4) ~fore txt + else loop txts + in + loop txts + + and draw_pkg_narrow x y width height colour = + draw#set_foreground colour; + draw#rectangle ~x:(x+2) ~y:(y+2) + ~width:(width-4) ~height:(height-4) ~filled:true () + + and choose_contrasting_colour = function + | `RGB (r, g, b) -> + if r + g + b > 98304 then `BLACK else `WHITE + | _ -> `WHITE + + and darken = function + | `RGB (r, g, b) -> + `RGB (r * 9 / 10, g * 9 / 10, b * 9 / 10) + | _ -> `WHITE + + and display_percent bytes = + 100. *. Int64.to_float bytes /. Int64.to_float top_total + + and display_size bytes = + if bytes > 104_857L then + sprintf "%.1f MB" (Int64.to_float bytes /. 1_048_576.) + else if bytes > 102L then + sprintf "%.1f KB" (Int64.to_float bytes /. 1_024.) + else + sprintf "%Ld" bytes + in + draw_tree 0. 0. tree; + + (* Return false because this is a Gtk event handler. *) + false in - display tree + ignore (da#event#connect#expose ~callback:repaint); + + window#show (); + GMain.main () diff --git a/rpmdepsize.pl b/rpmdepsize.pl deleted file mode 100755 index 0241a60..0000000 --- a/rpmdepsize.pl +++ /dev/null @@ -1,142 +0,0 @@ -#!PERL -w -# rpmdepsize - visualize the size of RPM dependencies -# (C) Copyright 2009 Red Hat Inc. -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# 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., 675 Mass Ave, Cambridge, MA 02139, USA. -# -# Written by Richard W.M. Jones - -use strict; - -use Getopt::Long; -use Pod::Usage; - -my $man = 0; -my $help = 0; - -GetOptions ('help|?' => \$help, - 'man' => \$man) - or pod2usage (2); -pod2usage (1) if $help || @ARGV == 0; -pod2usage (-exitstatus => 0, -verbose => 2) if $man; - -# Recurse through dependencies until all deps have been found. -my %deps; - -foreach (@ARGV) { - $deps{$_} = [] -} - -my $stable = 0; -while (!$stable) { - $stable = 1; - foreach my $name (sort keys %deps) { - if (@{$deps{$name}} == 0) { - $stable = 0; - add_deps ($name); - } - } -} - -sub add_deps -{ - my $name = shift; - - print "resolving deps in $name ...\n"; - -# repoquery is incredibly slow. Unfortunately python has a -# privileged position into the yum databases, and a python -# script to access this information runs quickly, so this -# is what the alternate implementation below uses. -# my $cmd = -# "repoquery --recursive --resolve -R $name | -# sort -u | awk -F- '{print \$1}'"; - - my $cmd = "./repodeps $name | grep -v '^Loaded plugins:'"; - - open RQ, "$cmd |" or die "$cmd: $!"; - my $n = 0; - while () { - chomp; - push @{$deps{$name}}, $_; - $n++; - $deps{$_} = [] unless exists $deps{$_}; - } - close RQ; - push @{$deps{$name}}, $name if $n == 0; -} - -__END__ - -=head1 NAME - - rpmdepsize - Visualize the size of RPM dependencies - -=head1 SYNOPSIS - - rpmdepsize [--options] package [package ...] - -=head1 OPTIONS - -=over 4 - -=item B<--help> - -Display short usage message and exit. - -=item B<--man> - -Display manual page and exit. - -=back - -=head1 DESCRIPTION - - - - - -=head1 HOME PAGE - -L - -=head1 SEE ALSO - -L, L, L. - -=head1 AUTHORS - -Richard W.M. Jones - -=head1 COPYRIGHT - -(C) Copyright 2009 Red Hat Inc., -L. - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -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., 675 Mass Ave, Cambridge, MA 02139, USA. - -=cut