#!/usr/bin/perl
#
# $Id: pkgmy,v 1.42 2022/01/13 14:29:08 pdc Exp $
# http://kobyla.info/soft/freebsd/pkgmy
# (C) 2012-2013 Pavel Polyakov
#
# Ideas from: 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 integer;
use feature ":5.10";

my $PKGDIR="/var/db/pkg";
my $PORTSDIR="/usr/ports";

our @dirs=();
our %required;	# this pkg is required by other packages
our %requires;	# this pkg requires other packages
our %origin;	# package origin
our %atorigin;	# package(s) at this origin
our %installed;	# installed packages
our %missing;	# missing packages - found in requirements



$D=5;
my $err=0;
my $where=\*STDOUT;

$opt_b=0;
$opt_h=0;	# help
$opt_k=0;	# grep by key
$opt_l=0;	# list names only
$opt_n=0;	# grep by name
$opt_q=0;
$opt_c=0;	# check
$opt_d=0;	# depends
$opt_D=0;	# print depends
$opt_i=0;	# index import/grep
$opt_o=0;	# print origin
$opt_p=0;	# pkg import
$opt_t=0;

$verbose=0;
$import_index=0;
$import_pkg=0;

my @args;
my $cmd='';

sub arg1($){
	shift;
	my $cnt;
	if(s/^-+//) {				# option
		if($cnt = s/v//g) {
			$verbose+=$cnt;
			print STDERR "opt_v: $cnt\n";
		}

		for my $o (split(//,'cdDbihklntopq')) { eval qq!
			if(\$cnt = s/$o//g) {
				\$opt_$o+=\$cnt;
				#print STDERR "opt_$o: \$cnt\\n";
			}	
		!}

		if($_ ne '')  {
			print STDERR "unknown option: $_\n";
			$err=1;
		}
	}

	elsif(m%^:?(install|makeadr|reinstall|adr|clean|cadr|fetch|checksum|patch|all):?$%) {	# command
		$cmd=$1;
		push @args, ":$cmd";
		print STDERR "command: $cmd\n";
	}

	elsif(m%^/.*/$%) {			# regexp
		push @args, $_;
		push @args_regexp, $_;
		print STDERR "regexp: $_\n";
	}

	elsif(m%^(?:$PORTSDIR/)?([a-z0-9_-]+/[a-z0-9_-]+)$%i) {	# origin
		push @args_origin, $1;
		print STDERR "origin: $_\n";
	}

	else {
		push @args, $_;
		print STDERR "arg: $_\n";
	}

}

for(@ARGV) {
	arg1($_);
}

if($opt_h || !@ARGV) {
	print "Usage: $0 [-options] [command] [pattern]... [port/origin]... [-options]
	-v	Increase verbosity
	-k	Search in all fields 		(make search key=)
	-i	Import INDEX / lookup ports	(make search name=)
	-p	Import installed packages data	$PKGDIR
	-d	Process dependency tree
	-(l|n)	List package name
	-o	List package origin
	-D	Print dependency info
	install	Install ports from specified origins (make all deinstall reinstall) in simple dumb way
	pattern	Can be written in simple or /regexp/i form

"; $opt_h=1;
}

exit $err if $err;
exit 0 if $opt_h;

$print_depends=$opt_D;

my $hasargs=$#ARGV>=0;

our $arg1=@args[0];

our $pat;
if($cmd eq '') {
	given($arg1) {
		when (/^$/) { $pat=qr/./s };
		when (/^\/([\^\$*0-9a-z_.@*\\+-]+)\/([i]*)$/i) { 
			$arg1=$1; $arg2=$2; $arg1=~s%\$%\\\$%g; $pat=eval "qr/$arg1/$2"; 
			print STDERR "$pat\n";
			}
		when (/^[\^0-9a-z_.@+ \t-]+$/i) { 
			$arg1=~s/\+/\\+/g; $pat=qr /$arg1/i; }
		default { print STDERR "Bad pattern: $arg1\n"; $pat=\0 };
	};
}
elsif($cmd=~/^c?adr$|^clean$|^install$|^reinstall$|^(all|patch|checksum|fetch)$/){
	cmd_makeadr($cmd);		# install by origins
};

$import_index=$opt_i || defined($pat) && !$opt_p;
if($import_index) {
	import_index();
}

if($opt_p) {
	import_pkg( $opt_d?'deps':'' );
	#import_pkg( 'deps' );
	print STDERR "=== Done with pkg info\n";


	#print STDERR "$arg1:  $pat\n";
	for my $pkg (sort keys %installed) {
		next if $pkg!~$pat;
		print "$pkg\n";
	}
}


sub cmd_makeadr{
	my $cmd_=shift;
	my $CMD='';
	my $warn=0;
	my $make='all deinstall reinstall';
	$make=$cmd_ if $cmd_ =~ '^(re)?install$|^(all|patch|checksum|fetch|clean)$';
	for my $origin (@args_origin) {
		if($origin=~m%^[0-9a-z_-]+/[0-9a-z_-]+$%i) {
			my $dir1="$PORTSDIR/$origin";
			if(!-e $dir1) {
				print STDERR "!!! WARNING: $dir1 does not exist\n";
				$warn++;
			} else {
				$cmd1= "cd $dir1 && make $make\n";
				$CMD.=$cmd1;
				print "$cmd1";
			}
		} 
		else {
			print STDERR "BAD origin: $origin\n";		
			$err=1;
		}
	}

	print(STDERR "Aborting\n"),exit $err  if $err;
	sleep 5 if $warn;
	system $CMD;
}

sub import_pkg(;$){
	my $what=shift;
	print STDERR "Import pkg($what) from: $PKGDIR\n";
	my $pkg;

	if(!defined $pkg_list_done) {
		opendir DIR,$PKGDIR or die "Couldn't open $PKGDIR";
		our @dirs=readdir DIR;
		closedir DIR;

		@dirs=grep !/^\.|\.(bak|orig|tmp)$/i,@dirs;
		@dirs=grep -d "$PKGDIR/$_",@dirs;
		#@dirs=sort @dirs;

		$pkg_list_done=1;

		foreach my $pkg (@dirs) {
			$installed{$pkg}=1;
			$required{$pkg}[0]=0;
			$requires{$pkg}[0]=0;
			$origin{$pkg}=undef;
		};
	}

#
# Read from every package the +REQUIRED_BY file. This file contains
# info about the packages which require this package.
#
	if($what=~/dep/ && !defined $pkg_deps_done) {
		print STDERR "Read depends... ";

		foreach $pkg (@dirs) {
		    if (open FILE,  $PKGDIR."/".$pkg."/+REQUIRED_BY") {
			my @reqby;
			my $line;
			my $count=0;

			@reqby=<FILE>;
			close FILE;

			chomp @reqby;
			foreach $line (@reqby) {
			    $required{$pkg}[++$count]=$line;
			}
			$required{$pkg}[0]=$count;
			print $where "/// $pkg req by $count\n"	if $D>7;
		    }
		}

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

			@lines=<FILE>;
			close FILE;

			chomp @lines;

			my $pkg_origin=undef;
			my $pkg_name=undef;
			for (@lines) {	# +CONTENTS
				if( /^\@pkgdep/ ) {
				    @w=split(" ",$_);
				    $requires{$pkg}[++$count]=$w[1];
				}
				elsif( /^\@name +(.+)$/ ) {
					$pkg_name=$1;
					if($pkg ne $pkg_name) {
						print $where "!!! $pkg: name $pkg_name does not match!\n";
						$err++;
					}
				}
				elsif( /^\@comment ORIGIN: *(.+)$/ ) {
					$pkg_origin=$1;
					$origin{$pkg}=$pkg_origin;
					if(defined $atorigin{$pkg_origin}) {
						$atorigin{$pkg_origin}.="|$pkg";
					} else {
						$atorigin{$pkg_origin}=$pkg;
					}

				}
			}
			$requires{$pkg}[0]=$count;
			print $where "/// $pkg need $count\n"	if $D>7;

		    }
		}
		$pkg_deps_done=1;
		print STDERR "\rRead depends... done\n";
	}

};

