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

#
# Maintainers.pm - show information about maintainers
#

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 $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;
use Getopt::Long;

my %MANIFEST;
if (open(MANIFEST, "MANIFEST")) {
    while (<MANIFEST>) {
	if (/^(\S+)\t+(.+)$/) {
	    $MANIFEST{$1}++;
	}
    }
    close MANIFEST;
} else {
    die "$0: Failed to open MANIFEST for reading: $!\n";
}

sub get_module_pat {
    my $m = shift;
    split ' ', $Modules{$m}{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);
}

sub get_maintainer_modules {
    my $m = shift;
    sort { lc $a cmp lc $b }
    grep { $Modules{$_}{MAINTAINER} eq $m }
    keys %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
			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
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.
The options may be abbreviated to their unique prefixes
__EOF__
    exit(0);
}

my $Maintainer;
my $Module;
my $Files;
my $Check;
my $Opened;

sub process_options {
    usage()
	unless
	    GetOptions(
		       'maintainer=s'	=> \$Maintainer,
		       'module=s'	=> \$Module,
		       'files'		=> \$Files,
		       'check'		=> \$Check,
		       'opened'		=> \$Opened,
		      );

    my @Files;

    if ($Opened) {
	chomp (@Files = `git ls-files -m --full-name`);
	die if $?;
    } elsif (@ARGV == 1 &&
	     $ARGV[0] =~ /^(?:HEAD|[0-9a-f]{4,40})(?:~\d+)?\^*$/) {
	my $command = "git diff --name-only $ARGV[0]^ $ARGV[0]";
	chomp (@Files = `$command`);
	die "'$command' failed: $?" if $?;
    } else {
	@Files = @ARGV;
    }

    usage() if @Files && ($Maintainer || $Module || $Files);

    for my $mean ($Maintainer, $Module) {
	warn "$0: Did you mean '$0 $mean'?\n"
	    if $mean && -e $mean && $mean ne '.' && !$Files;
    }

    warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
	if defined $Maintainer && exists $Modules{$Maintainer};

    warn "$0: Did you mean '$0 -ma $Module'?\n"
	if defined $Module     && exists $Maintainers{$Module};

    return ($Maintainer, $Module, $Files, @Files);
}

sub show_results {
    my ($Maintainer, $Module, $Files, @Files) = @_;

    if ($Maintainer) {
	for my $m (sort keys %Maintainers) {
	    if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
		my @modules = get_maintainer_modules($m);
		if ($Module) {
		    @modules = grep { /$Module/io } @modules;
		}
		if ($Files) {
		    my @files;
		    for my $module (@modules) {
			push @files, get_module_files($module);
		    }
		    printf "%-15s @files\n", $m;
		} else {
		    if ($Module) {
			printf "%-15s @modules\n", $m;
		    } else {
			printf "%-15s $Maintainers{$m}\n", $m;
		    }
		}
	    }
	}
    } elsif ($Module) {
	for my $m (sort { lc $a cmp lc $b } keys %Modules) {
	    if ($m =~ /$Module/io) {
		if ($Files) {
		    my @files = get_module_files($m);
		    printf "%-15s @files\n", $m;
		} else {
		    printf "%-15s %-12s %s\n", $m, $Modules{$m}{MAINTAINER}, $Modules{$m}{UPSTREAM}||'unknown';
		}
	    }
	}
    } elsif ($Check) {
        if( @Files ) {
	    missing_maintainers( qr{\.(?:[chty]|p[lm]|xs)\z}msx, @Files)
	}
	else { 
	    duplicated_maintainers();
	}
    } elsif (@Files) {
	my %ModuleByFile;

	for (@Files) { s:^\./:: }

	@ModuleByFile{@Files} = ();

	# First try fast match.

	my %ModuleByPat;
	for my $module (keys %Modules) {
	    for my $pat (get_module_pat($module)) {
		$ModuleByPat{$pat} = $module;
	    }
	}
	# Expand any globs.
	my %ExpModuleByPat;
	for my $pat (keys %ModuleByPat) {
	    if (-e $pat) {
		$ExpModuleByPat{$pat} = $ModuleByPat{$pat};
	    } else {
		for my $exp (glob($pat)) {
		    $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
		}
	    }
	}
	%ModuleByPat = %ExpModuleByPat;
	for my $file (@Files) {
	    $ModuleByFile{$file} = $ModuleByPat{$file}
	        if exists $ModuleByPat{$file};
	}

	# If still unresolved files...
	if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {

	    # Cannot match what isn't there.
	    @ToDo = grep { -e $_ } @ToDo;

	    if (@ToDo) {
		# Try prefix matching.

		# Remove trailing slashes.
		for (@ToDo) { s|/$|| }

		my %ToDo;
		@ToDo{@ToDo} = ();

		for my $pat (keys %ModuleByPat) {
		    last unless keys %ToDo;
		    if (-d $pat) {
			my @Done;
			for my $file (keys %ToDo) {
			    if ($file =~ m|^$pat|i) {
				$ModuleByFile{$file} = $ModuleByPat{$pat};
				push @Done, $file;
			    }
			}
			delete @ToDo{@Done};
		    }
		}
	    }
	}

	for my $file (@Files) {
	    if (defined $ModuleByFile{$file}) {
		my $module     = $ModuleByFile{$file};
		my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
		my $upstream   = $Modules{$module}{UPSTREAM}||'unknown';
		printf "%-15s [%-7s] $module $maintainer $Maintainers{$maintainer}\n", $file, $upstream;
	    } else {
		printf "%-15s ?\n", $file;
	    }
	}
    }
    elsif ($Opened) {
	print STDERR "(No files are modified)\n";
    }
    else {
	usage();
    }
}

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