},
'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),
# -*- 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
use strict;
use warnings;
-our $VERSION = '1.000031'; # TRIAL
+our $VERSION = '1.000032'; # TRIAL
use Carp qw/croak/;
use File::Spec;
}
$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] || '';
+ }
}
}
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;
$self->{pod_headings} = \@pod;
}
+sub __uniq (@)
+{
+ my (%seen, $key);
+ grep { not $seen{ $key = $_ }++ } @_;
+}
+
{
my $pn = 0;
sub _evaluate_version_line {
=head1 VERSION
-version 1.000031
+version 1.000032
=head1 SYNOPSIS
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
$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;
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 @_ };
# 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;
}
# vim:ts=8:sw=2:et:sta:sts=2
use Test::More 0.82;
-use Data::Dumper;
use Module::Metadata;
use lib 't/lib';
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;
# 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') {
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 {
use File::Basename;
use Cwd ();
use File::Path;
-use Data::Dumper;
-plan tests => 61;
+plan tests => 70;
require_ok('Module::Metadata');
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;
}
{
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');
https://perl5.git.perl.org / perl5.git / commitdiff