package Maintainers;
use strict;
+use warnings;
use lib "Porting";
# Please don't use post 5.008 features as this module is used by
use 5.008;
require "Maintainers.pl";
-use vars qw(%Modules %Maintainers);
+our (%Modules, %Maintainers);
-use vars qw(@ISA @EXPORT_OK $VERSION);
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(%Modules %Maintainers
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(%Modules %Maintainers
get_module_files get_module_pat
show_results process_options files_to_modules
+ finish_tap_output
reload_manifest);
-$VERSION = 0.03;
+our $VERSION = 0.14;
+
require Exporter;
use File::Find;
sub reload_manifest {
%MANIFEST = ();
- if (open(MANIFEST, "MANIFEST")) {
- while (<MANIFEST>) {
+
+ my $manifest_path = 'MANIFEST';
+ if (! -e $manifest_path) {
+ $manifest_path = "../MANIFEST";
+ }
+
+ if (open(my $manfh, '<', $manifest_path )) {
+ while (<$manfh>) {
if (/^(\S+)/) {
$MANIFEST{$1}++;
}
warn "MANIFEST:$.: malformed line: $_\n";
}
}
- close MANIFEST;
+ close $manfh;
} else {
- die "$0: Failed to open MANIFEST for reading: $!\n";
+ die "$0: Failed to open MANIFEST for reading: $!\n";
}
}
split ' ', $Modules{$m}{FILES};
}
+# expand dir/ or foo* into a full list of files
+#
+sub expand_glob {
+ sort { lc $a cmp lc $b }
+ map {
+ -f $_ && $_ !~ /[*?]/ ? # File as-is.
+ $_ :
+ -d _ && $_ !~ /[*?]/ ? # Recurse into directories.
+ do {
+ my @files;
+ find(
+ sub {
+ push @files, $File::Find::name
+ if -f $_ && exists $MANIFEST{$File::Find::name};
+ }, $_);
+ @files;
+ }
+ # Not a glob, but doesn't exist
+ : $_ !~ /[*?{]/ ? $_
+ # The rest are globbable patterns; expand the glob, then
+ # recursively perform directory expansion on any results
+ : expand_glob(glob($_))
+ } @_;
+}
+
+sub filter_excluded {
+ my ($m, @files) = @_;
+
+ my $excluded = $Modules{$m}{EXCLUDED};
+ return @files
+ unless $excluded and @$excluded;
+
+ my ($pat) = map { qr/$_/ } join '|' => map {
+ ref $_ ? $_ : qr/\b\Q$_\E$/
+ } @{ $excluded };
+
+ return grep { $_ !~ $pat } @files;
+}
+
sub get_module_files {
my $m = shift;
- sort { lc $a cmp lc $b }
- map {
- -f $_ ? # Files as-is.
- $_ :
- -d _ ? # Recurse into directories.
- do {
- my @files;
- find(
- sub {
- push @files, $File::Find::name
- if -f $_ && exists $MANIFEST{$File::Find::name};
- }, $_);
- @files;
- }
- : glob($_) # The rest are globbable patterns.
- } get_module_pat($m);
+ return filter_excluded $m => map { expand_glob($_) } get_module_pat($m);
}
+
sub get_maintainer_modules {
my $m = shift;
sort { lc $a cmp lc $b }
}
sub usage {
- print <<__EOF__;
-$0: Usage: $0 [[--maintainer M --module M --files]|[--check] [commit] | [file ...]
---maintainer M list all maintainers matching M
---module M list all modules matching M
---files list all files
---check check consistency of Maintainers.pl
+ warn <<__EOF__;
+$0: Usage:
+ --maintainer M | --module M [--files]
+ List modules or maintainers matching the pattern M.
+ With --files, list all the files associated with them
+or
+ --check | --checkmani [commit | file ... | dir ... ]
+ Check consistency of Maintainers.pl
with a file checks if it has a maintainer
with a dir checks all files have a maintainer
- otherwise checks for multiple maintainers
---checkmani like --check, but only reports on unclaimed files if they
- are in MANIFEST
---opened list all modules of modified files
+ with a commit checks files modified by that commit
+ no arg checks for multiple maintainers
+ --checkmani is like --check, but only reports on unclaimed
+ files if they are in MANIFEST
+or
+ --opened | file ....
+ List the module ownership of modified or the listed files
+
Matching is case-ignoring regexp, author matching is both by
the short id and by the full name and email. A "module" may
not be just a module, it may be a file or files or a subdirectory.
my $Check;
my $Checkmani;
my $Opened;
+my $TestCounter = 0;
sub process_options {
usage()
my @Files;
if ($Opened) {
+ usage if @ARGV;
chomp (@Files = `git ls-files -m --full-name`);
die if $?;
} elsif (@ARGV == 1 &&
if (@ToDo) {
# Try prefix matching.
+ # Need to try longest prefixes first, else lib/CPAN may match
+ # lib/CPANPLUS/... and similar
+
+ my @OrderedModuleByPat
+ = sort {length $b <=> length $a} keys %ModuleByPat;
+
# Remove trailing slashes.
for (@ToDo) { s|/$|| }
my %ToDo;
@ToDo{@ToDo} = ();
- for my $pat (keys %ModuleByPat) {
+ for my $pat (@OrderedModuleByPat) {
last unless keys %ToDo;
if (-d $pat) {
my @Done;
}
}
} elsif ($Check or $Checkmani) {
+ require Test::More;
+ Test::More->import;
if( @Files ) {
- missing_maintainers(
- $Checkmani
- ? sub { -f $_ and exists $MANIFEST{$File::Find::name} }
- : sub { /\.(?:[chty]|p[lm]|xs)\z/msx },
- @Files
- );
- }
- else {
- duplicated_maintainers();
- }
+ missing_maintainers(
+ $Checkmani
+ ? sub { -f $_ and exists $MANIFEST{$File::Find::name} }
+ : sub { /\.(?:[chty]|p[lm]|xs)\z/msx },
+ @Files
+ );
+ } else {
+ duplicated_maintainers();
+ superfluous_maintainers();
+ }
} elsif (@Files) {
my $ModuleByFile = files_to_modules(@Files);
for my $file (@Files) {
sub duplicated_maintainers {
maintainers_files();
- for my $f (keys %files) {
- if ($files{$f} > 1) {
- warn "File $f appears $files{$f} times in Maintainers.pl\n";
- }
+ for my $f (sort keys %files) {
+ cmp_ok($files{$f}, '<=', 1, "File $f appears $files{$f} times in Maintainers.pl");
}
}
sub warn_maintainer {
my $name = shift;
- warn "File $name has no maintainer\n" if not $files{$name};
+ ok($files{$name}, "$name has a maintainer (see Porting/Maintainers.pl)");
}
sub missing_maintainers {
maintainers_files();
my @dir;
for my $d (@path) {
- if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
+ if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
+ }
+ find sub { warn_maintainer($File::Find::name) if $check->() }, @dir if @dir;
+}
+
+sub superfluous_maintainers {
+ maintainers_files();
+ for my $f (sort keys %files) {
+ ok($MANIFEST{$f}, "File $f has a maintainer and is in MANIFEST");
}
- find sub { warn_maintainer($File::Find::name) if $check->() }, @dir
- if @dir;
+}
+
+sub finish_tap_output {
+ done_testing();
}
1;