#!/usr/pkg/bin/perl -w
# -*- perl -*-
# The process has two steps
# (1)
# Travers all the files (with some filtering) over /usr/pkgsrc
# pick up referenced -> referer relation and store them to %HASH 
#  (multiple files are concatinated by ';' )
# (2)
# read input (usually named 'commonbump'), and expand one line into
# replacement referer lines, which are referenced  -> referer relation.

use strict;
use Getopt::Std;
use File::Find;

my(%HASH);	  		# referenced -> referer relation hash, referer is delimitted by ;
my($PKGSRCDIR);			# /usr/pkgsrc path, usually /usr/pkgsrc

my($TABLE) = 'commonbump';	# name of file, list-of-files to process
my(@TABLE);			# contents of file above

my($debug) = 0;
my($prefix) ;			# A part of path, top to pkgsrc, typically /usr/pkgsrc

my($common_bump) = 0;		# count, not used for now (yet)
my(%opts);
our(@ARGV);

my ($FILE)	= __FILE__;
    $FILE	=~ s,.*/([^/]+),$1,;	# pick leafname from __FILE__

my($replaced) = 'commonbump.replaced';

my($my_name) = $0;
$my_name =~ s#(.*)/##;

sub usage() {
    print <<HELP;
$my_name:
  This command is a part of revbump package and intended for pkgsrc developers.
  (1) Read entire pkgsrc tree and check referer -> referenced relation,
      then internally keeps (opposite) referenced -> referer relation table.
  (2) Read another file, named '$TABLE' or other name with -T, which
      usually lists Makefile.common or *common.mk files to expand.
  (3) Now expands those list in '$TABLE' into list of Makefiles by
      referenced -> refer relation. By default, it outputs to the file
      '$replaced' (currently the name is fixed).

Synopsys:
    $my_name [-a ] [-h] [-p pkgsrc_directory] [-T list_file] 
Where:
   -a	Check all, disregard to -T option. If "# used by" is 
    	included or not.
   -h	Show this help
   -p directory	
        pkgsrc directory to process (default $PKGSRCDIR)
   -T	the filename containing list of files (default commonbump)
See Also:
    revbump(1) for how to use it.
HELP
}

#  get value of variable by using /usr/bin/make show-var
sub show_var($$){
    my($varname) = shift;
    my($pkgdir)  = shift;
    my($value);
    #chdir $pkgdir;
    open(MAKE, '-|', "cd $PKGSRCDIR/$pkgdir ; /usr/bin/make show-var VARNAME=$varname");
    $value = <MAKE>;
    close(MAKE);
    chomp($value);
    if ($value =~ /know how to make/ ) { print STDERR $value, '(', $pkgdir,')',"\n";}
    return $value
}

