Add a new -m option that prints sh script which invokes make for each

"interesting" package, where "interesting" is defined by the other
options given on the command line.

Rework the "rebuild", "delete", and "fetch" output modes to use a new
generic routine invoked with (the new) -m option.  Other new options
are:

 -a all packages (to make more packages becoming "interesting")
 -e adds an "existence check" to each of the lines of sh(1) style
    output (ala the current rebuild output)
 -r reverses the order in which the packages are listed
 -S package
    selects a subgraph of the installed package base
 -s print a simple list of packages instead of sh commands

Also: fix a dreadful bug in the group number assignment loop.  Groups
are now assigned more properly, meaning that wholely selected
subgraphs (via the new -S option) work.

Welcome to version 2.5.

3 files changed, 274 insertions, 67 deletions

diff --git a/pkgtools/pkgdepgraph/Makefile b/pkgtools/pkgdepgraph/Makefile
index bd05b59e4cb..27c18be7c8a 100644
--- a/pkgtools/pkgdepgraph/Makefile
+++ b/pkgtools/pkgdepgraph/Makefile
@@ -1,7 +1,7 @@
-# $NetBSD: Makefile,v 1.10 2003/03/29 12:42:11 jmmv Exp $
+# $NetBSD: Makefile,v 1.11 2003/04/30 03:39:17 atatat Exp $
 #
 
-DISTNAME=	pkgdepgraph-2.4
+DISTNAME=	pkgdepgraph-2.5
 WRKSRC=		${WRKDIR}
 CATEGORIES=	pkgtools devel
 MASTER_SITES=	# empty
diff --git a/pkgtools/pkgdepgraph/files/pkgdepgraph.1 b/pkgtools/pkgdepgraph/files/pkgdepgraph.1
index 847fc81fdce..e2daffbd1a3 100644
--- a/pkgtools/pkgdepgraph/files/pkgdepgraph.1
+++ b/pkgtools/pkgdepgraph/files/pkgdepgraph.1
@@ -1,4 +1,4 @@
-.\"	$NetBSD: pkgdepgraph.1,v 1.7 2003/04/16 09:50:01 wiz Exp $
+.\"	$NetBSD: pkgdepgraph.1,v 1.8 2003/04/30 03:39:17 atatat Exp $
 .\"
 .\" Copyright (c) 2002, 2003 by Andrew Brown <atatat@netbsd.org>
 .\" Absolutely no warranty.
@@ -10,12 +10,14 @@
 .Nd visual representation of installed packages
 .Sh SYNOPSIS
 .Nm
-.Op Fl ACcDFfgLloRv
+.Op Fl AaCcDeFfgLloRrsv
 .Op Fl d Ar pkg_dbdir
 .Op Fl K Ar packages
 .Op Fl M Ar make
+.Op Fl m Ar target
 .Op Fl O Ar package
 .Op Fl P Ar pkgsrcdir
+.Op Fl S Ar package
 .Op Fl t Ar target
 .Op Fl U Ar package
 .Op Pa data ...
@@ -75,12 +77,26 @@ The package has been removed and not yet replaced, or the graph is
 uncolored.
 The difference between an uncolored graph and a graph that has been
 recolored almost entirely black as a result of removing all the
-packages can be visually detected by the presence of the
+packages can be visually detected by the color of the
 .Nm
-package.
+package with which the graph was recolored.
 .El
 .Pp
-The options are as follows:
+It is important to note that all installed packages fall into one (or
+more) of the following categories:
+.Bl -tag -width out-of-date
+.It installed
+Any installed package.
+.It out of date
+Any package that can be upgraded.
+.It stale
+Any package that depends on a package that is out of date.
+.It leaf
+Any package that is not depended on by any other package.
+.El
+.Pp
+Selecting the type or types of packages that are listed, and how the
+information is put to use, can be controlled by the following options:
 .Bl -tag -width package
 .It Fl A
 This option modifies the output of
@@ -89,6 +105,21 @@ to use
 .Xr pkg_add 1
 to reinstall deleted packages, instead of building directly from the
 pkgsrc tree.
+.It Fl a
+All packages.
+This option can be specified more than once to augment the meaning of
+.Dq all
+as it relates to the selected output mode.
+For the default graph output, this option has no effect.
+When used with
+.Fl m
+where the default output is the list of out of date packages, one
+.Fl a
+will make
+.Nm
+also list stale packages, and a second
+.Fl a
+will make it list all installed packages.
 .It Fl C
 Asserts
 .Fl c
@@ -115,12 +146,21 @@ This is a good first step to take before rebuilding all your packages
 that are out of date (see the
 .Fl R
 option).
