Add META.yml and Stas' makemeta (plus extensive reworking

of the Maintainers utility)

p4raw-id: //depot/perl@20491

4 files changed, 269 insertions, 187 deletions

diff --git a/Porting/Maintainers b/Porting/Maintainers
index 9c878031af..20a14df989 100644
--- a/Porting/Maintainers
+++ b/Porting/Maintainers
@@ -5,194 +5,10 @@
 #
 
 use strict;
+use lib "Porting";
 
-use FindBin qw($Bin);
-require "$Bin/Maintainers.pl";
-use vars qw(%Modules %Maintainers);
+use Maintainers qw(show_results process_options);
 
-use Getopt::Long;
-use File::Find;
+show_results(process_options());
 
-sub usage {
-    print <<__EOF__;
-$0: Usage: $0 [[--maintainer M --module M --files]|file ...]
---maintainer M	list all maintainers matching M
---module M	list all modules matching M
---files		list all 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;
-
-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 '.' && !$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};
-
-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 || $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 $Modules{$m}{MAINTAINER}\n", $m;
-	    }
-	}
-    }
-} 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};
-	    printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
-	} else {
-	    printf "%-15s ?\n", $file;
-	}
-    }
-}
-else {
-    usage();
-}
 
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 3d04db7c45..27c07cf1d0 100644
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -6,6 +6,8 @@
 # and in CPAN.  Those that have a CPAN existence, have the CPAN
 # attribute set to true.
 
+package Maintainers;
+
 %Maintainers =
 	(
 	'abergman'	=> 'Arthur Bergman <abergman@cpan.org>',
diff --git a/Porting/Maintainers.pm b/Porting/Maintainers.pm
new file mode 100644
index 0000000000..3cf48560c6
--- /dev/null
+++ b/Porting/Maintainers.pm
@@ -0,0 +1,228 @@
+#
+# Maintainers.pm - show information about maintainers
+#
+
+package Maintainers;
+
+use strict;
+
+use lib "Porting";
+
+require "Maintainers.pl";
+use vars qw(%Modules %Maintainers);
+
+use vars qw(@ISA @EXPORT_OK);
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(%Modules %Maintainers
+		get_module_files get_module_pat
+		show_results process_options);
+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]|file ...]
+--maintainer M	list all maintainers matching M
+--module M	list all modules matching M
+--files		list all 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;
+
+sub process_options {
+    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 '.' && !$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 $Modules{$m}{MAINTAINER}\n", $m;
+		}
+	    }
+	}
+    } 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};
+		printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
+	    } else {
+		printf "%-15s ?\n", $file;
+	    }
+	}
+    }
+    else {
+	usage();
+    }
+}
+
+1;
+
diff --git a/Porting/makemeta b/Porting/makemeta
new file mode 100644
index 0000000000..9889c8e81a
--- /dev/null
+++ b/Porting/makemeta
@@ -0,0 +1,36 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use lib "Porting";
+
+my $file = "META.yml";
+die "$0: will not override $file, delete it first.\n" if -e $file;
+
+use Maintainers qw(%Modules get_module_files get_module_pat);
+
+my @CPAN  = grep { $Modules{$_}{CPAN} } keys %Modules;
+my @files = map { get_module_files($_) } @CPAN;
+my @dirs  = grep { -d $_ } map { get_module_pat($_) } @CPAN;
+
+my $files = join '', map { "    - $_\n" } sort { lc $a cmp lc $b } @files;
+my $dirs  = join '', map { "    - $_\n" } sort { lc $a cmp lc $b } @dirs;
+
+open my $fh, ">$file" or die "Can't open $file: $!";
+
+print $fh <<"EOI";
+name: perl
+version: $]
+abstract: Practical Extraction and Reporting Language
+author: perl5-porters\@perl.org
+license: perl
+distribution_type: core
+private:
+  directory:
+$dirs
+  file:
+$files
+EOI
+
+close $fh;
+