summaryrefslogtreecommitdiff
path: root/pkgtools/revbump/files/replace-commonbump
blob: 46da917ab314798631afae140e8b416de6621a6b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
#!@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 make show-var
sub show_var($$){
    my($varname) = shift;
    my($pkgdir)  = shift;
    my($value);
    #chdir $pkgdir;
    open(MAKE, '-|', "cd $PKGSRCDIR/$pkgdir ; 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 emtpy 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__