pkgdepgraph prints out a "dot" language specification of the

inter-dependencies of your installed packages.  The "dot" language
is interpreted by the graphviz package to make graphs.  There are
several uses for such information.

(1) A graphical representation of information is always good to
look at.

(2) The output itself can be sorted and filtered to provide a list
of packages to delete in order that they can be rebuilt (to replace
out-of-date components).

(3) You can visually estimate the work involved in (or impact of)
removing a given component in order to replace it.

5 files changed, 433 insertions, 0 deletions

diff --git a/pkgtools/pkgdepgraph/DESCR b/pkgtools/pkgdepgraph/DESCR
new file mode 100644
index 00000000000..881e5c2364e
--- /dev/null
+++ b/pkgtools/pkgdepgraph/DESCR
@@ -0,0 +1,14 @@
+pkgdepgraph prints out a "dot" language specification of the
+inter-dependencies of your installed packages.  The "dot" language
+is interpreted by the graphviz package to make graphs.  There are
+several uses for such information.
+
+(1) A graphical representation of information is always good to
+look at.
+
+(2) The output itself can be sorted and filtered to provide a list
+of packages to delete in order that they can be rebuilt (to replace
+out-of-date components).
+
+(3) You can visually estimate the work involved in (or impact of)
+removing a given component in order to replace it.
diff --git a/pkgtools/pkgdepgraph/Makefile b/pkgtools/pkgdepgraph/Makefile
new file mode 100644
index 00000000000..650af1b54d6
--- /dev/null
+++ b/pkgtools/pkgdepgraph/Makefile
@@ -0,0 +1,57 @@
+# $NetBSD: Makefile,v 1.1.1.1 2002/11/07 23:18:01 atatat Exp $
+#
+
+DISTNAME=	pkgdepgraph-1.0
+CATEGORIES=	pkgtools devel
+MASTER_SITES=	# empty
+DISTFILES=	# empty
+
+MAINTAINER=	atatat@netbsd.org
+HOMEPAGE=	ftp://ftp.netbsd.org/pub/NetBSD/packages/pkgsrc/Packages.txt
+COMMENT=	Visual representation of installed NetBSD packages
+
+DEPENDS+=	graphviz-[0-9]*:../../graphics/graphviz
+
+USE_PERL5=	YES
+
+EXTRACT_ONLY=	# empty
+WRKSRC=		${WRKDIR}
+NO_CHECKSUM=	yes
+NO_PATCH=	yes
+NO_CONFIGURE=	yes
+
+MAKE_ENV=	PKG_DBDIR=${PKG_DBDIR}
+
+DISTVER=	${DISTNAME:S/pkgdepgraph-//}
+
+.include "../../mk/bsd.prefs.mk"
+
+.if ${OPSYS} == "SunOS"
+# This doesn't create readable manual pages. "mandoc" should be added
+# to zoularis.
+NROFF=		nroff -man
+.else
+NROFF=		nroff -mandoc
+.endif
+
+do-build:
+.for FILE in pkgdepgraph
+	${SED} -e 's|@PREFIX@|${PREFIX}|g'		\
+		-e 's|@PKG_DBDIR@|${PKG_DBDIR}|g'	\
+		-e 's|@DISTVER@|${DISTVER}|g'		\
+		< ${FILESDIR}/${FILE}.pl 		\
+		> ${WRKSRC}/${FILE}
+.endfor
+.for FILE in pkgdepgraph
+	${SED} -e 's|@PKG_DBDIR@|${PKG_DBDIR}|g'	\
+		< ${FILESDIR}/${FILE}.1			\
+		> ${WRKSRC}/${FILE}.1
+	${NROFF} ${WRKSRC}/${FILE}.1 >${WRKSRC}/${FILE}.0
+.endfor
+
+do-install:
+	${INSTALL_SCRIPT} ${WRKSRC}/pkgdepgraph ${PREFIX}/bin/pkgdepgraph
+	${INSTALL_MAN} ${WRKSRC}/pkgdepgraph.0 ${PREFIX}/man/cat1
+	${INSTALL_MAN} ${WRKSRC}/pkgdepgraph.1 ${PREFIX}/man/man1
+
+.include "../../mk/bsd.pkg.mk"
diff --git a/pkgtools/pkgdepgraph/PLIST b/pkgtools/pkgdepgraph/PLIST
new file mode 100644
index 00000000000..beef3f75ff9
--- /dev/null
+++ b/pkgtools/pkgdepgraph/PLIST
@@ -0,0 +1,4 @@
+@comment $NetBSD: PLIST,v 1.1.1.1 2002/11/07 23:18:01 atatat Exp $
+bin/pkgdepgraph
+man/cat1/pkgdepgraph.0
+man/man1/pkgdepgraph.1
diff --git a/pkgtools/pkgdepgraph/files/pkgdepgraph.1 b/pkgtools/pkgdepgraph/files/pkgdepgraph.1
new file mode 100644
index 00000000000..e3cb16882e7
--- /dev/null
+++ b/pkgtools/pkgdepgraph/files/pkgdepgraph.1
@@ -0,0 +1,130 @@
+.\"	$NetBSD: pkgdepgraph.1,v 1.1.1.1 2002/11/07 23:18:01 atatat Exp $
+.\"
+.\" Copyright (c) 2002 by Andrew Brown <atatat@netbsd.org>
+.\" Absolutely no warranty.
+.\"
+.Dd November 6, 2002
+.Dt PKGDEPGRAPH 1
+.Sh NAME
+.Nm pkgdepgraph
+.Nd visual representation of installed packages
+.Sh SYNOPSIS
+.Nm
+.Op Fl d Ar pkg_dbdir
+.Op Fl clov
+.Op Pa lintpkgsrc output ...
+.Sh DESCRIPTION
+.Nm
+emits a
+.Pa dot
+language description of the locally installed packages, with the
+inter-dependencies reduced to a minimal set of edges.
+It scans each directory under the package database directory for files
+named
+.Pa +BUILD_INFO
+and
+.Pa +REQUIRED_BY
+in order to gather its data.
+.Nm
+will also read any files passed to it as arguments (or stdin if it
+is not connected to a tty), in search of output that resembles that
+of either
+.Xr lintpkgsrc 1
+or
+.Xr audit-packages 1 .
+.Pp
+The options are as follows:
+.Bl -tag -width indent
+.It Fl c
+Use colors.
+The graph defaults to black, but if this option is used and the output
+from
+.Xr lintpkgsrc 1
+or
+.Pa audit-packages
+is given, then nodes (and edges leading from them) will be colored in
+the following manner:
+.Bl -tag -width purple
+.It green
+The package is completely up to date.
+.It orange
+The package is up to date, but some of its dependencies require updating.
+.It red
+The package is out of date or has had a security advisory issued
+against it, and should be replaced.
+.It purple
+The package was not found in the local pkgsrc tree.
+.El
+.It Fl d Ar pkg_dbdir
+The location of the package database files.
+This defaults to the value of the
+.Pa PKG_DBDIR
+environment variable, if it is set, or to
+.Pa @PKG_DBDIR@ .
+.It Fl l
+Adds package 
+.Dq location
+information to the labels on the nodes.
+This is the path to the package under the local pkgsrc tree.
+.It Fl o
+Adds a package
+.Dq order
+number to each node's label.
+The number indicates only the place of the node in the hierarchy, such
+that each node has a number greater than that of anything which
+depends on it, and with the
+.Dq leaf
+nodes numbered one.
+.It Fl v
+Adds the package version number to the node's label in the graph.
+.El
+.Sh ENVIRONMENT
+.Ss PKG_DBDIR
+Where to find registered packages instead of
+.Pa @PKG_DBDIR@ .
+.Sh EXAMPLES
+The default output:
+.Bd -literal -offset indent
+$ pkgdepgraph | dotty -
+.Ed
+.Pp
+To generate colored graph output for later use, and a postscript image
+of it:
+.Bd -literal -offset indent
+$ lintpkgsrc -i \> pkgdepgraph.in
+$ audit-packages \>\> pkgdepgraph.in
+$ pkgdepgraph -clv pkgdepgraph.in \> pkgdepgraph.dot
+$ dot -Tps pkgdepgraph.dot \> pkgdepgraph.ps
+.Ed
+.Pp
+To subsequently generate a graph of just the out-of-date nodes as a
+gif:
+.Bd -literal -offset indent
+$ grep -v green pkgdepgraph.dot | \\
+	sed 's/"packages"/"out of date packages"/' | \\
+	dot -Tgif \> pkgdepgraph.ood.gif
+.Ed
+.Pp
+To make a list of packages that need to be removed in order to bring
+all packages up to date:
+.Bd -literal -offset indent
+$ grep -v green pkgdepgraph.dot \> out-of-date
+$ grep label out-of-date | \\
+	sort -t\\# +1n | \\
+	sed 's/\\(.\\)".*/\\1/;s/"//' \> delete_order
+$ grep LEAF out-of-date | \\
+	sort -t\\# +1nr | \\
+	sed 's/.*label="//;s/\\\\.*//' \> rebuild_order
+.Ed
+.Sh SEE ALSO
+.Xr dot 1 ,
+.Xr dotty 1 ,
+.Xr lintpkgsrc 1
+.Sh AUTHORS
+.An Andrew Brown Aq atatat@netbsd.org
+.Sh BUGS
+.Nm
+was written in
+.Xr perl 1 ,
+but I believe the balance of code layout and comments is actually
+reasonable, despite what you may think of perl.
diff --git a/pkgtools/pkgdepgraph/files/pkgdepgraph.pl b/pkgtools/pkgdepgraph/files/pkgdepgraph.pl
new file mode 100755
index 00000000000..4dab20f8f56
--- /dev/null
+++ b/pkgtools/pkgdepgraph/files/pkgdepgraph.pl
@@ -0,0 +1,228 @@
+#!@PREFIX@/bin/perl
+
+# $NetBSD: pkgdepgraph.pl,v 1.1.1.1 2002/11/07 23:18:01 atatat Exp $
+# pkgdepgraph: @DISTVER@
+
+# (1) lintpkgsrc -i > ! pkgdepgraph.in			(optional, adds color)
+# (1a) audit-packages >> pkgdepgraph.in			(optional, adds color)
+# (2) ./pkgdepgraph pkgdepgraph.in > ! pkgdepgraph.out	(can leave off lint)
+# (3) dotty pkgdepgraph.out				(to view it)
+# (4) dot -Tgif pkgdepgraph.out > ! pkgdepgraph.gif
+# (5) file pkgdepgraph.gif				(to determine size)
+# (6) dot -Tps pkgdepgraph.out > ! pkgdepgraph.ps
+# (7) pstopnm -stdout -xsize 26332 -ysize 652 pkgdepgraph.ps > ! pkgdepgraph.ppm
+
+use strict;
+
+use Getopt::Std;
+my($opts, %opt, $usecolor, $locations, $order, $versions) = ('cd:lov');
+my($pkg_dbdir);
+die("usage: $0 [-d pkg_dbdir] [-clov]\n") if (!getopts($opts, \%opt));
+$usecolor = $opt{c};
+$pkg_dbdir = $opt{d} || $ENV{'PKG_DBDIR'} || "/var/db/pkg";
+$locations = $opt{l};
+$order = $opt{o};
+$versions = $opt{v};
+
+my(@pkgs, $pkg, $req, %req, @reqs, @rreqs);
+my(%where, %leaf, $pkgcnt, $num, %num, @num, %ord, @ord, $suffix);
+my(%color, $color1, $color2, $ecolor, %vuln);
+my(%need, $label);
+
+##
+## load out-of-date or security problem list (if given)
+##
+if (@ARGV || ! -t) {
+    $usecolor = 1;
+    while (<>) {
+	if (/^Version mismatch: '(\S+)' (\S+) vs (\S+)/) {
+	    $color{"$1-$2"} = "red";
+	    $need{"$1-$2"} = "$1-$3";
+	}
+	elsif (/^Unknown package: '(\S+)' version (\S+)/) {
+	    $color{"$1-$2"} = "purple";
+	}
+	elsif (/Package (\S+) has a (\S+) vulnerability/) {
+	    $vuln{$1} = $2;
+	    $color{$1} = "red";
+	    # $1 =~ /(\S+)-([0-9\.]*([a-z]+\d*)?(nb[0-9]*)?)$/i;
+	}
+    }
+}
+
+##
+## load pkg list
+##
+chdir($pkg_dbdir);
+opendir(P, ".") || die("opendir");
+@pkgs = grep(/-/, readdir(P));
+closedir(P);
+$pkgcnt = @pkgs;
+
+##
+## where are they needed
+##
+foreach $pkg (@pkgs) {
+    $where{$pkg} = $pkg;
+    $leaf{$pkg} = 1 unless (defined($leaf{$pkg}));
+    open(R, "<$pkg/+BUILD_INFO") ||
+	die("$pkg: +BUILD_INFO: $!\n");
+    while (<R>) {
+	if (/^PKGPATH\s*=\s*(\S+)/) {
+	    $where{$pkg} = $1;
+	    last;
+	}
+    }
+    close(R);
+    next if (!open(R, "<$pkg/+REQUIRED_BY"));
+    while ($req = <R>) {
+	chomp($req);
+	$leaf{$pkg} = 0;
+	$req{$req}->{$pkg} = 1;
+#	print("$req -> $pkg\n");
+    }
+}
+
+##
+## eliminate redundancies by deleting edges that are redundant
+##
+foreach $pkg (@pkgs) {
+    @reqs = sort(keys %{$req{$pkg}});
+    @rreqs = recurse(@reqs);
+#    print("$pkg -> (@reqs) -> (@rreqs)\n");
+    map(delete($req{$pkg}->{$_}), @rreqs);
+}
+
+##
+## impose some sort of order on the pkgs by assigning them numbers
+## that indicate their height in the graph
+##
+foreach $pkg (@pkgs) {
+    order(1, $pkg);
+}
+
+sub order {
+    my($n, @pkgs) = @_;
+    my($pkg);
+    foreach $pkg (@pkgs) {
+	$ord{$pkg} = $n if ($ord{$pkg} <= $n);
+	order($n + 1, sort(keys %{$req{$pkg}}));
+    }
+}
+
+##
+## assign each pkg a group number, and count the number of pkgs in
+## that group.  the higher the number, the earlier we need to assign
+## them to a group.
+##
+$num = 1;
+foreach $pkg (sort(byord @pkgs)) {
+    my($pkgnum);
+    @reqs = sort(keys %{$req{$pkg}});
+    @rreqs = recurse(@reqs);
+    $pkgnum = number($pkg, @reqs, @rreqs) || $num;
+    foreach $req ($pkg, @reqs, @rreqs) {
+	$num[$num{$req}]--;
+	$num{$req} = $pkgnum;
+	$num[$num{$req}]++;
+    }
+    $num++;
+}
+
+##
+## show left overs as a graph
+##
+print("digraph \"packages\" {\n");
+foreach $pkg (sort(bynum @pkgs)) {
+    $color1 = color($pkg);
+    $label = $pkg;
+    $label =~ s/(.*)-.*/$1/ if (!$versions);
+    $label = "($ord{$pkg}) $label" if ($order);
+    $label = "$where{$pkg}\\n$label" if ($locations);
+    $label .= "\\n$need{$pkg}" if ($need{$pkg});
+    if ($vuln{$pkg}) {
+	$label .= "\\n(no update available)" if (!$need{$pkg});
+	$label .= "\\n[$vuln{$pkg}]";
+    }
+    $suffix = "\t// \#$ord{$pkg}, group $num{$pkg}, $num[$num{$pkg}] members, $pkgcnt pkgs";
+    $suffix .= ", LEAF" if ($leaf{$pkg});
+    printf("\"%s\" [color=\"%s\",label=\"%s\"];$suffix\n", $pkg , $color1, $label);
+    @reqs = sort(keys %{$req{$pkg}});
+#    print("// $pkg -> (@reqs)\n");
+    $suffix =~ s/, LEAF$//;
+    $suffix .= ", EDGE";
+    foreach $req (@reqs) {
+	$color2 = color($req);
+	printf("\"%s\" -> \"%s\" [color=\"%s\"];$suffix\n", $req, $pkg, $color2);
+    }
+}
+print("}\n");
+
+##
+## find all dependencies below a given node
+##
+sub recurse {
+    my($pkg, @list, %list);
+    %list = @list = ();
+    foreach $pkg (@_) {
+	@list = keys %{$req{$pkg}};
+	map($list{$_} = $_, @list, recurse(@list));
+    }
+    sort(keys %list);
+}
+
+##
+## lowest number of a graph
+##
+sub number {
+    my($n, $pkg);
+    $n = 0;
+    foreach $pkg (@_) {
+	$n = $num{$pkg} if ($n == 0 || $num{$pkg} < $n);
+    }
+    $n + 0;
+}
+
+##
+## pick a color based on the color of the dependencies
+##
+sub color {
+    my($pkg) = @_;
+    if (! $usecolor) {
+	"black";
+    }
+    elsif ($color{$pkg}) {
+	$color{$pkg};
+    }
+    else {
+	my($req, @reqs, $color);
+	@reqs = sort(keys %{$req{$pkg}});
+	@reqs = (@reqs, recurse(@reqs));
+	$color = "green";
+	foreach $req (@reqs) {
+	    if ($color{$req} eq "red") {
+		return "orange"; 
+	    }
+	    elsif ($color{$req} eq "purple") {
+		$color = "blue";
+	    }
+	}
+	$color;
+    }
+}
+
+##
+## bynum - higher numbers come last
+##
+sub bynum {
+    return $num{$a} <=> $num{$b} ||
+	$a cmp $b;
+}
+
+##
+## byord - higher orders comes first
+##
+sub byord {
+    return $ord{$b} <=> $ord{$a} ||
+	$b cmp $a;
+}