epigraph for 5.17.0

[perl5.git] / Porting / Maintainers.pm

diff --git a/Porting/Maintainers.pm b/Porting/Maintainers.pm
index e5dde3c..3e6697f 100644 (file)
--- a/Porting/Maintainers.pm
+++ b/Porting/Maintainers.pm
@@ -5,6 +5,7 @@
 package Maintainers;
 
 use strict;
+use warnings;
 
 use lib "Porting";
 # Please don't use post 5.008 features as this module is used by
@@ -19,8 +20,10 @@ use vars qw(@ISA @EXPORT_OK $VERSION);
 @EXPORT_OK = qw(%Modules %Maintainers
                get_module_files get_module_pat
                show_results process_options files_to_modules
+               finish_tap_output
                reload_manifest);
-$VERSION = 0.03;
+$VERSION = 0.06;
+
 require Exporter;
 
 use File::Find;
@@ -32,8 +35,14 @@ my %MANIFEST;
 
 sub reload_manifest {
     %MANIFEST = ();
-    if (open(MANIFEST, "MANIFEST")) {
-       while (<MANIFEST>) {
+
+    my $manifest_path = 'MANIFEST';
+   if (! -e  $manifest_path) {
+        $manifest_path = "../MANIFEST";
+    }
+
+    if (open(my $manfh,  $manifest_path )) {
+       while (<$manfh>) {
            if (/^(\S+)/) {
                $MANIFEST{$1}++;
            }
@@ -41,9 +50,9 @@ sub reload_manifest {
                warn "MANIFEST:$.: malformed line: $_\n";
            }
        }
-       close MANIFEST;
+       close $manfh;
     } else {
-       die "$0: Failed to open MANIFEST for reading: $!\n";
+           die "$0: Failed to open MANIFEST for reading: $!\n";
     }
 }
 
@@ -60,9 +69,9 @@ sub get_module_pat {
 sub expand_glob {
     sort { lc $a cmp lc $b }
        map {
-           -f $_ ? # File as-is.
+           -f $_ && $_ !~ /[*?]/ ? # File as-is.
                $_ :
-               -d _ ? # Recurse into directories.
+               -d _ && $_ !~ /[*?]/ ? # Recurse into directories.
                do {
                    my @files;
                    find(
@@ -72,25 +81,30 @@ sub expand_glob {
                         }, $_);
                    @files;
                }
+           # Not a glob, but doesn't exist
+           : $_ !~ /[*?{]/ ? $_
            # The rest are globbable patterns; expand the glob, then
-           # recurively perform directory expansion on any results
-           : expand_glob(grep -e $_,glob($_))
+           # recursively perform directory expansion on any results
+           : expand_glob(glob($_))
            } @_;
 }
 
+sub filter_excluded {
+    my ($m, @files) = @_;
+
+    return @files
+       unless my $excluded = $Modules{$m}{EXCLUDED};
+
+    my ($pat) = map { qr/$_/ } join '|' => map {
+       ref $_ ? $_ : qr/\b\Q$_\E$/
+    } @{ $excluded };
+
+    return grep { $_ !~ $pat } @files;
+}
+
 sub get_module_files {
     my $m = shift;
-    my %exclude;
-    my @files;
-    for (get_module_pat($m)) {
-       if (s/^!//) {
-           $exclude{$_}=1 for expand_glob($_);
-       }
-       else {
-           push @files, expand_glob($_);
-       }
-    }
-    return grep !$exclude{$_}, @files;
+    return filter_excluded $m => map { expand_glob($_) } get_module_pat($m);
 }
 
 
@@ -134,6 +148,7 @@ my $Files;
 my $Check;
 my $Checkmani;
 my $Opened;
+my $TestCounter = 0;
 
 sub process_options {
     usage()
@@ -287,16 +302,16 @@ sub show_results {
        }
     } elsif ($Check or $Checkmani) {
         if( @Files ) {
-           missing_maintainers(
-               $Checkmani
-                   ? sub { -f $_ and exists $MANIFEST{$File::Find::name} }
-                   : sub { /\.(?:[chty]|p[lm]|xs)\z/msx },
-               @Files
-           );
-       }
-       else { 
-           duplicated_maintainers();
-       }
+                   missing_maintainers(
+                       $Checkmani
+                           ? sub { -f $_ and exists $MANIFEST{$File::Find::name} }
+                           : sub { /\.(?:[chty]|p[lm]|xs)\z/msx },
+                       @Files
+                   );
+               } else {
+                   duplicated_maintainers();
+                   superfluous_maintainers();
+               }
     } elsif (@Files) {
        my $ModuleByFile = files_to_modules(@Files);
        for my $file (@Files) {
@@ -333,14 +348,20 @@ 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";
+           print  "not ok ".++$TestCounter." - File $f appears $files{$f} times in Maintainers.pl\n";
+       } else {
+           print  "ok ".++$TestCounter." - 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};
+    if ($files{$name}) {
+       print "ok ".++$TestCounter." - $name has a maintainer\n";
+    } else {
+       print "not ok ".++$TestCounter." - $name has NO maintainer\n";
+    }
 }
 
 sub missing_maintainers {
@@ -348,10 +369,24 @@ sub missing_maintainers {
     maintainers_files();
     my @dir;
     for my $d (@path) {
-       if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
+           if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
+    }
+    find sub { warn_maintainer($File::Find::name) if $check->() }, @dir if @dir;
+}
+
+sub superfluous_maintainers {
+    maintainers_files();
+    for my $f (keys %files) {
+       if ($MANIFEST{$f}) {
+           print "ok ".++$TestCounter." - Maintained file $f appears in MANIFEST\n";
+       } else {
+           print "not ok ".++$TestCounter." - File $f has has a maintainer but is not in MANIFEST\n";
+       }
     }
-    find sub { warn_maintainer($File::Find::name) if $check->() }, @dir
-       if @dir;
+}
+
+sub finish_tap_output {
+    print "1..".$TestCounter."\n"; 
 }
 
 1;