sub split_index($){	# line
	my @index_split=split /\|/o, ${shift()}, 11;
	our($name,$path,$prefix, $info,$descr_file, $main,$cat,$bdeps,$rdeps,$www) = @index_split;

#	PATH = /usr/ports/ORIGIN

	#$name\n$path\n$prefix\n$info\n$descr_file\n$main\n$cat\n$bdeps\n$rdeps\n$www
	#split/\|/, shift;
#	return @index_split;
}

sub print_port(;$){	# what: (a)ll (l)ist name (o)rigin,   $print_depends
	my $what=shift;
	if(!defined $what) {	# not specified - guess from opt
		$what='';
		$what.= 'l' if $opt_l;
		$what.= 'o' if $opt_o;
		#$what = 'a:' if $what;
	}
	
	if($what =~ /^$|a:/) {	# print all info, in make search format (excluding deps)
print "Port:\t$name
Path:\t$path
Info:\t$info
Maint:\t$main
".  
($print_depends? 
"B-deps:\t$bdeps
R-deps:\t$rdeps
":'').
"WWW:\t$www
\n";
	}

	else {		# print only selected
		if($what =~ /[nl]/) 	{ print "$name\n" };

		if($what =~ /[o]/) 	{ print path_origin($path),"\n" };

		if($print_depends) 	{ print "B-deps:\t$bdeps\nR-deps:\t$rdeps\n" };
	}
	
}


sub import_index($){
	our $INDEXFILE="$PORTSDIR/".`make -C $PORTSDIR -V INDEXFILE`;
	chomp $INDEXFILE;
	if( !open(I,"<",$INDEXFILE) ) {
		print "Open index file $PORTSDIR/$INDEXFILE failed: $!\n";
		return -1;
	};
	my $what= ($opt_k?'k':''). ($opt_n?'n':''). ($opt_d?'d':'');
	$what='n' if $what eq '';
	$what='dk' if $what eq 'd';
	my $N=0;
	my $sel=0;
	my $line;
#	print STDERR "$what $arg1:  $pat\n";
	for $line (<I>){
		$N++;
		if($line=~/$pat/o) {
		given($what){
			when(/k/) {
				split_index(\$line);
				if(/d/) {		# search in deps
					$sel++;
					print_port();
				} else {		# ignore match within deps
					my $s="$name\n$path\n$prefix\n$info\n$descr_file\n$main\n$cat\n\n\n$www";
					if($s=~/$pat/om) {
						$sel++;
						print_port();
					}
				}
			}			
			when(/n/) {
				split_index(\$line);
				$name=~/$pat/o && { $sel++,print_port() };
			}
		}
		}
	}
	print STDERR "=== Done with $INDEXFILE: $sel of $N entries\n";
	close I;
}



sub get_pkgname($){	#	get_pkgname(origin) from the ports tree
	my $origin=shift;
	my $pkgname=`cd /usr/ports/$origin && make -V PKGNAME`;
	chomp $pkgname;
	print STDERR "### $origin -> $pkgname\n";
	
	return $pkgname;
}


sub path_origin($){	# /usr/ports/x11/nvidia-driver-173 -> x11/nvidia-driver-173
	my $path=shift;
	$path=~s%^/usr/ports/%%;
	return $path;
}



if($opt_c) {	# check consistency

	for $pkg (keys %installed) {
		if( !defined $origin{$pkg} ) {
			print $where "!!! $pkg has no origin\n";
			$err++;
		}
	}


	for $pkg (keys %installed) {
		my $needcnt=$requires{$pkg}[0];
		for my $need (@{$requires{$pkg}}[1..$needcnt]) {
			if( !defined $installed{$need} ) {
				print $where "!!! $pkg needs missing package $need\n";
				$missing{$need}=1;
				$err++;
			}
		}
	}

	my @M=keys %missing;
	if(@M>0) {
		print $where "=== ",scalar @M," packages missing or updated:\n";
		for (@M) {
			print $where "$_\n";
		}
		print $where "\n";
	}

	my $n=0;
	for (keys %atorigin) {
		my $pkgs=$atorigin{$_};
		if($pkgs=~s/\|/ /g) {
			my $pkgname=get_pkgname($_);
			print $where "!!! Duplicated origin: ( $_ -> $pkgname )  $pkgs\n";
			$err++;
			$n=1;
		}
	}
	print $where "\n" if $n;

	print STDERR "=== Done with pkg checking\n";
};	# check




if($err) {
	print STDERR "!!! At least $err errors found!\n";
	sleep 5;
};


#
# 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.
#
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);
    }
	print "\n";
}