+This option is an alias for
+.Fl as .
 .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 e
+Adds an
+.Dq existence check
+to each of the lines of
+.Xr sh 1
+style output so that commands can be skipped if the package is already
+installed.
 .It Fl F
 Makes
 .Nm
@@ -128,6 +168,8 @@ emit a series of
 .Xr sh 1
 commands that will fetch all the required distfiles for rebuilding out
 of date packages.
+This option is an alias for
+.Fl m Ar fetch . 
 .It Fl f
 Force a rebuild of all dependent packages.
 This option is for use in conjunction with the
@@ -154,6 +196,13 @@ appended to it.
 .It Fl L
 Limit the graph to those packages that are out of date
 or ultimately depend on some package that is.
+When used with
+.Fl m
+or
+.Fl s ,
+this limits the list to
+.Dq leaf
+packages that are out of date or stale.
 .It Fl l
 Adds package
 .Dq location
@@ -176,6 +225,16 @@ command or the correct choice might not be named
 The default value for this is taken from the MAKE environment
 variable, if it is set, or is simply
 .Dq make .
+.It Fl m Ar target
+Emits generic
+.Xr sh 1
+commands to 
+.Dq make Ar target
+for each listed package.
+One interesting target to specify is
+.Ar '$*'
+since that will yield a script that will pass its own command
+line arguments to make for processing.
 .It Fl O Ar package
 Marks
 .Ar package
@@ -209,6 +268,61 @@ all the deleted leaf packages.
 Packages that are out of date should be deleted first (see the
 .Fl D
 option).
+This option is an alias for
+.Fl eLm Ar target .
+See the
+.Fl t
+option for a description of what value is used for
+.Ar target .
+.It Fl r
+Reverses the order in which the packages are listed.
+.It Fl S Ar package
+Selects a subgraph of the installed package base around which to
+generate output.
+By default, if a subgraph of
+.Ar package
+is requested, only
+.Ar package
+and those packages immediately above and below it in the graph will be
+listed.
+To select only those immediately below, prefix a
+.Dq -
+to the package name.
+To select all packages below
+.Ar package ,
+prefix
+.Dq --
+to the package name.
+To select packages above
+.Ar package ,
+use
+.Dq +
+and
+.Dq ++
+as appropriate.
+To select all packages remotely connected to
+.Ar package ,
+add
+.Dq =
+to the beginning.
+Note: take care when using this option with generated lists or sh
+scripts.
+Since the subgraph of packages selected by this option may not include
+all stale or out of date packages involved in a proper package update
+procedure, the lists may be incomplete and can cause problems.
+.It Fl s
+Print a simple list of packages instead of
+.Xr sh
+commands.
+The default output set for this command is out of date packages from
+the entire package set.
+Use combinations of
+.Fl a ,
+.Fl L ,
+.Fl O Ar package ,
+and
+.Fl S Ar package
+to select more or other package lists.
 .It Fl t Ar target
 Changes the target of the
 .Fl R
@@ -371,12 +485,15 @@ reasonable, despite what you may think of perl.
 .Pp
 The
 .Dq rebuild
-output and the
+output,
 .Dq fetch
+output, and the generic
+.Dq make target
 output (see the
-.Fl R
+.Fl R ,
+.Fl F ,
 and
-.Fl F
+.Fl m
 options) do not deal very well with packages that have moved within
 the pkgsrc tree.
 It is necessary that you edit the rebuild script by hand to work
diff --git a/pkgtools/pkgdepgraph/files/pkgdepgraph.pl b/pkgtools/pkgdepgraph/files/pkgdepgraph.pl
index ce94a1d9881..5e70be44f63 100755
--- a/pkgtools/pkgdepgraph/files/pkgdepgraph.pl
+++ b/pkgtools/pkgdepgraph/files/pkgdepgraph.pl
@@ -3,10 +3,11 @@
 # Copyright (c) 2002, 2003 by Andrew Brown <atatat@netbsd.org>
 # Absolutely no warranty.
 
-# $NetBSD: pkgdepgraph.pl,v 1.7 2003/03/26 04:50:19 atatat Exp $
+# $NetBSD: pkgdepgraph.pl,v 1.8 2003/04/30 03:39:18 atatat Exp $
 # pkgdepgraph: @DISTVER@
 
 use strict;
+# no strict 'refs';
 
 use Getopt::Long;
 Getopt::Long::Configure("bundling");
