embed.fnc: Mark unlnk as Core only

[perl5.git] / Porting / Maintainers.pm

diff --git a/Porting/Maintainers.pm b/Porting/Maintainers.pm
index 51c847f..20ed4f7 100644 (file)
--- a/Porting/Maintainers.pm
+++ b/Porting/Maintainers.pm
@@ -13,16 +13,15 @@ use lib "Porting";
 use 5.008;
 
 require "Maintainers.pl";
-use vars qw(%Modules %Maintainers);
+our (%Modules, %Maintainers);
 
-use vars qw(@ISA @EXPORT_OK $VERSION);
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(%Modules %Maintainers
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(%Modules %Maintainers
                get_module_files get_module_pat
                show_results process_options files_to_modules
-        finish_tap_output
+               finish_tap_output
                reload_manifest);
-$VERSION = 0.04;
+our $VERSION = 0.13;
 
 require Exporter;
 
@@ -41,7 +40,7 @@ sub reload_manifest {
         $manifest_path = "../MANIFEST";
     }
 
-    if (open(my $manfh,  $manifest_path )) {
+    if (open(my $manfh,  '<', $manifest_path )) {
        while (<$manfh>) {
            if (/^(\S+)/) {
                $MANIFEST{$1}++;
@@ -64,7 +63,7 @@ sub get_module_pat {
     split ' ', $Modules{$m}{FILES};
 }
 
-# exand dir/ or foo* into a full list of files
+# expand dir/ or foo* into a full list of files
 #
 sub expand_glob {
     sort { lc $a cmp lc $b }
@@ -81,15 +80,31 @@ 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) = @_;
+
+    my $excluded = $Modules{$m}{EXCLUDED};
+    return @files
+       unless $excluded and @$excluded;
+
+    my ($pat) = map { qr/$_/ } join '|' => map {
+       ref $_ ? $_ : qr/\b\Q$_\E$/
+    } @{ $excluded };
+
+    return grep { $_ !~ $pat } @files;
+}
+
 sub get_module_files {
     my $m = shift;
-    return map { expand_glob($_) } get_module_pat($m);
+    return filter_excluded $m => map { expand_glob($_) } get_module_pat($m);
 }
 
 
@@ -119,10 +134,6 @@ or
     --opened  | file ....
                List the module ownership of modified or the listed files
 
-    --tap-output
-        Show results as valid TAP output. Currently only compatible
-        with --check, --checkmani
-
 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.
@@ -138,7 +149,6 @@ my $Check;
 my $Checkmani;
 my $Opened;
 my $TestCounter = 0;
-my $TapOutput;
 
 sub process_options {
     usage()
@@ -150,7 +160,6 @@ sub process_options {
                       'check'          => \$Check,
                       'checkmani'      => \$Checkmani,
                       'opened'         => \$Opened,
-                      'tap-output' => \$TapOutput,
                      );
 
     my @Files;
@@ -226,7 +235,7 @@ sub files_to_modules {
        if (@ToDo) {
            # Try prefix matching.
 
-           # Need to try longst prefixes first, else lib/CPAN may match
+           # Need to try longest prefixes first, else lib/CPAN may match
            # lib/CPANPLUS/... and similar
 
            my @OrderedModuleByPat
@@ -292,6 +301,8 @@ sub show_results {
            }
        }
     } elsif ($Check or $Checkmani) {
+        require Test::More;
+        Test::More->import;
         if( @Files ) {
                    missing_maintainers(
                        $Checkmani
@@ -299,8 +310,9 @@ sub show_results {
                            : sub { /\.(?:[chty]|p[lm]|xs)\z/msx },
                        @Files
                    );
-               } else { 
+               } else {
                    duplicated_maintainers();
+                   superfluous_maintainers();
                }
     } elsif (@Files) {
        my $ModuleByFile = files_to_modules(@Files);
@@ -336,34 +348,14 @@ sub maintainers_files {
 
 sub duplicated_maintainers {
     maintainers_files();
-    for my $f (keys %files) {
-        if ($TapOutput) {
-               if ($files{$f} > 1) {
-                   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";
-            }
-        } else {
-               if ($files{$f} > 1) {
-                   warn "File $f appears $files{$f} times in Maintainers.pl\n";
-               }
-    }
+    for my $f (sort keys %files) {
+        cmp_ok($files{$f}, '<=', 1, "File $f appears $files{$f} times in Maintainers.pl");
     }
 }
 
 sub warn_maintainer {
     my $name = shift;
-    if ($TapOutput) {
-        if ($files{$name}) {
-            print "ok ".++$TestCounter." - $name has a maintainer\n";
-        } else {
-            print "not ok ".++$TestCounter." - $name has NO maintainer\n";
-           
-        } 
-
-    } else {
-        warn "File $name has no maintainer\n" if not $files{$name};
-    }
+    ok($files{$name}, "$name has a maintainer (see Porting/Maintainer.pl)");
 }
 
 sub missing_maintainers {
@@ -376,8 +368,15 @@ sub missing_maintainers {
     find sub { warn_maintainer($File::Find::name) if $check->() }, @dir if @dir;
 }
 
+sub superfluous_maintainers {
+    maintainers_files();
+    for my $f (sort keys %files) {
+        ok($MANIFEST{$f}, "File $f has a maintainer and is in MANIFEST");
+    }
+}
+
 sub finish_tap_output {
-    print "1..".$TestCounter."\n"; 
+    done_testing();
 }
 
 1;