[perl #57016] debugger: o warn=0 die=0 ignored

[p5sagit/p5-mst-13.2.git] / Porting / Maintainers.pm

diff --git a/Porting/Maintainers.pm b/Porting/Maintainers.pm
index 3cf4856..0a2f4c6 100644 (file)
--- a/Porting/Maintainers.pm
+++ b/Porting/Maintainers.pm
@@ -7,15 +7,19 @@ package Maintainers;
 use strict;
 
 use lib "Porting";
+# Please don't use post 5.008 features as this module is used by
+# Porting/makemeta, and that in turn has to be run by the perl just built.
+use 5.008;
 
 require "Maintainers.pl";
 use vars qw(%Modules %Maintainers);
 
-use vars qw(@ISA @EXPORT_OK);
+use vars qw(@ISA @EXPORT_OK $VERSION);
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(%Modules %Maintainers
                get_module_files get_module_pat
                show_results process_options);
+$VERSION = 0.02;
 require Exporter;
 
 use File::Find;
@@ -67,10 +71,15 @@ sub get_maintainer_modules {
 
 sub usage {
     print <<__EOF__;
-$0: Usage: $0 [[--maintainer M --module M --files]|file ...]
+$0: Usage: $0 [[--maintainer M --module M --files]|[--check] 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
+                       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 files opened by perforce
 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.
@@ -82,6 +91,8 @@ __EOF__
 my $Maintainer;
 my $Module;
 my $Files;
+my $Check;
+my $Opened;
 
 sub process_options {
     usage()
@@ -90,9 +101,22 @@ sub process_options {
                       'maintainer=s'   => \$Maintainer,
                       'module=s'       => \$Module,
                       'files'          => \$Files,
+                      'check'          => \$Check,
+                      'opened'         => \$Opened,
                      );
 
-    my @Files = @ARGV;
+    my @Files;
+   
+    if ($Opened) {
+       @Files = `p4 opened`;
+       die if $?;
+       foreach (@Files) {
+           s!#.*!!s;
+           s!^//depot/(?:perl|.*?/perl)/!!;
+       }
+    } else {
+       @Files = @ARGV;
+    }
 
     usage() if @Files && ($Maintainer || $Module || $Files);
 
@@ -146,6 +170,13 @@ sub show_results {
                }
            }
        }
+    } elsif ($Check) {
+        if( @Files ) {
+           missing_maintainers( qr{\.(?:[chty]|p[lm]|xs)\z}msx, @Files)
+       }
+       else { 
+           duplicated_maintainers();
+       }
     } elsif (@Files) {
        my %ModuleByFile;
 
@@ -224,5 +255,41 @@ sub show_results {
     }
 }
 
+my %files;
+
+sub maintainers_files {
+    %files = ();
+    for my $k (keys %Modules) {
+       for my $f (get_module_files($k)) {
+           ++$files{$f};
+       }
+    }
+}
+
+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";
+       }
+    }
+}
+
+sub warn_maintainer {
+    my $name = shift;
+    warn "File $name has no maintainer\n" if not $files{$name};
+}
+
+sub missing_maintainers {
+    my($check, @path) = @_;
+    maintainers_files();
+    my @dir;
+    for my $d (@path) {
+       if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
+    }
+    find sub { warn_maintainer($File::Find::name) if /$check/; }, @dir
+       if @dir;
+}
+
 1;