@@ -14,42 +15,51 @@ my(@opts, %opt);
 my($iam, $version, $usecolor, $group, $locations, $order, $versions);
 my($limit, $delete, $rebuild, $force, @outofdate, @update, $clean);
 my($pkg_dbdir, $pkgsrcdir, $packages, $pkgadd, $fetch, $make);
+my($all, $target, $exists, $reverse, $simple, @subgraph);
 
 $version = '@DISTVER@';
 ($iam = $0) =~ s:.*/::;
-@opts = ('A', 'C', 'c', 'D', 'd=s', 'F', 'f', 'g', 'K=s', 'L', 'l',
-	 'M=s', 'O=s', 'o', 'P=s', 'R', 't=s', 'U=s', 'v');
+@opts = ('A', 'a+', 'C', 'c', 'D', 'd=s', 'e', 'F', 'f', 'g', 'K=s',
+	 'L', 'l', 'M=s', 'm=s', 'O=s', 'o', 'P=s', 'R', 'r', 'S=s',
+	 's', 't=s', 'U=s', 'v');
 %opt = (
 	'A' => \$pkgadd,
+	'a' => \$all,
 	# 'C' => implies "realclean", handled later
 	# 'c' => implies "clean", handled later
 	'D' => \$delete,
 	'd' => \$pkg_dbdir,
-	'f' => \$force,
+	'e' => \$exists,
 	'F' => \$fetch,
+	'f' => \$force,
 	'g' => \$group,
 	'K' => \$packages,
 	'L' => \$limit,
 	'l' => \$locations,
 	'M' => \$make,
+	'm' => \$target,
 	'O' => \@outofdate,
 	'o' => \$order,
 	'P' => \$pkgsrcdir,
 	'R' => \$rebuild,
+	'r' => \$reverse,
+	'S' => \@subgraph,
+	's' => \$simple,
 	# 't' => goes to rebuild, handled later
 	'U' => \@update,
 	'v' => \$versions,
 	);
-die("usage: $iam [-ACcDFfgLloRv] [-d pkg_dbdir] [-K packages] [-M make]\n",
+die("usage: $iam [-AaCcDeFfgLloRrsv] [-d pkg_dbdir] [-K packages] [-M make]\n",
     " " x (length($iam) + 8),
-    "[-O package] [-P pkgsrcdir] [-t target] [-U package]\n",
+    "[-m target] [-O package] [-P pkgsrcdir] [-S package]\n",
     " " x (length($iam) + 8),
-    "[data ...]\n")
+    "[-t target] [-U package] [data ...]\n")
     if (!GetOptions(\%opt, @opts));
 
-die("$iam: -D, -F, and -R are mutually exclusive -- please pick one\n")
+die("$iam: -D, -F, -m, and -R are mutually exclusive -- please pick one\n")
     if (($delete != 0) + 
 	($fetch != 0) +
+	($target ne "") +
 	($rebuild ne "") > 1);
 
 $pkg_dbdir ||= $ENV{'PKG_DBDIR'} || "/var/db/pkg";
@@ -62,12 +72,13 @@ $clean = "clean" if ($opt{c});
 $clean = "CLEANDEPENDS=YES clean" if ($opt{C});
 $make ||= $ENV{'MAKE'} || "make";
 
-my(@pkgs, $pkg, $req, %req, @reqs, @rreqs);
+my(@pkgs, $pkg, $req, %req, %dep, @reqs, @rreqs);
 my(%clusters, $cluster);
 my(%where, $pkgcnt, $num, %num, @num, %ord, @ord, $suffix);
 my(%color, $color, %vuln);
 my(%need, %forced, $label);
 my($recolor, @graph);
+my(%vpkgs);
 
 ##
 ## load out-of-date or security problem list (if given), or a graph to
@@ -128,6 +139,7 @@ foreach $pkg (@pkgs) {
     while ($req = <R>) {
 	chomp($req);
 	$req{$req}->{$pkg} = 1;
+	$dep{$pkg}->{$req} = 1;
     }
     close(R);
 }
