Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[PATCH] Upgrade Module::Metadata to 1.000032 #15325

Closed
p5pRT opened this issue May 16, 2016 · 8 comments
Closed

[PATCH] Upgrade Module::Metadata to 1.000032 #15325

p5pRT opened this issue May 16, 2016 · 8 comments

Comments

@p5pRT
Copy link

p5pRT commented May 16, 2016

Migrated from rt.perl.org#128153 (status was 'resolved')

Searchable as RT128153$

@p5pRT
Copy link
Author

p5pRT commented May 16, 2016

From @karenetheridge

Patch attached. I also included a small typo fix to the RMG.

@p5pRT
Copy link
Author

p5pRT commented May 16, 2016

From @karenetheridge

0001-fix-typo-in-RMG.patch
From 39a5cfa8b98cd714cd2f7117ce5bcbcaf46fc97c Mon Sep 17 00:00:00 2001
From: Karen Etheridge <ether@cpan.org>
Date: Sun, 15 May 2016 19:18:39 -0700
Subject: [PATCH 1/2] fix typo in RMG

---
 Porting/release_managers_guide.pod | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Porting/release_managers_guide.pod b/Porting/release_managers_guide.pod
index 3e1e025..0d724e7 100644
--- a/Porting/release_managers_guide.pod
+++ b/Porting/release_managers_guide.pod
@@ -278,7 +278,7 @@ into the repository anyway.
 =item *
 
 For any new files in the distro, determine whether they are needed.
-If not, delete them, and list them in either C<EXCLUDED> or C<@INGORE>.
+If not, delete them, and list them in either C<EXCLUDED> or C<@IGNORABLE>.
 Otherwise, add them to C<MANIFEST>, and run C<git add> to add the files
 to the repository.
 
-- 
2.6.2

@p5pRT
Copy link
Author

p5pRT commented May 16, 2016

From @karenetheridge

0002-upgrade-Module-Metadata-to-1.000032.patch
From d3f67dd7d4640f699da38484c76bb2e63e4e82a7 Mon Sep 17 00:00:00 2001
From: Karen Etheridge <ether@cpan.org>
Date: Sun, 15 May 2016 19:19:01 -0700
Subject: [PATCH 2/2] upgrade Module-Metadata to 1.000032

