+*.cmi
+*.cmo
+*.cmx
Makefile.in
Makefile
aclocal.m4
#
# Written by Richard W.M. Jones <rjones@redhat.com>
-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 $@
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
----------------------------------------------------------------------
set -e
set -v
export AUTOMAKE='automake --foreign --add-missing'
+aclocal -I m4
autoreconf
./configure "$@"
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])
--- /dev/null
+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 <<EOF
+open $3
+EOF
+ unset found
+ for $1 in $$1 $4 ; do
+ if $OCAMLC -c -I "$$1" 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 <<EOF
+ print_endline (string_of_int Sys.word_size)
+ EOF
+ OCAML_WORD_SIZE=`ocaml conftest.ml`
+ AC_MSG_RESULT($OCAML_WORD_SIZE)
+ AC_SUBST(OCAML_WORD_SIZE)
+])
+++ /dev/null
-#!PYTHON
-# repodeps - list recursive dependencies of a package in the repo
-# (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 <rjones@redhat.com>
-# 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)
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.
*)
(* 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 =
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 ()
+++ /dev/null
-#!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 <rjones@redhat.com>
-
-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 (<RQ>) {
- 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<http://et.redhat.com/~rjones/rpmdepsize>
-
-=head1 SEE ALSO
-
-L<rpm(1)>, L<repoquery(1)>, L<dot(1)>.
-
-=head1 AUTHORS
-
-Richard W.M. Jones <rjones @ redhat . com>
-
-=head1 COPYRIGHT
-
-(C) Copyright 2009 Red Hat Inc.,
-L<http://et.redhat.com/~rjones/febootstrap>.
-
-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
git.annexia.org / rpmdepsize.git / commitdiff