@@ -205,8 +217,12 @@ if ($recolor) {
 ##
 foreach $pkg (@pkgs) {
     @reqs = sort(keys %{$req{$pkg}});
-    @rreqs = recurse(@reqs);
+    @rreqs = recurse(\%req, @reqs);
     map(delete($req{$pkg}->{$_}), @rreqs);
+
+    @reqs = sort(keys %{$dep{$pkg}});
+    @rreqs = recurse(\%dep, @reqs);
+    map(delete($dep{$pkg}->{$_}), @rreqs);
 }
 
 ##
@@ -240,22 +256,38 @@ map(order(1, $_), @pkgs);
 
 ##
 ## assign each pkg a group number, and count the number of pkgs in
-## that group.  the higher the order number, the earlier we need to
-## assign them to a group.  the group numbers are arbitrary, and serve
-## only to identify pkgs that belong to the same group.
+## that group.  the group numbers are arbitrary, and serve only to
+## identify pkgs that belong to the same group.
 ##
 $num = 1;
-foreach $pkg (sort(byord @pkgs)) {
+foreach $pkg (@pkgs) {
     my($pkgnum);
+    # my direct requirements
     @reqs = sort(keys %{$req{$pkg}});
-    @rreqs = recurse(@reqs);
+    # all the requirements of my requirements
+    @rreqs = recurse(\%req, @reqs);
+    # the lowest group number from all of those
     $pkgnum = number($pkg, @reqs, @rreqs) || $num;
+    # stuff all those into the list for that group 
+    push(@{$num[$pkgnum]}, $pkg, @reqs, @rreqs);
+    # now check for packages coming from other groups
     foreach $req ($pkg, @reqs, @rreqs) {
-	$num[$num{$req}]--;
-	$num{$req} = $pkgnum;
-	$num[$num{$req}]++;
+	# no group yet, skip on
+	next if (!$num{$req});
+	# was $req in a different group
+	if ($num{$req} != $pkgnum) {
+	    # yes, pull that group into the current group 
+	    push(@{$num[$pkgnum]}, @{$num[$num{$req}]});
+	    # empty out the old group
+	    @{$num[$num{$req}]} = ();
+	}
     }
-    $num++;
+    # reduce the group list
+    @{$num[$pkgnum]} = uniq(sort(@{$num[$pkgnum]}));
+    # make sure all packages in this group know 
+    map($num{$_} = $pkgnum, @{$num[$pkgnum]});
+    # skip to next available group number
+    $num += ($num == $pkgnum);
 }
 
 ##
@@ -286,7 +318,7 @@ if (@update) {
     my(@leftover);
 
     canonicalize(@update);
-    @update = uniq(sort(@update, recurse(@update)));
+    @update = uniq(sort(@update, recurse(\%req, @update)));
 
     if ($force) {
 	foreach (@update) {
@@ -312,43 +344,73 @@ if (@update) {
 }
 
 ##
-## "delete" output, ordered with "least depended on" first
+## pick packages for a subgraph
 ##
-if ($delete) {
-    map(print("$_\n"),
-	reverse(sort(byord grep(color($_) ne "green", @pkgs))));
-    exit(0);
+## + means up from given package, - means down, ++ means all the way
+## up, -- means all the way down, = means all "connected" packages, etc.
+##
+if (@subgraph) {
+    my ($sub, $up, $down, $eq);
+    foreach (@subgraph) {
+	($sub) = (/^([-+=]+)/);
+	s/^[-+=]+//;
+	$sub = "+-" if ($sub eq "");
+	canonicalize($_);
+	$up = join("", ($sub =~ /(\+)/g));
+	$down = join("", ($sub =~ /(-)/g));
+	$eq = join("", ($sub =~ /(=)/g));
+	if ($eq) {
+	    map($vpkgs{$_} = 1, @{$num[$num{$_}]});
+	}
+	else {
+	    if ($up) {
+		@reqs = sort(keys %{$req{$_}});
+		@rreqs = (length($up) > 1) ? recurse(\%req, @reqs) : ();
+		map($vpkgs{$_} = 1, ($_, @reqs, @rreqs));
+	    }
+	    if ($down) {
+		@reqs = sort(keys %{$dep{$_}});
+		@rreqs = (length($down) > 1) ? recurse(\%dep, @reqs) : ();
+		map($vpkgs{$_} = 1, ($_, @reqs, @rreqs));
+	    }
+	}
+    }
+}
+else {
+    @vpkgs{@pkgs} = (1) x @pkgs;
 }
 
 ##
-## "fetch" output, in no particular order (as with the rebuild
-## output), but with all out-of-date pkgs listed, instead of all stale
-## leaf pkgs.
+## translate "older" alternate output modes to the new generic version
 ##
 if ($fetch) {
-    map(print("( cd $pkgsrcdir/$where{$_} && $make fetch ) &&\n"),
-	grep(color($_) eq "red", @pkgs));
-    print("true\n");
-    exit(0);
+    $target = "fetch";
+}
+elsif ($rebuild) {
+    $exists = 1;
+    $limit = 1;
+    $target = $rebuild;
+}
+elsif ($delete) {
+    $all++;
+    $simple = 1;
 }
 
 ##
-## "rebuild" output for sh(1), with just leaves listed.  all the
-## dependencies will be built "automagically" by the regular build
-## mechanism.  if $add is set, emit commands for installing binary
-## pkgs instead.
-##
-if ($rebuild) {
-    printf("PKG_PATH=\"$packages\"\nexport PKG_PATH\n") if ($pkgadd);
-
-    map($pkgadd ?
-	printf("( pkg_info -qe %s || pkg_add %s.tgz ) &&\n",
-	       /(.*)-.*/, ($need{$_} || $_)) :
-	printf("( pkg_info -qe %s || ( cd %s && $make %s%s )) &&\n",
-	       /(.*)-.*/, "$pkgsrcdir/$where{$_}",
-	       $rebuild, $clean ? " && $make $clean" : ""),
-	grep(color($_) ne "green" && $ord{$_} == 1, @pkgs));
-    print("true\n");
+## "target" output mode, ordered by ascendency
+##
+if ($target || $simple) {
+    my(@targets);
+    printf("PKG_PATH=\"$packages\"\nexport PKG_PATH\n")
+	if ($pkgadd && $rebuild);
+    @targets = grep((color($_) eq "red" && !$limit) ||
+		    (color($_) ne "green" &&
+		     ($all || ($ord{$_} == 1 && $limit))) ||
+		    ($all > 1), keys %vpkgs);
+    @targets = sort(byord @targets);
+    @targets = reverse(@targets) if (!$reverse);
+    print_package(@targets);
+    print("true\n") if (!$simple);
     exit(0);
 }
 
@@ -357,10 +419,11 @@ if ($rebuild) {
 ##
 printf("digraph \"%s packages\" {\n",
        $limit ? "out of date" : "installed");
-printf("label = \"%s packages graph, generated by %s v%s, on %s\";\n",
+printf("label = \"%s packages %s, generated by %s v%s, on %s\";\n",
        $limit ? "out of date" : "installed",
+       @subgraph ? "subgraph (@subgraph)" : "graph",
        $iam, $version, scalar(localtime));
-foreach $pkg (sort(bynum @pkgs)) {
+foreach $pkg (sort(bynum keys %vpkgs)) {
     $color = color($pkg);
     next if ($limit && $color eq "green");
     $label = $pkg;
@@ -372,7 +435,8 @@ foreach $pkg (sort(bynum @pkgs)) {
 	$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 = "\t// \#$ord{$pkg}, group $num{$pkg}, " .
+	scalar(@{$num[$num{$pkg}]}) . " members, $pkgcnt pkgs";
     $suffix .= ", LEAF" if ($ord{$pkg} == 1);
 
     ##
@@ -412,14 +476,40 @@ foreach $pkg (sort(bynum @pkgs)) {
 print("}\n");
 
 ##
-## find all dependencies below a given node
+## print sh(1) style commands to handle work on a given package, or
+## just the package name if $simple is set
+##
+sub print_package {
+    foreach (@_) {
+	printf("( pkg_info -qe %s || ", /(.*)-.*/) if ($exists && !$simple);
+	if ($simple) {
+	    print($_);
+	}
+	elsif ($pkgadd) {
+	    printf("( pkg_add %s.tgz", ($need{$_} || $_));
+	}
+	else {
+	    print("( cd $pkgsrcdir/$where{$_} && $make $target");
+	    print(" && $make $clean") if ($clean);
+	}
+	if (!$simple) {
+	    print(" )") if ($exists);
+	    print(" ) &&");
+	}
+	print("\n");
+    }
+}
+
+##
+## find all dependencies above or below a given node
 ##
 sub recurse {
-    my(@list, @new);
+    my(@list, @new, $map);
     @list = ();
+    $map = shift;
     foreach (@_) {
-	@new = keys %{$req{$_}};
-	push(@list, @new, recurse(@new));
+	@new = keys %{$map->{$_}};
+	push(@list, @new, recurse($map, @new));
     }
     uniq(sort(@list));
 }
@@ -448,7 +538,7 @@ sub canonicalize {
 }
 
 ##
-## lowest number of a graph
+## lowest group number of a set of packages
 ##
 sub number {
     my($n, $pkg);
@@ -470,7 +560,7 @@ sub color {
     else {
 	my($req, @reqs, $color);
 	@reqs = sort(keys %{$req{$pkg}});
-	@reqs = (@reqs, recurse(@reqs));
+	@reqs = (@reqs, recurse(\%req, @reqs));
 	$color = "green";
 	foreach $req (@reqs) {
 	    if ($color{$req} eq "red") {