Reintroduce Porting/Modules. No, it's not duplicating

the information in Module::CoreList.

p4raw-id: //depot/perl@20285

1 files changed, 195 insertions, 0 deletions

diff --git a/Porting/Modules b/Porting/Modules
new file mode 100644
index 0000000000..9de5385232
--- /dev/null
+++ b/Porting/Modules
@@ -0,0 +1,195 @@
+#!/usr/bin/perl -w
+
+#
+# Modules - show information about modules and their maintainers
+#
+
+use strict;
+
+use FindBin qw($Bin);
+require "$Bin/Modules.pl";
+use vars qw(%Modules %Maintainers);
+
+use Getopt::Long;
+use File::Find;
+
+sub usage {
+    print <<__EOF__;
+$0: Usage: $0 [[--maintainer M --module M --files]|file ...]
+$0 --maintainer M	list all maintainers matching M
+$0 --module M		list all modules matching M
+$0 --files		list all files of the module
+Matching is case-ignoring regexp, author matching is both by
+the short id and by the full name and email.
+$0 file ...		list the module and maintainer
+__EOF__
+    exit(0);
+}
+
+my $Maintainer;
+my $Module;
+my $Files;
+
+usage()
+    unless
+    GetOptions(
+	       'maintainer=s'	=> \$Maintainer,
+	       'module=s'	=> \$Module,
+	       'files'		=> \$Files,
+	       );
+
+my @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 '.';
+}
+
+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};
+
+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 $_;
+		     }, $_);
+		@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;
+}
+
+if ($Maintainer) {
+    for my $m (sort keys %Maintainers) {
+	if ($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 $Modules{$m}{MAINTAINER}\n", $m;
+	    }
+	}
+    }
+} elsif (@Files) {
+    my %ModuleByFile;
+
+    @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};
+	    printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
+	} else {
+	    printf "%-15s ?\n", $file;
+	}
+    }
+}
+else {
+    usage();
+}
+