set authorized flag for perl releases based on pumpking list

metacpan · Apr 25, 2024 · 723b8c1 · 723b8c1
1 parent b5dcfa4
commit 723b8c1
Show file tree

Hide file tree

Showing 3 changed files with 91 additions and 13 deletions.
diff --git a/lib/MetaCPAN/Document/File.pm b/lib/MetaCPAN/Document/File.pm
@@ -959,19 +959,27 @@ as unauthorized as well.
 sub set_authorized {
     my ( $self, $perms ) = @_;
 
-    # only authorized perl distributions make it into the CPAN
-    return () if ( $self->distribution eq 'perl' );
-    foreach my $module ( @{ $self->module } ) {
-        $module->_set_authorized(0)
-            if ( $perms->{ $module->name } && !grep { $_ eq $self->author }
-            @{ $perms->{ $module->name } } );
+    if ( $self->distribution eq 'perl' ) {
+        my $allowed = grep $_ eq $self->author, @{ $perms->{perl} };
+        foreach my $module ( @{ $self->module } ) {
+            $module->_set_authorized($allowed);
+        }
+        $self->_set_authorized($allowed);
+    }
+    else {
+        foreach my $module ( @{ $self->module } ) {
+            $module->_set_authorized(0)
+                if ( $perms->{ $module->name }
+                && !grep { $_ eq $self->author }
+                @{ $perms->{ $module->name } } );
+        }
+        $self->_set_authorized(0)
+            if ( $self->authorized
+            && $self->documentation
+            && $perms->{ $self->documentation }
+            && !grep { $_ eq $self->author }
+            @{ $perms->{ $self->documentation } } );
     }
-    $self->_set_authorized(0)
-        if ( $self->authorized
-        && $self->documentation
-        && $perms->{ $self->documentation }
-        && !grep { $_ eq $self->author }
-        @{ $perms->{ $self->documentation } } );
     return grep { !$_->authorized && $_->indexed } @{ $self->module };
 }
 

diff --git a/lib/MetaCPAN/Script/Release.pm b/lib/MetaCPAN/Script/Release.pm
@@ -14,7 +14,8 @@ use MetaCPAN::Script::Runner  ();
 use MetaCPAN::Types::TypeTiny qw( Bool HashRef Int Str );
 use Moose;
 use PerlIO::gzip;
-use Try::Tiny qw( catch try );
+use Try::Tiny  qw( catch try );
+use Path::Tiny qw(path);
 
 with 'MetaCPAN::Role::Script', 'MooseX::Getopt',
     'MetaCPAN::Script::Role::Contributor';
@@ -431,6 +432,24 @@ sub _build_perms {
         }
         close $fh;
     }
+
+    # we would like this data to come from CPAN directly eventually
+    #my $pumpking_file = $self->cpan->child(qw(modules 07pumpkings.txt));
+    my $pumpking_file
+        = path(__FILE__)->parent->child(qw(Release 07pumpkings.txt));
+    if ( -e $pumpking_file ) {
+        log_debug { "parsing ", $pumpking_file };
+        my $fh = $pumpking_file->openr;
+        while ( my $line = <$fh> ) {
+            chomp $line;
+            push( @{ $authors{perl} ||= [] }, $line );
+        }
+        close $fh;
+    }
+    else {
+        log_warn {"$pumpking_file could not be found."};
+    }
+
     return \%authors;
 }
 

diff --git a/lib/MetaCPAN/Script/Release/07pumpkings.txt b/lib/MetaCPAN/Script/Release/07pumpkings.txt
@@ -0,0 +1,51 @@
+ABH
+ABIGAIL
+ANDYD
+ARISTOTLE
+ATOOMIC
+AVAR
+BINGOS
+CHIPS
+CORION
+DAGOLDEN
+DAPM
+DOM
+DOY
+DROLSKY
+EHERMAN
+ETHER
+EXODIST
+FLORA
+GBARR
+GENEHACK
+GSAR
+HAARG
+HVDS
+HYDAHY
+JESSE
+JHI
+LBROCARD
+LEONT
+LWALL
+MICB
+MIYAGAWA
+MSTROUT
+NEILB
+NI-S
+NWCLARK
+PCM
+PEVANS
+RENEEB
+RGARCIA
+RJBS
+SHAY
+STEVAN
+TIMB
+TODDR
+TOMHUKINS
+TONYC
+WOLFSAGE
+XSAWYERX
+YVES
+ZAKAME
+ZEFRAM