mirror of
https://git.freebsd.org/ports.git
synced 2025-05-27 08:26:27 -04:00
The way it works is that it calls pkg info 3 times, so there is a possibility of losing consistency. The -r option added for displaying the "Required by" graph instead of the "Depends on" graph. Pass maintainership to submitter PR: 256214
134 lines
3 KiB
Text
134 lines
3 KiB
Text
--- pkg_tree.orig 2001-12-12 11:44:40 UTC
|
|
+++ pkg_tree
|
|
@@ -26,7 +26,7 @@
|
|
# 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 LICESE.
|
|
+# For license issues, see the file LICENSE.
|
|
# For more information, see the website: http://www.mavetju.org
|
|
#
|
|
|
|
@@ -34,31 +34,77 @@ use strict;
|
|
|
|
use Getopt::Std;
|
|
|
|
-use vars qw/ $opt_v /;
|
|
+use vars qw/ $opt_b $opt_q $opt_r $opt_t $opt_v /;
|
|
|
|
$opt_v=0;
|
|
-getopts("v");
|
|
+$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";
|
|
-my @dirs=readdir DIR;
|
|
+@dirs=readdir DIR;
|
|
closedir DIR;
|
|
|
|
@dirs=grep !/^\./,@dirs;
|
|
+@dirs=grep !/^pkgdb.db$/,@dirs;
|
|
@dirs=sort @dirs;
|
|
|
|
-my @args=@ARGV;
|
|
-my $hasargs=$#ARGV>=0;
|
|
-
|
|
-my %required; # this key is required by other packages
|
|
-my %requires; # this key requires other packages
|
|
-
|
|
#
|
|
# Read from every package the +REQUIRED_BY file. This file contains
|
|
# info about the packages which require this package.
|
|
#
|
|
-my $pkg;
|
|
foreach $pkg (@dirs) {
|
|
$required{$pkg}[0]=0;
|
|
if (open FILE,$PKGDIR."/".$pkg."/+REQUIRED_BY") {
|
|
@@ -101,6 +147,10 @@ foreach $pkg (@dirs) {
|
|
}
|
|
}
|
|
|
|
+} # end pkg_install
|
|
+else {
|
|
+ die;
|
|
+}
|
|
|
|
#
|
|
# Print the dependancies (recursive) of the packages
|
|
@@ -141,6 +191,11 @@ sub print_deps {
|
|
# 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;
|
|
@@ -150,8 +205,10 @@ foreach $pkg (@dirs) {
|
|
}
|
|
next if (!$found);
|
|
}
|
|
+ next if ($opt_t && $required{$pkg}[0]!=0);
|
|
+ next if ($opt_b && $requires{$pkg}[0]!=0);
|
|
print "$pkg\n";
|
|
- if ($requires{$pkg}[0]!=0) {
|
|
+ if (!$opt_q && $requires{$pkg}[0]!=0) {
|
|
print_deps("|"," ",1,$pkg);
|
|
}
|
|
}
|