X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Porting%2FMaintainers.pm;h=187e38b68e513b0d6e8ec5414be0226ce6288c65;hb=55c474ba7687e845183c20351357b0cf4f16fdef;hp=7929352e68dad09b103d971666b9bd2f08f00d3d;hpb=da92fd6071387be2a444dac8cdba07b4488e05e0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/Porting/Maintainers.pm b/Porting/Maintainers.pm index 7929352..187e38b 100644 --- a/Porting/Maintainers.pm +++ b/Porting/Maintainers.pm @@ -5,6 +5,7 @@ package Maintainers; use strict; +use warnings; use lib "Porting"; # Please don't use post 5.008 features as this module is used by @@ -19,8 +20,10 @@ use vars qw(@ISA @EXPORT_OK $VERSION); @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; +$VERSION = 0.04; + require Exporter; use File::Find; @@ -32,8 +35,14 @@ my %MANIFEST; sub reload_manifest { %MANIFEST = (); - if (open(MANIFEST, "MANIFEST")) { - while () { + + my $manifest_path = 'MANIFEST'; + if (! -e $manifest_path) { + $manifest_path = "../MANIFEST"; + } + + if (open(my $manfh, $manifest_path )) { + while (<$manfh>) { if (/^(\S+)/) { $MANIFEST{$1}++; } @@ -41,9 +50,9 @@ sub reload_manifest { 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"; } } @@ -55,26 +64,45 @@ sub get_module_pat { split ' ', $Modules{$m}{FILES}; } +# exand 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; + } + # The rest are globbable patterns; expand the glob, then + # recurively perform directory expansion on any results + : expand_glob(grep -e $_,glob($_)) + } @_; +} + 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); + my %exclude; + my @files; + for (get_module_pat($m)) { + if (s/^!//) { + $exclude{$_}=1 for expand_glob($_); + } + else { + push @files, expand_glob($_); + } + } + return grep !$exclude{$_}, @files; } + sub get_maintainer_modules { my $m = shift; sort { lc $a cmp lc $b } @@ -83,16 +111,28 @@ sub get_maintainer_modules { } 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 ---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 + + --tap-output + Show results as valid TAP output. Currently only compatible + with --check, --checkmani + 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. @@ -105,7 +145,10 @@ my $Maintainer; my $Module; my $Files; my $Check; +my $Checkmani; my $Opened; +my $TestCounter = 0; +my $TapOutput; sub process_options { usage() @@ -115,12 +158,15 @@ sub process_options { 'module=s' => \$Module, 'files' => \$Files, 'check' => \$Check, + 'checkmani' => \$Checkmani, 'opened' => \$Opened, + 'tap-output' => \$TapOutput, ); my @Files; if ($Opened) { + usage if @ARGV; chomp (@Files = `git ls-files -m --full-name`); die if $?; } elsif (@ARGV == 1 && @@ -190,13 +236,19 @@ sub files_to_modules { if (@ToDo) { # Try prefix matching. + # Need to try longst 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; @@ -249,13 +301,17 @@ sub show_results { } } } - } elsif ($Check) { + } elsif ($Check or $Checkmani) { if( @Files ) { - missing_maintainers( qr{\.(?:[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(); + } } elsif (@Files) { my $ModuleByFile = files_to_modules(@Files); for my $file (@Files) { @@ -291,15 +347,33 @@ sub maintainers_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"; - } + if ($TapOutput) { + if ($files{$f} > 1) { + print "not ok ".++$TestCounter." - File $f appears $files{$f} times in Maintainers.pl\n"; + } else { + print "ok ".++$TestCounter." - File $f appears $files{$f} times in Maintainers.pl\n"; + } + } else { + if ($files{$f} > 1) { + warn "File $f appears $files{$f} times in Maintainers.pl\n"; + } + } } } sub warn_maintainer { my $name = shift; - warn "File $name has no maintainer\n" if not $files{$name}; + if ($TapOutput) { + if ($files{$name}) { + print "ok ".++$TestCounter." - $name has a maintainer\n"; + } else { + print "not ok ".++$TestCounter." - $name has NO maintainer\n"; + + } + + } else { + warn "File $name has no maintainer\n" if not $files{$name}; + } } sub missing_maintainers { @@ -307,10 +381,13 @@ 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; + find sub { warn_maintainer($File::Find::name) if $check->() }, @dir if @dir; +} + +sub finish_tap_output { + print "1..".$TestCounter."\n"; } 1;