__END__

. [pdc@cel 18:26:32] /tmp 116> g -n . p? | less -S
 p1:1: Port:   libcompizconfig-0.8.4_6
 p1:2: Path:   /usr/ports/x11-wm/libcompizconfig
 p1:3: Info:   An alternative configuration system for Compiz
 p1:4: Maint:  ports@FreeBSD.org
 p1:5: B-deps: ORBit2-2.14.19 atk-2.0.1 avahi-app-0.6.29_3 bash-4.2.42 bitstream-vera-1.10_5 cairo-1.10.2_5,2 
 p1:6: R-deps: libiconv-1.14 libinotify-20110829 libxml2-2.7.8_5 pkgconf-0.8.9
 p1:7: WWW:    

 p2:1:libcompizconfig-0.8.4_6
 p2:2:/usr/ports/x11-wm/libcompizconfig
 p2:3:/usr/local
 p2:4:An alternative configuration system for Compiz
 p2:5:/usr/ports/x11-wm/libcompizconfig/pkg-descr
 p2:6:ports@FreeBSD.org
 p2:7:x11-wm
 p2:8:ORBit2-2.14.19 atk-2.0.1 avahi-app-0.6.29_3 bash-4.2.42 bitstream-vera-1.10_5 cairo-1.10.2_5,2 compiz-0.8.4_9 
 p2:9:libiconv-1.14 libinotify-20110829 libxml2-2.7.8_5 pkgconf-0.8.9

bsd.port.subdir.mk
            fields["name"]  = 1;  names[1]  = "Port"; \
            fields["path"]  = 2;  names[2]  = "Path"; \
            fields["info"]  = 4;  names[4]  = "Info"; \
            fields["maint"] = 6;  names[6]  = "Maint"; \
            fields["cat"]   = 7;  names[7]  = "Index"; \
            fields["bdeps"] = 8;  names[8]  = "B-deps"; \
            fields["rdeps"] = 9;  names[9]  = "R-deps"; \
            fields["www"]   = 10; names[10] = "WWW"; \

pkgmy install net-mgmt/scdp net-mgmt/cdpd net-mgmt/cdpr