sub GenerateHash ($$) {
    my ($pkgsrc) = shift;
    my ($prefix) = shift;

    # ----------------------------------------------------------------
    my ($wanted_closure) = sub () {
	my $dir   = $File::Find::dir ;
	my $fname = "$File::Find::dir/$_" ;

	# skip these directories and files ( as files including something )
	if ($dir =~ m|CVS$| )		{$File::Find::prune = 1; return;}
	if ($dir =~ m|mk$| )		{$File::Find::prune = 1; return;}
	if ($dir =~ m|work$| )		{$File::Find::prune = 1; return;}
	if ($dir =~ m|patches$| )	{$File::Find::prune = 1; return;}
	if ($dir =~ m|files$| )		{$File::Find::prune = 1; return;}
	if ($dir =~ m|bootstrap$| )	{$File::Find::prune = 1; return;}
	if ($dir =~ m|pkgsrc/[^/]$| )	{$File::Find::prune = 1; return;}
	if ($dir =~ m|x11-links| )	{$File::Find::prune = 1; return;}
	if ($_ =~ m|^\.\#| )		{                        return;}
	if ($_ =~ m|~$| )		{                        return;}
	if ($_ =~ m|buildlink3.mk$| )	{                        return;}
	if ($_ =~ m|builtin.mk$| )	{                        return;}

	my($shortname) = $fname;
	$shortname =~ s|$prefix/||;
	my($shortdir)  = $dir;
	$shortdir  =~ s|$prefix/||;

	# pick only Makefile.* and .mk  ( as files including something )
	if ($_ =~ m|Makefile| ||
	    $_ =~ m|\.mk$|          )	{
	    print STDERR __LINE__, ' ', $fname,' ', `pwd`, "\n" if $debug;
	    open(FNAME, $fname) || print STDERR __LINE__, " Problem opening file $fname:$!\n";
	    my ($included) = '';
	    while (<FNAME>){
		# now starts finding included file
		# pick .include "../../
		if ( m|^\.\s*include\s+\"\.\./\.\./(.*)\"| ) { $included = $1;}
		# pick ".include "Makefile" etc (without leading ../../), this needs to add package dir.
		if ( m|^\.\s*include\s+\"(.*)\"| )	{ next;}	# including the same directory stuff, doesn't matter
		if ( m|^\.\s*include\s+\"(.*)\"| )	{ $included = $prefix .'/'. $1;}		
		if ( $included =~ m|/mk/| )		{ next;}	# it is include line but for mk, skip this line
		if ( $included =~ m|version.mk| )	{ next;}
		if ( $included =~ m|tests/| )		{ next;}
		if ( $included =~ m|options.mk| )	{ next;}
		if ( $included =~ m|enigmail.mk| )	{ next;}

		$included =~ s,\$\{.CURDIR},$shortname,;
		if ($included =~ /\$\{([^}]+)}/ ) { 
		    my($varname) = $1;
		    my($value) = show_var($varname, $shortdir);
		    $included =~ s/\$\{[^}]+}/$value/;
		    if ($value eq '') {
			print STDERR 
$FILE, ': ', __LINE__, ' Value ${', $varname, '} is empty at ', $shortdir, "\n";
		    }
		}
		print STDERR __LINE__ , ' ', $shortname, ' -> ', $included,': ',$_ ,"\n" if $debug;
		if ( $included eq '') 	   		{ next;}	# not include line, look at next line
		print STDERR __LINE__ , ' ', $shortname, ' -> ', $included,"\n" if $debug;
		if ( ! $HASH{$included} ) {
		    $HASH{$included} =  $shortname;
		} else {
		    my(@registered) = split ';',  $HASH{$included};
		    if (grep (/^$shortname$/, @registered) == 0 ) {
			$HASH{$included} .= ';'. $shortname;
			}
		}
	    } # end while
	    close(FNAME);
	} # if of (major process) ... starting with: if ($_ =~ m|Makefile| || 
    };  # end of my ($wanted_closure) = sub () {
    # ----------------------------------------------------------------    
    find($wanted_closure, $pkgsrc);
}

# Table is assumed to contain list of files to process, set up it in @TABLE here.
sub ReadTable($) {
    my ($table) = shift;
    if ($table eq '-') {
	@TABLE = <>;
    } else {
	open(TABLE, $table) || print STDERR "Problem reading file $table: $!\n";
	@TABLE = <TABLE>;
	close(TABLE);
	}
    }

sub ShowResults() {
    open(REPLACED, "> $replaced") || die "problem open to write: $replaced: $!\n";
    foreach my $file (@TABLE) {
	chomp($file);
	if ($file =~ /^\s*$/  ) { next; }	# Skip empty line, in case
	if ($HASH{$file} && 			# To avoid 'Use of uninitialized value in split at ..'
	    grep ($file, $HASH{$file}) > 0) {	# referer found ( separated with ';')
	    my(@list) = split ';', $HASH{$file};
	    foreach my $i (0..$#list) {	    
		print REPLACED "$list[$i]\n";	# write the list into REPLACED handle
	    }
	}
    }
}

# check the pkgsrc tree is healthy or not
sub CheckPkgsrcTree($){
    my ($pkgsrc) =	shift;
    
    if (! -d $pkgsrc || ! -d "$pkgsrc/doc" || ! -d "$pkgsrc/mk") {
	print STDERR "Invalid pkgsrc directory $pkgsrc\n";
	exit 1;
    }
}

# if -a option is applied, not using @TABLE, but scan whole thing.
sub CheckAll() {
    foreach my $i (sort keys %HASH) {	# for all the referenced
	if ($i =~ /buildlink3.mk/ ) { next;}

	# First collect the line of '# used by .*'
	open (REFERENCED, $i) || print '  *** ', __LINE__, " Unable to open $i $!\n";
	my (@referer) = {};
	while(<REFERENCED>){
	    if (/\# used by (.*)/) { push (@referer, $1);}
	}
	close(REFERENCED);
	my $number = 0;
	foreach my $referer (@referer) {
	    $number += grep $referer, $HASH{$i};
	}
	$#referer++; 	# conpensate -1 -> 0, 0 -> 1 etc
    	if ($#referer <  $number) { print $#referer . ' ? ' . $number .' .. ', $i,' <- ', $HASH{$i}, ' ... <', "\n";}
    	if ($#referer >  $number) { print $#referer . ' ? ' . $number .' .. ', $i,' <- ', $HASH{$i}, ' ... >', "\n";}	
    }
}
sub main() {
    my($check_all) = 0;
    my($prefix);

    $PKGSRCDIR = $ENV{PKGSRCDIR};
    if (! $PKGSRCDIR) {
        $PKGSRCDIR = "/usr/pkgsrc";
    }

    getopts('ahp:T:', \%opts);

    if ($opts{'a'}) { $check_all = 1;  }
    if ($opts{'h'}) { usage(); exit 0;}
    if ($opts{'p'}) { $PKGSRCDIR = $opts{'p'};}
    if ($opts{'T'}) { $TABLE = $opts{'T'};}

    $prefix = $PKGSRCDIR;
    $prefix =~ s|.*/pkgsrc/(.*)|$1|;
    CheckPkgsrcTree($PKGSRCDIR);
    GenerateHash($PKGSRCDIR, $prefix);
    ReadTable($TABLE);
    if ($check_all) { CheckAll(); }
    else            { ShowResults();}
}

main();

exit;
__END__
