From 51c1edc44c5af24989b125d2f6115b7287e5b8e7 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Sat, 24 Feb 2024 10:29:36 +0100 Subject: [PATCH] Only use author json files from CPAN, not BackPAN --- cpanfile | 2 ++ lib/MetaCPAN/Role/Script.pm | 26 ++++++++++++++++++++++++++ lib/MetaCPAN/Script/Author.pm | 4 ++++ lib/MetaCPAN/Script/Backpan.pm | 28 +--------------------------- lib/MetaCPAN/Script/Release.pm | 23 ++--------------------- t/lib/MetaCPAN/DarkPAN.pm | 23 +++++++++++++++++++++++ 6 files changed, 58 insertions(+), 48 deletions(-) diff --git a/cpanfile b/cpanfile index 50ec0cd4e..2788cf967 100644 --- a/cpanfile +++ b/cpanfile @@ -57,11 +57,13 @@ requires 'EV'; requires 'Exporter', '5.74'; requires 'ExtUtils::HasCompiler'; requires 'File::Basename'; +requires 'File::Copy'; requires 'File::Find'; requires 'File::Find::Rule'; requires 'File::Find::Rule::Perl'; requires 'File::Spec'; requires 'File::Spec::Functions'; +requires 'File::pushd'; requires 'File::stat'; requires 'File::Temp'; requires 'FindBin'; diff --git a/lib/MetaCPAN/Role/Script.pm b/lib/MetaCPAN/Role/Script.pm index 7ee0885e4..190ed1e82 100644 --- a/lib/MetaCPAN/Role/Script.pm +++ b/lib/MetaCPAN/Role/Script.pm @@ -28,6 +28,14 @@ has cpan => ( 'Location of a local CPAN mirror, looks for $ENV{MINICPAN} and ~/CPAN', ); +has cpan_file_map => ( + is => 'ro', + isa => HashRef, + lazy => 1, + builder => '_build_cpan_file_map', + traits => ['NoGetopt'], +); + has die_on_error => ( is => 'ro', isa => Bool, @@ -225,6 +233,24 @@ sub _build_cpan { } +sub _build_cpan_file_map { + my $self = shift; + my $ls = $self->cpan->child(qw(indices find-ls.gz)); + unless ( -e $ls ) { + die "File $ls does not exist"; + } + log_info {"Reading $ls"}; + my $cpan = {}; + open my $fh, "<:gzip", $ls; + while (<$fh>) { + my $path = ( split(/\s+/) )[-1]; + next unless ( $path =~ /^authors\/id\/\w+\/\w+\/(\w+)\/(.*)$/ ); + $cpan->{$1}{$2} = 1; + } + close $fh; + return $cpan; +} + sub _build_quarantine { my $path = "$ENV{HOME}/QUARANTINE"; if ( !-d $path ) { diff --git a/lib/MetaCPAN/Script/Author.pm b/lib/MetaCPAN/Script/Author.pm index 77437e3d5..9ed4e804e 100644 --- a/lib/MetaCPAN/Script/Author.pm +++ b/lib/MetaCPAN/Script/Author.pm @@ -260,9 +260,13 @@ sub author_config { return undef unless $dir->is_dir; + my $author_cpan_files = $self->cpan_file_map->{$pauseid} + or return undef; + # Get the most recent version my ($file) = map $_->[0], sort { $a->[1] <=> $b->[1] } map [ $_ => $_->stat->mtime ], + grep $author_cpan_files->{ $_->basename }, $dir->children(qr/\Aauthor-.*\.json\z/); return undef diff --git a/lib/MetaCPAN/Script/Backpan.pm b/lib/MetaCPAN/Script/Backpan.pm index 1b993d7af..2bb4cc39e 100644 --- a/lib/MetaCPAN/Script/Backpan.pm +++ b/lib/MetaCPAN/Script/Backpan.pm @@ -31,13 +31,6 @@ has files_only => ( documentation => 'only update the "file" index', ); -has _cpan_files_list => ( - is => 'ro', - isa => HashRef, - lazy => 1, - builder => '_build_cpan_files_list', -); - has _release_status => ( is => 'ro', isa => HashRef, @@ -50,25 +43,6 @@ has _bulk => ( default => sub { +{} }, ); -sub _build_cpan_files_list { - my $self = shift; - my $ls = $self->cpan->child(qw(indices find-ls.gz)); - unless ( -e $ls ) { - log_error {"File $ls does not exist"}; - exit; - } - log_info {"Reading $ls"}; - my $cpan = {}; - open my $fh, "<:gzip", $ls; - while (<$fh>) { - my $path = ( split(/\s+/) )[-1]; - next unless ( $path =~ /^authors\/id\/\w+\/\w+\/(\w+)\/(.*)$/ ); - $cpan->{$1}{$2} = 1; - } - close $fh; - return $cpan; -} - sub run { my $self = shift; @@ -106,7 +80,7 @@ sub build_release_status_map { $self->_release_status->{$author}{$name} = [ ( $self->undo - or exists $self->_cpan_files_list->{$author}{$archive} + or exists $self->cpan_file_map->{$author}{$archive} ) ? 'cpan' : 'backpan', diff --git a/lib/MetaCPAN/Script/Release.pm b/lib/MetaCPAN/Script/Release.pm index 88a50bbd0..c2f6569df 100644 --- a/lib/MetaCPAN/Script/Release.pm +++ b/lib/MetaCPAN/Script/Release.pm @@ -187,7 +187,7 @@ sub run { my @module_to_purge_dists = map { CPAN::DistnameInfo->new($_) } @files; $self->index; - $self->_cpan_files_list if ( $self->detect_backpan ); + $self->cpan_file_map if ( $self->detect_backpan ); $self->perms; my @pid; @@ -388,29 +388,10 @@ sub import_archive { $self->update_release_contirbutors($contrib_data); } -sub _build_cpan_files_list { - my $self = shift; - my $ls = $self->cpan->child(qw(indices find-ls.gz)); - unless ( -e $ls ) { - log_error {"File $ls does not exist"}; - exit; - } - log_info {"Reading $ls"}; - my $cpan = {}; - open my $fh, "<:gzip", $ls; - while (<$fh>) { - my $path = ( split(/\s+/) )[-1]; - next unless ( $path =~ /^authors\/id\/\w+\/\w+\/(.*)$/ ); - $cpan->{$1} = 1; - } - close $fh; - return $cpan; -} - sub detect_status { my ( $self, $author, $archive ) = @_; return $self->status unless ( $self->detect_backpan ); - if ( $self->_cpan_files_list->{ join( '/', $author, $archive ) } ) { + if ( $self->cpan_file_map->{$author}{$archive} ) { return 'cpan'; } else { diff --git a/t/lib/MetaCPAN/DarkPAN.pm b/t/lib/MetaCPAN/DarkPAN.pm index a14d3797c..b3161f21c 100644 --- a/t/lib/MetaCPAN/DarkPAN.pm +++ b/t/lib/MetaCPAN/DarkPAN.pm @@ -10,6 +10,8 @@ use OrePAN2::Indexer; use OrePAN2::Injector; use Path::Tiny qw( path ); use URI::FromHash qw( uri_object ); +use File::pushd qw( pushd ); +use File::Copy qw( copy ); has base_dir => ( is => 'ro', @@ -67,6 +69,7 @@ sub run { ); $orepan->make_index( no_compress => 1, ); $self->_write_06perms; + $self->_write_find_ls; } sub _write_06perms { @@ -104,5 +107,25 @@ sub _write_06perms { $modules_dir->child('06perms.txt')->spew($content); } +sub _write_find_ls { + my $self = shift; + my $base_dir = $self->base_dir; + + my $indices = $base_dir->child('indices'); + $indices->mkpath; + + my $find_ls = $indices->child('find-ls.gz')->openw(':gzip'); + + pushd($base_dir); + + open my $fh, '-|', 'find', 'authors', '-ls' + or die "can't run find: $!"; + + copy $fh, $find_ls; + + close $fh; + close $find_ls; +} + __PACKAGE__->meta->make_immutable; 1;