1#
2# Maintainers.pm - show information about maintainers
3#
4
5package Maintainers;
6
7use strict;
8use warnings;
9
10use lib "Porting";
11# Please don't use post 5.008 features as this module is used by
12# Porting/makemeta, and that in turn has to be run by the perl just built.
13use 5.008;
14
15require "Maintainers.pl";
16use vars qw(%Modules %Maintainers);
17
18use vars qw(@ISA @EXPORT_OK $VERSION);
19@ISA = qw(Exporter);
20@EXPORT_OK = qw(%Modules %Maintainers
21		get_module_files get_module_pat
22		show_results process_options files_to_modules
23		finish_tap_output
24		reload_manifest);
25$VERSION = 0.10;
26
27require Exporter;
28
29use File::Find;
30use Getopt::Long;
31
32my %MANIFEST;
33
34# (re)read the MANIFEST file, blowing away any previous effort
35
36sub reload_manifest {
37    %MANIFEST = ();
38
39    my $manifest_path = 'MANIFEST';
40   if (! -e  $manifest_path) {
41        $manifest_path = "../MANIFEST";
42    }
43
44    if (open(my $manfh,  $manifest_path )) {
45	while (<$manfh>) {
46	    if (/^(\S+)/) {
47		$MANIFEST{$1}++;
48	    }
49	    else {
50		warn "MANIFEST:$.: malformed line: $_\n";
51	    }
52	}
53	close $manfh;
54    } else {
55	    die "$0: Failed to open MANIFEST for reading: $!\n";
56    }
57}
58
59reload_manifest;
60
61
62sub get_module_pat {
63    my $m = shift;
64    split ' ', $Modules{$m}{FILES};
65}
66
67# expand dir/ or foo* into a full list of files
68#
69sub expand_glob {
70    sort { lc $a cmp lc $b }
71	map {
72	    -f $_ && $_ !~ /[*?]/ ? # File as-is.
73		$_ :
74		-d _ && $_ !~ /[*?]/ ? # Recurse into directories.
75		do {
76		    my @files;
77		    find(
78			 sub {
79			     push @files, $File::Find::name
80				 if -f $_ && exists $MANIFEST{$File::Find::name};
81			 }, $_);
82		    @files;
83		}
84	    # Not a glob, but doesn't exist
85	    : $_ !~ /[*?{]/ ? $_
86	    # The rest are globbable patterns; expand the glob, then
87	    # recursively perform directory expansion on any results
88	    : expand_glob(glob($_))
89	    } @_;
90}
91
92sub filter_excluded {
93    my ($m, @files) = @_;
94
95    my $excluded = $Modules{$m}{EXCLUDED};
96    return @files
97	unless $excluded and @$excluded;
98
99    my ($pat) = map { qr/$_/ } join '|' => map {
100	ref $_ ? $_ : qr/\b\Q$_\E$/
101    } @{ $excluded };
102
103    return grep { $_ !~ $pat } @files;
104}
105
106sub get_module_files {
107    my $m = shift;
108    return filter_excluded $m => map { expand_glob($_) } get_module_pat($m);
109}
110
111
112sub get_maintainer_modules {
113    my $m = shift;
114    sort { lc $a cmp lc $b }
115    grep { $Modules{$_}{MAINTAINER} eq $m }
116    keys %Modules;
117}
118
119sub usage {
120    warn <<__EOF__;
121$0: Usage:
122    --maintainer M | --module M [--files]
123		List modules or maintainers matching the pattern M.
124		With --files, list all the files associated with them
125or
126    --check | --checkmani [commit | file ... | dir ... ]
127		Check consistency of Maintainers.pl
128			with a file	checks if it has a maintainer
129			with a dir	checks all files have a maintainer
130			with a commit   checks files modified by that commit
131			no arg		checks for multiple maintainers
132	       --checkmani is like --check, but only reports on unclaimed
133	       files if they are in MANIFEST
134or
135    --opened  | file ....
136		List the module ownership of modified or the listed files
137
138Matching is case-ignoring regexp, author matching is both by
139the short id and by the full name and email.  A "module" may
140not be just a module, it may be a file or files or a subdirectory.
141The options may be abbreviated to their unique prefixes
142__EOF__
143    exit(0);
144}
145
146my $Maintainer;
147my $Module;
148my $Files;
149my $Check;
150my $Checkmani;
151my $Opened;
152my $TestCounter = 0;
153
154sub process_options {
155    usage()
156	unless
157	    GetOptions(
158		       'maintainer=s'	=> \$Maintainer,
159		       'module=s'	=> \$Module,
160		       'files'		=> \$Files,
161		       'check'		=> \$Check,
162		       'checkmani'	=> \$Checkmani,
163		       'opened'		=> \$Opened,
164		      );
165
166    my @Files;
167
168    if ($Opened) {
169	usage if @ARGV;
170	chomp (@Files = `git ls-files -m --full-name`);
171	die if $?;
172    } elsif (@ARGV == 1 &&
173	     $ARGV[0] =~ /^(?:HEAD|[0-9a-f]{4,40})(?:~\d+)?\^*$/) {
174	my $command = "git diff --name-only $ARGV[0]^ $ARGV[0]";
175	chomp (@Files = `$command`);
176	die "'$command' failed: $?" if $?;
177    } else {
178	@Files = @ARGV;
179    }
180
181    usage() if @Files && ($Maintainer || $Module || $Files);
182
183    for my $mean ($Maintainer, $Module) {
184	warn "$0: Did you mean '$0 $mean'?\n"
185	    if $mean && -e $mean && $mean ne '.' && !$Files;
186    }
187
188    warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
189	if defined $Maintainer && exists $Modules{$Maintainer};
190
191    warn "$0: Did you mean '$0 -ma $Module'?\n"
192	if defined $Module     && exists $Maintainers{$Module};
193
194    return ($Maintainer, $Module, $Files, @Files);
195}
196
197sub files_to_modules {
198    my @Files = @_;
199    my %ModuleByFile;
200
201    for (@Files) { s:^\./:: }
202
203    @ModuleByFile{@Files} = ();
204
205    # First try fast match.
206
207    my %ModuleByPat;
208    for my $module (keys %Modules) {
209	for my $pat (get_module_pat($module)) {
210	    $ModuleByPat{$pat} = $module;
211	}
212    }
213    # Expand any globs.
214    my %ExpModuleByPat;
215    for my $pat (keys %ModuleByPat) {
216	if (-e $pat) {
217	    $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
218	} else {
219	    for my $exp (glob($pat)) {
220		$ExpModuleByPat{$exp} = $ModuleByPat{$pat};
221	    }
222	}
223    }
224    %ModuleByPat = %ExpModuleByPat;
225    for my $file (@Files) {
226	$ModuleByFile{$file} = $ModuleByPat{$file}
227	    if exists $ModuleByPat{$file};
228    }
229
230    # If still unresolved files...
231    if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
232
233	# Cannot match what isn't there.
234	@ToDo = grep { -e $_ } @ToDo;
235
236	if (@ToDo) {
237	    # Try prefix matching.
238
239	    # Need to try longest prefixes first, else lib/CPAN may match
240	    # lib/CPANPLUS/... and similar
241
242	    my @OrderedModuleByPat
243		= sort {length $b <=> length $a} keys %ModuleByPat;
244
245	    # Remove trailing slashes.
246	    for (@ToDo) { s|/$|| }
247
248	    my %ToDo;
249	    @ToDo{@ToDo} = ();
250
251	    for my $pat (@OrderedModuleByPat) {
252		last unless keys %ToDo;
253		if (-d $pat) {
254		    my @Done;
255		    for my $file (keys %ToDo) {
256			if ($file =~ m|^$pat|i) {
257			    $ModuleByFile{$file} = $ModuleByPat{$pat};
258			    push @Done, $file;
259			}
260		    }
261		    delete @ToDo{@Done};
262		}
263	    }
264	}
265    }
266    \%ModuleByFile;
267}
268sub show_results {
269    my ($Maintainer, $Module, $Files, @Files) = @_;
270
271    if ($Maintainer) {
272	for my $m (sort keys %Maintainers) {
273	    if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
274		my @modules = get_maintainer_modules($m);
275		if ($Module) {
276		    @modules = grep { /$Module/io } @modules;
277		}
278		if ($Files) {
279		    my @files;
280		    for my $module (@modules) {
281			push @files, get_module_files($module);
282		    }
283		    printf "%-15s @files\n", $m;
284		} else {
285		    if ($Module) {
286			printf "%-15s @modules\n", $m;
287		    } else {
288			printf "%-15s $Maintainers{$m}\n", $m;
289		    }
290		}
291	    }
292	}
293    } elsif ($Module) {
294	for my $m (sort { lc $a cmp lc $b } keys %Modules) {
295	    if ($m =~ /$Module/io) {
296		if ($Files) {
297		    my @files = get_module_files($m);
298		    printf "%-15s @files\n", $m;
299		} else {
300		    printf "%-15s %-12s %s\n", $m, $Modules{$m}{MAINTAINER}, $Modules{$m}{UPSTREAM}||'unknown';
301		}
302	    }
303	}
304    } elsif ($Check or $Checkmani) {
305        require Test::More;
306        Test::More->import;
307        if( @Files ) {
308		    missing_maintainers(
309			$Checkmani
310			    ? sub { -f $_ and exists $MANIFEST{$File::Find::name} }
311			    : sub { /\.(?:[chty]|p[lm]|xs)\z/msx },
312			@Files
313		    );
314		} else {
315		    duplicated_maintainers();
316		    superfluous_maintainers();
317		}
318    } elsif (@Files) {
319	my $ModuleByFile = files_to_modules(@Files);
320	for my $file (@Files) {
321	    if (defined $ModuleByFile->{$file}) {
322		my $module     = $ModuleByFile->{$file};
323		my $maintainer = $Modules{$ModuleByFile->{$file}}{MAINTAINER};
324		my $upstream   = $Modules{$module}{UPSTREAM}||'unknown';
325		printf "%-15s [%-7s] $module $maintainer $Maintainers{$maintainer}\n", $file, $upstream;
326	    } else {
327		printf "%-15s ?\n", $file;
328	    }
329	}
330    }
331    elsif ($Opened) {
332	print STDERR "(No files are modified)\n";
333    }
334    else {
335	usage();
336    }
337}
338
339my %files;
340
341sub maintainers_files {
342    %files = ();
343    for my $k (keys %Modules) {
344	for my $f (get_module_files($k)) {
345	    ++$files{$f};
346	}
347    }
348}
349
350sub duplicated_maintainers {
351    maintainers_files();
352    for my $f (sort keys %files) {
353        cmp_ok($files{$f}, '<=', 1, "File $f appears $files{$f} times in Maintainers.pl");
354    }
355}
356
357sub warn_maintainer {
358    my $name = shift;
359    ok($files{$name}, "$name has a maintainer");
360}
361
362sub missing_maintainers {
363    my($check, @path) = @_;
364    maintainers_files();
365    my @dir;
366    for my $d (@path) {
367	    if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
368    }
369    find sub { warn_maintainer($File::Find::name) if $check->() }, @dir if @dir;
370}
371
372sub superfluous_maintainers {
373    maintainers_files();
374    for my $f (sort keys %files) {
375        ok($MANIFEST{$f}, "File $f has a maintainer and is in MANIFEST");
376    }
377}
378
379sub finish_tap_output {
380    done_testing();
381}
382
3831;
384
385