#!/usr/local/bin/perl -w

# $Id: pkg_tree,v 1.2 2001/12/12 11:38:47 mavetju Exp $

#
# PKG-TREE
#
# Generates a ascii-art-graphical tree of packages and their dependancies.
# For example for itk-3.2_1:
#
#	[~] edwin@k7>pkg_tree itk  
#	itk-3.2_1
#	|\__ freetype2-2.0.4
#	|\__ tcl-8.3.3_3 (unknown)
#	|\__ itcl-3.2
#	|      \__ tcl-8.3.3_3 (unknown)
#	|\__ imake-4.1.0 (unknown)
#	|\__ tk-8.3.3
#	|     |\__ tcl-8.3.3_3 (unknown)
#	|     |\__ imake-4.1.0 (unknown)
#	|     |\__ freetype2-2.0.4
#	|      \__ XFree86-libraries-4.1.0 (unknown)
#	 \__ XFree86-libraries-4.1.0 (unknown)
# 
# Unknown means that the package is no longer in /var/db/pkg, most likely
# updated by a newer version. In case of tcl-8.3.3_3, this is tcl-8.3.3_4.
#
# PKG-TREE is (c) Edwin Groothuis, edwin@mavetju.org
# For license issues, see the file LICENSE.
# For more information, see the website: http://www.mavetju.org
#

use strict;

use Getopt::Std;

use vars qw/ $opt_b $opt_q $opt_r $opt_t $opt_v /;

$opt_v=0;
$opt_t=0;
$opt_b=0;
$opt_q=0;
$opt_r=0;
getopts("bqrtv");

my @args=@ARGV;
my $hasargs=$#ARGV>=0;

my %required;	# this key is required by other packages
my %requires;	# this key requires other packages
my @dirs;
my $pkg;

`pkg -N 2>&1`;
my $child_error_pkg_N = $?;

if ($child_error_pkg_N == 0) {	# begin pkgng

    my $re_trim = qr/^\s+|\s+$/o;
    my $re_pkg = qr/^\s+/o;
    my $re_dep = qr/^Depends on     :$/o;
    my $re_req = qr/^Required by    :$/o;
    my($line, $r);

    $line = `pkg info -d -r -a`;
    if ($? == 0) {
	my @lines = split(/^/, $line);
	$pkg = '';
	foreach $line (@lines) {
	    if ($line =~ $re_dep) {
		$r = \%requires;
	    } elsif ($line =~ $re_req) {
		$r = \%required;
	    } elsif ($line =~ $re_pkg) {
		$line =~ s/$re_trim//g;
		${$r}{$pkg}[++${$r}{$pkg}[0]] = $line;
	    } else {
		$pkg = $line;
		$pkg =~ s/$re_trim//g;
		push(@dirs, $pkg);
		unless (exists $required{$pkg}) {
		    $required{$pkg}[0] = 0;
		}
		unless (exists $requires{$pkg}) {
		    $requires{$pkg}[0] = 0;
		}
	    }
	}
    }

}	# end pkgng
elsif (-e '/usr/sbin/pkg_info') {	# begin pkg_install

my $PKGDIR="/var/db/pkg";

opendir DIR,$PKGDIR or die "Couldn't open $PKGDIR";
@dirs=readdir DIR;
closedir DIR;

@dirs=grep !/^\./,@dirs;
@dirs=grep !/^pkgdb.db$/,@dirs;
@dirs=sort @dirs;

#
# Read from every package the +REQUIRED_BY file. This file contains
# info about the packages which require this package.
#
foreach $pkg (@dirs) {
    $required{$pkg}[0]=0;
    if (open FILE,$PKGDIR."/".$pkg."/+REQUIRED_BY") {
	my @lines=();
	my $line;
	my $count=0;

	@lines=<FILE>;
	chomp @lines;
	foreach $line (@lines) {
	    $required{$pkg}[++$count]=$line;
	}
	$required{$pkg}[0]=$count;
	close FILE;
    }
}

#
# Read from every packege the +CONTENTS. The lines starting with @pkgdep
# tell which packages they are depending on.
#
foreach $pkg (@dirs) {
    $requires{$pkg}[0]=0;
    if (open FILE,$PKGDIR."/".$pkg."/+CONTENTS") {
	my @lines=();
	my $line;
	my $count=0;
	my @w;

	@lines=<FILE>;
	chomp @lines;
	@lines=grep /^\@pkgdep/,@lines;

	foreach $line (@lines) {
	    @w=split(" ",$line);
	    $requires{$pkg}[++$count]=$w[1];
	}
	$requires{$pkg}[0]=$count;
	close FILE;
    }
}

}	# end pkg_install
else {
	die;
}

#
# Print the dependancies (recursive) of the packages
#
sub print_deps {
    my $prefixwith=shift;
    my $prefixwithout=shift;
    my $shift=shift;
    my $pkg=shift;
    my $i=0;

    while (++$i<=$requires{$pkg}[0]) {
	if ($i!=$requires{$pkg}[0]) {
	    print $prefixwith;
	} else {
	    print $prefixwithout;
	}
	print "\\__ ";
	print "$requires{$pkg}[$i]";
	if (defined $requires{$requires{$pkg}[$i]}[0]) {
	    print "\n";
	    if ($opt_v==1) {
		if ($i!=$requires{$pkg}[0]) {
		    print_deps("$prefixwith     |","$prefixwith      ",
				$shift+1,$requires{$pkg}[$i]);
		} else {
		    print_deps("$prefixwithout     |","$prefixwithout      ",
				$shift+1,$requires{$pkg}[$i]);
		}
	    }
	} else {
	    print " (unknown)\n";
	}
    }
}

#
# Print all packages or, if there is a command line argument, the ones which
# matches one of the arguments.
#
if ($opt_r) {
    my %t = %required;
    %required = %requires;
    %requires = %t;
}
foreach $pkg (@dirs) {
    if ($hasargs) {
	my $found=0;
	my $arg;
	foreach $arg (@args) {
	   $found=1 if ($pkg=~/$arg/);
	}
	next if (!$found);
    }
    next if ($opt_t && $required{$pkg}[0]!=0);
    next if ($opt_b && $requires{$pkg}[0]!=0);
    print "$pkg\n";
    if (!$opt_q && $requires{$pkg}[0]!=0) {
	print_deps("|"," ",1,$pkg);
    }
}

