Porting/Maintainers.pm

   1 #
   2 # Maintainers.pm - show information about maintainers
   3 #
   4
   5 package Maintainers;
   6
   7 use strict;
   8
   9 use lib "Porting";
  10
  11 require "Maintainers.pl";
  12 use vars qw(%Modules %Maintainers);
  13
  14 use vars qw(@ISA @EXPORT_OK);
  15 @ISA = qw(Exporter);
  16 @EXPORT_OK = qw(%Modules %Maintainers
  17                 get_module_files get_module_pat
  18                 show_results process_options);
  19 require Exporter;
  20
  21 use File::Find;
  22 use Getopt::Long;
  23
  24 my %MANIFEST;
  25 if (open(MANIFEST, "MANIFEST")) {
  26     while (<MANIFEST>) {
  27         if (/^(\S+)\t+(.+)$/) {
  28             $MANIFEST{$1}++;
  29         }
  30     }
  31     close MANIFEST;
  32 } else {
  33     die "$0: Failed to open MANIFEST for reading: $!\n";
  34 }
  35
  36 sub get_module_pat {
  37     my $m = shift;
  38     split ' ', $Modules{$m}{FILES};
  39 }
  40
  41 sub get_module_files {
  42     my $m = shift;
  43     sort { lc $a cmp lc $b }
  44     map {
  45         -f $_ ? # Files as-is.
  46             $_ :
  47             -d _ ? # Recurse into directories.
  48             do {
  49                 my @files;
  50                 find(
  51                      sub {
  52                          push @files, $File::Find::name
  53                              if -f $_ && exists $MANIFEST{$File::Find::name};
  54                      }, $_);
  55                 @files;
  56             }
  57         : glob($_) # The rest are globbable patterns.
  58         } get_module_pat($m);
  59 }
  60
  61 sub get_maintainer_modules {
  62     my $m = shift;
  63     sort { lc $a cmp lc $b }
  64     grep { $Modules{$_}{MAINTAINER} eq $m }
  65     keys %Modules;
  66 }
  67
  68 sub usage {
  69     print <<__EOF__;
  70 $0: Usage: $0 [[--maintainer M --module M --files --check]|file ...]
  71 --maintainer M  list all maintainers matching M
  72 --module M      list all modules matching M
  73 --files         list all files
  74 --check         check consistency of Maintainers.pl
  75 --opened        list all modules of files opened by perforce
  76 Matching is case-ignoring regexp, author matching is both by
  77 the short id and by the full name and email.  A "module" may
  78 not be just a module, it may be a file or files or a subdirectory.
  79 The options may be abbreviated to their unique prefixes
  80 __EOF__
  81     exit(0);
  82 }
  83
  84 my $Maintainer;
  85 my $Module;
  86 my $Files;
  87 my $Check;
  88 my $Opened;
  89
  90 sub process_options {
  91     usage()
  92         unless
  93             GetOptions(
  94                        'maintainer=s'   => \$Maintainer,
  95                        'module=s'       => \$Module,
  96                        'files'          => \$Files,
  97                        'check'          => \$Check,
  98                        'opened'         => \$Opened,
  99                       );
 100
 101     my @Files;
 102
 103     if ($Opened) {
 104         my @raw = `p4 opened`;
 105         die if $?;
 106         @Files =  map {s!#.*!!s; s!^//depot/.*?/perl/!!; $_} @raw;
 107     } else {
 108         @Files = @ARGV;
 109     }
 110
 111     usage() if @Files && ($Maintainer || $Module || $Files);
 112
 113     for my $mean ($Maintainer, $Module) {
 114         warn "$0: Did you mean '$0 $mean'?\n"
 115             if $mean && -e $mean && $mean ne '.' && !$Files;
 116     }
 117
 118     warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
 119         if defined $Maintainer && exists $Modules{$Maintainer};
 120
 121     warn "$0: Did you mean '$0 -ma $Module'?\n"
 122         if defined $Module     && exists $Maintainers{$Module};
 123
 124     return ($Maintainer, $Module, $Files, @Files);
 125 }
 126
 127 sub show_results {
 128     my ($Maintainer, $Module, $Files, @Files) = @_;
 129
 130     if ($Maintainer) {
 131         for my $m (sort keys %Maintainers) {
 132             if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
 133                 my @modules = get_maintainer_modules($m);
 134                 if ($Module) {
 135                     @modules = grep { /$Module/io } @modules;
 136                 }
 137                 if ($Files) {
 138                     my @files;
 139                     for my $module (@modules) {
 140                         push @files, get_module_files($module);
 141                     }
 142                     printf "%-15s @files\n", $m;
 143                 } else {
 144                     if ($Module) {
 145                         printf "%-15s @modules\n", $m;
 146                     } else {
 147                         printf "%-15s $Maintainers{$m}\n", $m;
 148                     }
 149                 }
 150             }
 151         }
 152     } elsif ($Module) {
 153         for my $m (sort { lc $a cmp lc $b } keys %Modules) {
 154             if ($m =~ /$Module/io) {
 155                 if ($Files) {
 156                     my @files = get_module_files($m);
 157                     printf "%-15s @files\n", $m;
 158                 } else {
 159                     printf "%-15s $Modules{$m}{MAINTAINER}\n", $m;
 160                 }
 161             }
 162         }
 163     } elsif (@Files) {
 164         my %ModuleByFile;
 165
 166         for (@Files) { s:^\./:: }
 167
 168         @ModuleByFile{@Files} = ();
 169
 170         # First try fast match.
 171
 172         my %ModuleByPat;
 173         for my $module (keys %Modules) {
 174             for my $pat (get_module_pat($module)) {
 175                 $ModuleByPat{$pat} = $module;
 176             }
 177         }
 178         # Expand any globs.
 179         my %ExpModuleByPat;
 180         for my $pat (keys %ModuleByPat) {
 181             if (-e $pat) {
 182                 $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
 183             } else {
 184                 for my $exp (glob($pat)) {
 185                     $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
 186                 }
 187             }
 188         }
 189         %ModuleByPat = %ExpModuleByPat;
 190         for my $file (@Files) {
 191             $ModuleByFile{$file} = $ModuleByPat{$file}
 192                 if exists $ModuleByPat{$file};
 193         }
 194
 195         # If still unresolved files...
 196         if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
 197
 198             # Cannot match what isn't there.
 199             @ToDo = grep { -e $_ } @ToDo;
 200
 201             if (@ToDo) {
 202                 # Try prefix matching.
 203
 204                 # Remove trailing slashes.
 205                 for (@ToDo) { s|/$|| }
 206
 207                 my %ToDo;
 208                 @ToDo{@ToDo} = ();
 209
 210                 for my $pat (keys %ModuleByPat) {
 211                     last unless keys %ToDo;
 212                     if (-d $pat) {
 213                         my @Done;
 214                         for my $file (keys %ToDo) {
 215                             if ($file =~ m|^$pat|i) {
 216                                 $ModuleByFile{$file} = $ModuleByPat{$pat};
 217                                 push @Done, $file;
 218                             }
 219                         }
 220                         delete @ToDo{@Done};
 221                     }
 222                 }
 223             }
 224         }
 225
 226         for my $file (@Files) {
 227             if (defined $ModuleByFile{$file}) {
 228                 my $module     = $ModuleByFile{$file};
 229                 my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
 230                 printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
 231             } else {
 232                 printf "%-15s ?\n", $file;
 233             }
 234         }
 235     }
 236     elsif ($Check) {
 237         duplicated_maintainers();
 238     }
 239     else {
 240         usage();
 241     }
 242 }
 243
 244 sub duplicated_maintainers {
 245     my %files;
 246     for my $k (keys %Modules) {
 247         for my $f (get_module_files($k)) {
 248             ++$files{$f};
 249         }
 250     }
 251     for my $f (keys %files) {
 252         if ($files{$f} > 1) {
 253             warn "File $f appears $files{$f} times in Maintainers.pl\n";
 254         }
 255     }
 256 }
 257
 258 1;
 259