diff --git a/lib/MetaCPAN/Document/File.pm b/lib/MetaCPAN/Document/File.pm index 97028fce2..c9fd79c8a 100644 --- a/lib/MetaCPAN/Document/File.pm +++ b/lib/MetaCPAN/Document/File.pm @@ -917,11 +917,7 @@ sub set_indexed { next; } - $mod->_set_indexed( - $mod->hide_from_pause( ${ $self->content }, $self->name ) - ? false - : true - ); + $mod->_set_indexed(true); } if ( my $doc_name = $self->documentation ) { diff --git a/lib/MetaCPAN/Document/Module.pm b/lib/MetaCPAN/Document/Module.pm index 3f1fc5358..a3901bae1 100644 --- a/lib/MetaCPAN/Document/Module.pm +++ b/lib/MetaCPAN/Document/Module.pm @@ -111,31 +111,6 @@ sub _build_version_numified { my $bom = qr/(?:\x00\x00\xfe\xff|\xff\xfe\x00\x00|\xfe\xff|\xff\xfe|\xef\xbb\xbf)/; -sub hide_from_pause { - my ( $self, $content, $file_name ) = @_; - return 0 if defined($file_name) && $file_name =~ m{\.pm\.PL\z}; - my $pkg = $self->name; - my $pkg_match = join q[(?:::|')], map quotemeta, split m{::}, $pkg; - -# This regexp is *almost* the same as $PKG_REGEXP in Module::Metadata. -# [b] We need to allow/ignore a possible BOM since we read in binary mode. -# Module::Metadata, for example, checks for a BOM and then sets the encoding. -# [s] We change `\s` to `\h` because we want to verify that it's on one line. -# [p] We replace $PKG_NAME_REGEXP with the specific package we're looking for. -# [v] Simplify the optional whitespace/version group ($V_NUM_REGEXP). - return $content =~ / # match a package declaration - ^ # start of line - (?:\A$bom)? # possible BOM at the start of the file [b] - [\h\{;]* # intro chars on a line [s] - package # the word 'package' - \h+ # whitespace [s] - ($pkg_match) # the package name [p] - (\h+ v?[0-9._]+)? # optional version number (preceded by whitespace) [v] - \h* # optional whitesapce [s] - [;\{] # semicolon line terminator or block start - /mx ? 0 : 1; -} - =head2 set_associated_pod Expects an instance C<$file> of L as first parameter diff --git a/lib/MetaCPAN/Model/Release.pm b/lib/MetaCPAN/Model/Release.pm index 83ef2f1d6..b756770dc 100644 --- a/lib/MetaCPAN/Model/Release.pm +++ b/lib/MetaCPAN/Model/Release.pm @@ -481,15 +481,16 @@ sub _modules_from_meta { my $provides = $self->metadata->provides; my $files = $self->files; + my %files = map +( $_->path => $_ ), @$files; foreach my $module ( sort keys %$provides ) { my $data = $provides->{$module}; my $path = File::Spec->canonpath( $data->{file} ); - # Obey no_index and take the shortest path if multiple files match. - my ($file) = sort { length( $a->path ) <=> length( $b->path ) } - grep { $_->indexed && $_->path =~ /\Q$path\E$/ } @$files; + my $file = $files{$path} + or next; + + next unless $file->indexed; - next unless $file; $file->add_module( { name => $module, version => $data->{version}, diff --git a/lib/MetaCPAN/Util.pm b/lib/MetaCPAN/Util.pm index 77b0855ae..582af0637 100644 --- a/lib/MetaCPAN/Util.pm +++ b/lib/MetaCPAN/Util.pm @@ -37,6 +37,7 @@ use Sub::Exporter -setup => { true false is_bool + to_bool MAX_RESULT_WINDOW ) ] }; @@ -44,9 +45,13 @@ use Sub::Exporter -setup => { # Limit the maximum result window to 1000, really should be enough! use constant MAX_RESULT_WINDOW => 1000; -*true = \&Cpanel::JSON::XS::true; -*false = \&Cpanel::JSON::XS::false; +sub true (); +*true = \&Cpanel::JSON::XS::true; +sub false (); +*false = \&Cpanel::JSON::XS::false; +sub is_bool ($); *is_bool = \&Cpanel::JSON::XS::is_bool; +sub to_bool ($) { $_[0] ? true : false } sub root_dir { Cwd::abs_path( File::Spec->catdir( diff --git a/t/document/file.t b/t/document/file.t index 6026b979f..0da986ebb 100644 --- a/t/document/file.t +++ b/t/document/file.t @@ -227,11 +227,6 @@ END is( $file->abstract, 'An object containing information about how to get access to teh Moby databases, resources, etc. from the mobycentral.config file' ); - is( - $file->module->[0] - ->hide_from_pause( ${ $file->content }, $file->name ), - 0, 'indexed' - ); is( $file->documentation, 'MOBY::Config' ); is( $file->level, 2 ); test_attributes $file, { @@ -302,13 +297,9 @@ AS-specific methods for Number::Phone 1; END - my $file = new_file_doc( - module => [ { name => 'Number::Phone::NANP::ASS', version => 1.1 } ], - content => \$content, - ); - is( $file->sloc, 8, '8 lines of code' ); - is( $file->slop, 4, '4 lines of pod' ); - is( $file->module->[0]->hide_from_pause($content), 1, 'not indexed' ); + my $file = new_file_doc( content => \$content, ); + is( $file->sloc, 8, '8 lines of code' ); + is( $file->slop, 4, '4 lines of pod' ); is( $file->abstract, 'AS-specific methods for Number::Phone', @@ -322,8 +313,6 @@ END is( $file->documentation, 'Number::Phone::NANP::AS', 'document text' ); is_deeply( $file->pod_lines, [ [ 18, 7 ] ], 'correct pod_lines' ); - is( $file->module->[0]->version_numified, - 1.1, 'numified version has been calculated' ); is( ${ $file->pod }, diff --git a/t/document/module.t b/t/document/module.t index d21fcac7d..c2c2400b4 100644 --- a/t/document/module.t +++ b/t/document/module.t @@ -5,61 +5,6 @@ use lib 't/lib'; use MetaCPAN::Document::Module (); use Test::More; -subtest hide_from_pause => sub { - foreach my $test ( - - # The original: - [ 'No::CommentNL' => "package # hide\n No::CommentNL;" ], - - # I'm not sure how PAUSE handles this one but currently we ignore it. - [ 'No::JustNL' => "package \n No::JustNL;" ], - - # The good ones: - [ 'Pkg' => 'package Pkg;' ], - [ 'Pkg::Ver' => 'package Pkg::Ver v1.2.3;' ], - [ 'Pkg::Block' => 'package Pkg::Block { our $var = 1 }' ], - [ - 'Pkg::VerBlock' => 'package Pkg::VerBlock 1.203 { our $var = 1 }' - ], - [ 'Pkg::SemiColons' => '; package Pkg::SemiColons; $var' ], - [ 'Pkg::InABlock' => '{ package Pkg::InABlock; $var }' ], - - # This doesn't work as a BOM can only appear at the start of a file. - #[ 'Pkg::AfterABOM' => "\xef\xbb\xbfpackage Pkg::AfterABOM" ], - - [ 'No::JustVar' => qq["\n\$package No::JustVar;\n"] ], - - # This shouldn't match, but there's only so much we can do... - # we're not going to eval the whole file to figure it out. - [ 'Pkg::InsideStr' => qq["\n package Pkg::InsideStr;\n"] ], - - [ 'No::Comment' => qq[# package No::Comment;\n] ], - [ 'No::Different' => q[package No::Different::Pkg;] ], - [ 'No::PkgWithNum' => qq["\npackage No::PkgWithNumv2.3;\n"] ], - [ 'No::CrazyChars' => qq["\npackage No::CrazyChars\[0\];\n"] ], - ) - { - my ( $name, $content ) = @$test; - - subtest $name => sub { - my $module = MetaCPAN::Document::Module->new( name => $name ); - - SKIP: { - skip( 'Perl 5.14 needed for package block compilation', 1 ) - if $] < 5.014; - ## no critic - ok eval "sub { no strict; $content }", "code compiles" - or diag $@; - } - - my ($hidden) = ( $name =~ /^No::/ ? 1 : 0 ); - - is $module->hide_from_pause($content), $hidden, - "hide_from_pause is $hidden"; - }; - } -}; - subtest set_associated_pod => sub { test_associated_pod( 'Squirrel', [qw( lib/Squirrel.pod )], 'lib/Squirrel.pod' ); diff --git a/t/lib/MetaCPAN/Tests/Release.pm b/t/lib/MetaCPAN/Tests/Release.pm index 1da09c204..8f7c7a6c7 100644 --- a/t/lib/MetaCPAN/Tests/Release.pm +++ b/t/lib/MetaCPAN/Tests/Release.pm @@ -230,18 +230,14 @@ test 'modules in Packages-1.103' => sub { = map { ( $_->{path} => $_->{module} ) } @{ $self->module_files }; foreach my $path ( sort keys %{ $self->modules } ) { - my $desc = "File '$path' has expected modules"; - if ( my $got = delete $module_files{$path} ) { - my $got = [ map +{%$_}, @$got ]; - $_->{associated_pod} //= undef for @$got; + my $desc = "File '$path' has expected modules"; + my $got_modules = delete $module_files{$path} || []; + my $got = [ map +{%$_}, @$got_modules ]; + $_->{associated_pod} //= undef for @$got; # We may need to sort modules by name, I'm not sure if order is reliable. - is_deeply $got, $self->modules->{$path}, $desc - or diag Test::More::explain($got); - } - else { - ok( 0, $desc ); - } + is_deeply $got, $self->modules->{$path}, $desc + or diag Test::More::explain($got); } is( scalar keys %module_files, 0, 'all module files tested' ) diff --git a/t/release/file-duplicates.t b/t/release/file-duplicates.t index 226bc5df4..50ca19b88 100644 --- a/t/release/file-duplicates.t +++ b/t/release/file-duplicates.t @@ -28,14 +28,7 @@ test_release( indexed => true, associated_pod => undef, } ], - 'lib/Dupe.pm' => [ { - name => 'Dupe', - version => '0.993', - version_numified => '0.993', - authorized => true, - indexed => false, - associated_pod => undef, - } ], + 'lib/Dupe.pm' => [], 'DupeX/Dupe.pm' => [ { name => 'DupeX::Dupe',