---
 Porting/Maintainers.pl                      |  2 +-
 cpan/Module-Metadata/lib/Module/Metadata.pm | 41 ++++++++++++++++-----
 cpan/Module-Metadata/t/extract-package.t    | 24 +++++++++++-
 cpan/Module-Metadata/t/extract-version.t    | 21 ++++++++---
 cpan/Module-Metadata/t/metadata.t           | 57 +++++++++++++++++++++++++++--
 5 files changed, 124 insertions(+), 21 deletions(-)

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index c581008..e3c102d 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -854,7 +854,7 @@ use File::Glob qw(:case);
     },
 
     'Module::Metadata' => {
-        'DISTRIBUTION' => 'ETHER/Module-Metadata-1.000031-TRIAL.tar.gz',
+        'DISTRIBUTION' => 'ETHER/Module-Metadata-1.000032-TRIAL.tar.gz',
         'FILES'        => q[cpan/Module-Metadata],
         'EXCLUDED'     => [
             qw(t/00-report-prereqs.t),
diff --git a/cpan/Module-Metadata/lib/Module/Metadata.pm b/cpan/Module-Metadata/lib/Module/Metadata.pm
index f7017cf..e8c2b25 100644
--- a/cpan/Module-Metadata/lib/Module/Metadata.pm
+++ b/cpan/Module-Metadata/lib/Module/Metadata.pm
@@ -1,6 +1,6 @@
 # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
-# vim:ts=8:sw=2:et:sta:sts=2
-package Module::Metadata; # git description: v1.000030-2-g52f466c
+# vim:ts=8:sw=2:et:sta:sts=2:tw=78
+package Module::Metadata; # git description: v1.000031-13-g7c061c9
 # ABSTRACT: Gather package and POD information from perl module files
 
 # Adapted from Perl-licensed code originally distributed with
@@ -14,7 +14,7 @@ sub __clean_eval { eval $_[0] }
 use strict;
 use warnings;
 
-our $VERSION = '1.000031'; # TRIAL
+our $VERSION = '1.000032'; # TRIAL
 
 use Carp qw/croak/;
 use File::Spec;
@@ -411,15 +411,29 @@ sub _init {
   }
   $self->_parse_fh($handle);
 
+  @{$self->{packages}} = __uniq(@{$self->{packages}});
+
   unless($self->{module} and length($self->{module})) {
-    my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
-    if($f =~ /\.pm$/) {
+    # CAVEAT (possible TODO): .pmc files not treated the same as .pm
+    if ($self->{filename} =~ /\.pm$/) {
+      my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
       $f =~ s/\..+$//;
-      my @candidates = grep /$f$/, @{$self->{packages}};
-      $self->{module} = shift(@candidates); # punt
+      my @candidates = grep /(^|::)$f$/, @{$self->{packages}};
+      $self->{module} = shift(@candidates); # this may be undef
     }
     else {
-      $self->{module} = 'main';
+      # this seems like an atrocious heuristic, albeit marginally better than
+      # what was here before. It should be rewritten entirely to be more like
+      # "if it's not a .pm file, it's not require()able as a name, therefore
+      # name() should be undef."
+      if ((grep /main/, @{$self->{packages}})
+          or (grep /main/, keys %{$self->{versions}})) {
+        $self->{module} = 'main';
+      }
+      else {
+        # TODO: this should maybe default to undef instead
+        $self->{module} = $self->{packages}[0] || '';
+      }
     }
   }
 
@@ -440,6 +454,7 @@ sub _do_find_module {
     my $testfile = File::Spec->catfile($dir, $file);
     return [ File::Spec->rel2abs( $testfile ), $dir ]
       if -e $testfile and !-d _;  # For stuff like ExtUtils::xsubpp
+    # CAVEAT (possible TODO): .pmc files are not discoverable here
     $testfile .= '.pm';
     return [ File::Spec->rel2abs( $testfile ), $dir ]
       if -e $testfile;
@@ -649,6 +664,12 @@ sub _parse_fh {
   $self->{pod_headings} = \@pod;
 }
 
+sub __uniq (@)
+{
+    my (%seen, $key);
+    grep { not $seen{ $key = $_ }++ } @_;
+}
+
 {
 my $pn = 0;
 sub _evaluate_version_line {
@@ -820,7 +841,7 @@ Module::Metadata - Gather package and POD information from perl module files
 
 =head1 VERSION
 
-version 1.000031
+version 1.000032
 
 =head1 SYNOPSIS
 
@@ -1037,7 +1058,7 @@ There is also a mailing list available for users of this distribution, at
 L<http://lists.perl.org/list/cpan-workers.html>.
 
 There is also an irc channel available for users of this distribution, at
-L<irc://irc.perl.org/#toolchain>.
+L<C<#toolchain> on C<irc.perl.org>|irc://irc.perl.org/#toolchain>.
 
 =head1 AUTHOR
 
diff --git a/cpan/Module-Metadata/t/extract-package.t b/cpan/Module-Metadata/t/extract-package.t
index 640b239..db99dae 100644
--- a/cpan/Module-Metadata/t/extract-package.t
+++ b/cpan/Module-Metadata/t/extract-package.t
@@ -107,6 +107,26 @@ package Simple;
 $Foo::Bar::VERSION = '1.23';
 ---
 },
+{
+  name => 'script 7 from t/metadata.t', # TODO merge these
+  package => [ '_private', 'main' ],
+  TODO => '$::VERSION indicates main namespace is referenced',
+  code => <<'---',
+package _private;
+$::VERSION = 0.01;
+$VERSION = '999';
+---
+},
+{
+  name => 'script 8 from t/metadata.t', # TODO merge these
+  package => [ '_private', 'main' ],
+  TODO => '$::VERSION indicates main namespace is referenced',
+  code => <<'---',
+package _private;
+$VERSION = '999';
+$::VERSION = 0.01;
+---
+},
 );
 
 my $test_num = 0;
@@ -118,7 +138,6 @@ foreach my $test_case (@pkg_names) {
     note $test_case->{name};
     my $code = $test_case->{code};
     my $expected_name = $test_case->{package};
-    local $TODO = $test_case->{TODO};
 
     my $warnings = '';
     local $SIG{__WARN__} = sub { $warnings .= $_ for @_ };
@@ -133,9 +152,12 @@ foreach my $test_case (@pkg_names) {
     # Test::Builder will prematurely numify objects, so use this form
     my $errs;
     my @got = $pm_info->packages_inside();
+  {
+    local $TODO = $test_case->{TODO};
     is_deeply( \@got, $expected_name,
                "case $test_case->{name}: correct package names (expected '" . join(', ', @$expected_name) . "')" )
             or $errs++;
+  }
     is( $warnings, '', "case $test_case->{name}: no warnings from parsing" ) or $errs++;
     diag "Got: '" . join(', ', @got) . "'\nModule contents:\n$code" if $errs;
 }
diff --git a/cpan/Module-Metadata/t/extract-version.t b/cpan/Module-Metadata/t/extract-version.t
index 278a602..16266e8 100644
--- a/cpan/Module-Metadata/t/extract-version.t
+++ b/cpan/Module-Metadata/t/extract-version.t
@@ -3,7 +3,6 @@ use warnings;
 # vim:ts=8:sw=2:et:sta:sts=2
 
 use Test::More 0.82;
-use Data::Dumper;
 use Module::Metadata;
 
 use lib 't/lib';
@@ -602,6 +601,16 @@ $Foo::Bar::VERSION = '1.23';
   vers => undef,
   all_versions => { 'Foo::Bar' => '1.23' },
 },
+{
+  name => 'package statement that does not quite match the filename',
+  filename => 'Simple.pm',
+  code => <<'---',
+package ThisIsNotSimple;
+our $VERSION = '1.23';
+---
+  vers => $undef,
+  all_versions => { 'ThisIsNotSimple' => '1.23' },
+},
 );
 
 my $test_num = 0;
@@ -639,8 +648,8 @@ foreach my $test_case (@modules) {
     # We want to ensure we preserve the original, as long as it's legal, so we
     # explicitly check the stringified form.
     {
-      local $TODO = $test_case->{TODO_got_version};
-      isa_ok($got, 'version') if defined $expected_version;
+      local $TODO = !defined($got) && ($test_case->{TODO_code_sub} || $test_case->{TODO_scalar});
+      isa_ok($got, 'version') or $errs++ if defined $expected_version;
     }
 
     if (ref($expected_version) eq 'CODE') {
@@ -669,19 +678,19 @@ foreach my $test_case (@modules) {
         ok(
           $test_case->{all_versions}->($pm_info->{versions}),
           "case '$test_case->{name}': all extracted versions passes match sub"
-        );
+        ) or $errs++;
       }
       else {
         is_deeply(
           $pm_info->{versions},
           $test_case->{all_versions},
           'correctly found all $VERSIONs',
-        );
+        ) or $errs++;
       }
     }
 
     is( $warnings, '', "case '$test_case->{name}': no warnings from parsing" ) or $errs++;
-    diag 'extracted versions: ', explain({ got => $pm_info->{versions}, module_contents => $code }) if !$ENV{PERL_CORE} && $errs;
+    diag 'parsed module: ', explain($pm_info) if !$ENV{PERL_CORE} && $errs;
   }
 }
 continue {
diff --git a/cpan/Module-Metadata/t/metadata.t b/cpan/Module-Metadata/t/metadata.t
index 068a865..8135773 100644
--- a/cpan/Module-Metadata/t/metadata.t
+++ b/cpan/Module-Metadata/t/metadata.t
@@ -10,9 +10,8 @@ use File::Temp;
 use File::Basename;
 use Cwd ();
 use File::Path;
-use Data::Dumper;
 
-plan tests => 61;
+plan tests => 70;
 
 require_ok('Module::Metadata');
 
@@ -205,12 +204,17 @@ $::VERSION = 0.01;
 
 my ( $i, $n ) = ( 1, scalar( @scripts ) );
 foreach my $script ( @scripts ) {
+  note '-------';
+  my $errs;
   my $file = File::Spec->catfile('bin', 'simple.plx');
   my ($dist_name, $dist_dir) = new_dist(files => { $file => $script } );
   my $pm_info = Module::Metadata->new_from_file( $file );
 
-  is( $pm_info->version, '0.01', "correct script version ($i of $n)" );
+  is( $pm_info->name, 'main', 'name for script is always main');
+  is( $pm_info->version, '0.01', "correct script version ($i of $n)" ) or $errs++;
   $i++;
+
+  diag 'parsed module: ', explain($pm_info) if !$ENV{PERL_CORE} && $errs;
 }
 
 {
@@ -324,6 +328,53 @@ our $VERSION = '1.23';
   is( $pm_info->version, '1.23', 'version for default package' );
 }
 
+my $tmpdir = GeneratePackage::tmpdir();
+my $undef;
+my $test_num = 0;
+use lib 't/lib';
+use GeneratePackage;
+
+{
+  # and now a real pod file
+  # (this test case is ready to be rolled into a corpus loop, later)
+  my $test_case = {
+    name => 'file only contains pod',
+    filename => 'Simple/Documentation.pod',
+    code => <<'---',
+# PODNAME: Simple::Documentation
+# ABSTRACT: My documentation
+
+=pod
+
+Hello, this is pod.
+
+=cut
+---
+    module => '', # TODO: should probably be $undef actually
+    all_versions => { },
+  };
+
+  note $test_case->{name};
+  my $code = $test_case->{code};
+  my $expected_name = $test_case->{module};
+  local $TODO = $test_case->{TODO};
+
+  my $errs;
+
+  my ($vol, $dir, $basename) = File::Spec->splitpath(File::Spec->catdir($tmpdir, "Simple${test_num}", ($test_case->{filename} || 'Simple.pm')));
+  my $pm_info = Module::Metadata->new_from_file(generate_file($dir, $basename, $code));
+
+  my $got_name = $pm_info->name;
+  is(
+    $got_name,
+    $expected_name,
+    "case '$test_case->{name}': module name matches",
+  )
+  or $errs++;
+
+  diag 'parsed module: ', explain($pm_info) if !$ENV{PERL_CORE} && $errs;
+}
+
 {
   # Make sure processing stops after __DATA__
   my $file = File::Spec->catfile('lib', 'Simple.pm');
-- 
2.6.2

@p5pRT
Copy link
Author

p5pRT commented May 16, 2016

From @jkeenan

Thanks, applied to blead in commits
0f5c582
and 8255316.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented May 16, 2016

The RT System itself - Status changed from 'new' to 'open'

@p5pRT p5pRT closed this as completed May 16, 2016
@p5pRT
Copy link
Author

p5pRT commented May 16, 2016

@jkeenan - Status changed from 'open' to 'resolved'

@p5pRT
Copy link
Author

p5pRT commented May 16, 2016

From @iabyn

On Mon, May 16, 2016 at 03​:15​:14AM -0700, James E Keenan via RT wrote​:

Thanks, applied to blead in commits
0f5c582
and 8255316.

Note that with that release, there's now noise on stderr​:

$ ./perl harness ../cpan/Module-Metadata/t/extract-package.t >/dev/null
# Got​: '_private'
# Module contents​:
# package _private;
# $​::VERSION = 0.01;
# $VERSION = '999';
# Got​: '_private'
# Module contents​:
# package _private;
# $VERSION = '999';
# $​::VERSION = 0.01;

--
Lear​: Dost thou call me fool, boy?
Fool​: All thy other titles thou hast given away; that thou wast born with.

@p5pRT
Copy link
Author

p5pRT commented May 16, 2016

From @karenetheridge

On Mon May 16 08​:25​:14 2016, davem wrote​:

On Mon, May 16, 2016 at 03​:15​:14AM -0700, James E Keenan via RT wrote​:

Thanks, applied to blead in commits
0f5c582
and 8255316.

Note that with that release, there's now noise on stderr​:

Sorry about that! I shall endeavour to fix that in the next few days (and I will also consider if I can detect this issue automatically so it doesn't happen again, if it is not too complicated).

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant