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