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/00_setup.t b/t/00_setup.t index b2b6a545a..acdcd6fdb 100644 --- a/t/00_setup.t +++ b/t/00_setup.t @@ -11,6 +11,7 @@ use MetaCPAN::TestHelpers qw( fakecpan_dir get_config tmp_dir + write_find_ls ); use MetaCPAN::TestServer (); use Module::Faker 0.015 (); # Generates META.json. @@ -94,6 +95,8 @@ $src_dir->child('bugs.tsv')->copy( $fakecpan_dir->child('bugs.tsv') ); $src_dir->child('mirrors.json') ->copy( $fakecpan_dir->child(qw(indices mirrors.json)) ); +write_find_ls($fakecpan_dir); + $server->index_permissions; $server->index_packages; $server->index_releases; diff --git a/t/lib/MetaCPAN/DarkPAN.pm b/t/lib/MetaCPAN/DarkPAN.pm index a14d3797c..7b7faa2c4 100644 --- a/t/lib/MetaCPAN/DarkPAN.pm +++ b/t/lib/MetaCPAN/DarkPAN.pm @@ -3,7 +3,7 @@ package MetaCPAN::DarkPAN; use MetaCPAN::Moose; use CPAN::Repository::Perms; -use MetaCPAN::TestHelpers qw( get_config ); +use MetaCPAN::TestHelpers qw( get_config write_find_ls ); use MetaCPAN::Types::TypeTiny qw( Path ); use MetaCPAN::Util qw( author_dir ); use OrePAN2::Indexer; @@ -67,6 +67,7 @@ sub run { ); $orepan->make_index( no_compress => 1, ); $self->_write_06perms; + write_find_ls( $self->base_dir ); } sub _write_06perms { diff --git a/t/lib/MetaCPAN/TestHelpers.pm b/t/lib/MetaCPAN/TestHelpers.pm index 2f7ee6a4f..596c00ba7 100644 --- a/t/lib/MetaCPAN/TestHelpers.pm +++ b/t/lib/MetaCPAN/TestHelpers.pm @@ -5,6 +5,8 @@ package # no_index MetaCPAN::TestHelpers; use Cpanel::JSON::XS; +use File::Copy qw( copy ); +use File::pushd qw( pushd ); use FindBin; use Git::Helpers qw( checkout_root ); use MetaCPAN::Script::Runner; @@ -30,6 +32,7 @@ our @EXPORT = qw( test_release tmp_dir try + write_find_ls ); =head1 EXPORTS @@ -145,4 +148,25 @@ sub test_cache_headers { ) if exists $conf->{surrogate_control}; } +sub write_find_ls { + my $cpan_dir = shift; + + my $indices = $cpan_dir->child('indices'); + $indices->mkpath; + + my $find_ls = $indices->child('find-ls.gz')->openw(':gzip'); + + my $chdir = pushd($cpan_dir); + + open my $fh, '-|', 'find', 'authors', '-ls' + or die "can't run find: $!"; + + copy $fh, $find_ls; + + close $fh; + close $find_ls; + + return; +} + 1;