summaryrefslogtreecommitdiffstats
path: root/gnu/usr.bin/perl/cpan/Module-Metadata
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/usr.bin/perl/cpan/Module-Metadata')
-rw-r--r--gnu/usr.bin/perl/cpan/Module-Metadata/lib/Module/Metadata.pm153
-rw-r--r--gnu/usr.bin/perl/cpan/Module-Metadata/t/encoding.t30
-rw-r--r--gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16BE.pmbin0 -> 238 bytes
-rw-r--r--gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16LE.pmbin0 -> 238 bytes
-rw-r--r--gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF8.pm13
-rw-r--r--gnu/usr.bin/perl/cpan/Module-Metadata/t/metadata.t104
6 files changed, 247 insertions, 53 deletions
diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/lib/Module/Metadata.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/lib/Module/Metadata.pm
index e52a0e24968..e3c25049460 100644
--- a/gnu/usr.bin/perl/cpan/Module-Metadata/lib/Module/Metadata.pm
+++ b/gnu/usr.bin/perl/cpan/Module-Metadata/lib/Module/Metadata.pm
@@ -11,7 +11,7 @@ package Module::Metadata;
use strict;
use vars qw($VERSION);
-$VERSION = '1.000009';
+$VERSION = '1.000011';
$VERSION = eval $VERSION;
use Carp qw/croak/;
@@ -61,7 +61,6 @@ my $VERS_REGEXP = qr{ # match a VERSION definition
=[^=~] # = but not ==, nor =~
}x;
-
sub new_from_file {
my $class = shift;
my $filename = File::Spec->rel2abs( shift );
@@ -219,7 +218,7 @@ sub new_from_module {
# separating into primary & alternative candidates
my( %prime, %alt );
foreach my $file (@files) {
- my $mapped_filename = File::Spec->abs2rel( $file, $dir );
+ my $mapped_filename = File::Spec::Unix->abs2rel( $file, $dir );
my @path = split( /\//, $mapped_filename );
(my $prime_package = join( '::', @path )) =~ s/\.pm$//;
@@ -232,10 +231,12 @@ sub new_from_module {
my $version = $pm_info->version( $package );
+ $prime_package = $package if lc($prime_package) eq lc($package);
if ( $package eq $prime_package ) {
if ( exists( $prime{$package} ) ) {
croak "Unexpected conflict in '$package'; multiple versions found.\n";
} else {
+ $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename);
$prime{$package}{file} = $mapped_filename;
$prime{$package}{version} = $version if defined( $version );
}
@@ -420,7 +421,7 @@ sub _parse_version_expression {
my $line = shift;
my( $sig, $var, $pkg );
- if ( $line =~ $VERS_REGEXP ) {
+ if ( $line =~ /$VERS_REGEXP/o ) {
( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
if ( $pkg ) {
$pkg = ($pkg eq '::') ? 'main' : $pkg;
@@ -438,9 +439,49 @@ sub _parse_file {
my $fh = IO::File->new( $filename )
or croak( "Can't open '$filename': $!" );
+ $self->_handle_bom($fh, $filename);
+
$self->_parse_fh($fh);
}
+# Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream.
+# If there's one, then skip it and set the :encoding layer appropriately.
+sub _handle_bom {
+ my ($self, $fh, $filename) = @_;
+
+ my $pos = $fh->getpos;
+ return unless defined $pos;
+
+ my $buf = ' ' x 2;
+ my $count = $fh->read( $buf, length $buf );
+ return unless defined $count and $count >= 2;
+
+ my $encoding;
+ if ( $buf eq "\x{FE}\x{FF}" ) {
+ $encoding = 'UTF-16BE';
+ } elsif ( $buf eq "\x{FF}\x{FE}" ) {
+ $encoding = 'UTF-16LE';
+ } elsif ( $buf eq "\x{EF}\x{BB}" ) {
+ $buf = ' ';
+ $count = $fh->read( $buf, length $buf );
+ if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) {
+ $encoding = 'UTF-8';
+ }
+ }
+
+ if ( defined $encoding ) {
+ if ( "$]" >= 5.008 ) {
+ # $fh->binmode requires perl 5.10
+ binmode( $fh, ":encoding($encoding)" );
+ }
+ } else {
+ $fh->setpos($pos)
+ or croak( sprintf "Can't reset position to the top of '$filename'" );
+ }
+
+ return $encoding;
+}
+
sub _parse_fh {
my ($self, $fh) = @_;
@@ -454,16 +495,21 @@ sub _parse_fh {
my $line_num = $.;
chomp( $line );
- next if $line =~ /^\s*#/;
- $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
-
- # Would be nice if we could also check $in_string or something too
- last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
+ # From toke.c : any line that begins by "=X", where X is an alphabetic
+ # character, introduces a POD segment.
+ my $is_cut;
+ if ( $line =~ /^=([a-zA-Z].*)/ ) {
+ my $cmd = $1;
+ # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic
+ # character (which includes the newline, but here we chomped it away).
+ $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/;
+ $in_pod = !$is_cut;
+ }
- if ( $in_pod || $line =~ /^=cut/ ) {
+ if ( $in_pod ) {
- if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
+ if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) {
push( @pod, $1 );
if ( $self->{collect_pod} && length( $pod_data ) ) {
$pod{$pod_sect} = $pod_data;
@@ -471,25 +517,37 @@ sub _parse_fh {
}
$pod_sect = $1;
-
} elsif ( $self->{collect_pod} ) {
$pod_data .= "$line\n";
}
- } else {
+ } elsif ( $is_cut ) {
+ if ( $self->{collect_pod} && length( $pod_data ) ) {
+ $pod{$pod_sect} = $pod_data;
+ $pod_data = '';
+ }
$pod_sect = '';
- $pod_data = '';
+
+ } else {
+
+ # Skip comments in code
+ next if $line =~ /^\s*#/;
+
+ # Would be nice if we could also check $in_string or something too
+ last if $line =~ /^__(?:DATA|END)__$/;
# parse $line to see if it's a $VERSION declaration
my( $vers_sig, $vers_fullname, $vers_pkg ) =
- $self->_parse_version_expression( $line );
+ ($line =~ /VERSION/)
+ ? $self->_parse_version_expression( $line )
+ : ();
- if ( $line =~ $PKG_REGEXP ) {
+ if ( $line =~ /$PKG_REGEXP/o ) {
$pkg = $1;
push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
- $vers{$pkg} = (defined $2 ? $2 : undef) unless exists( $vers{$pkg} );
+ $vers{$pkg} = $2 unless exists( $vers{$pkg} );
$need_vers = defined $2 ? 0 : 1;
# VERSION defined with full package spec, i.e. $Module::VERSION
@@ -500,14 +558,6 @@ sub _parse_fh {
unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
$vers{$vers_pkg} =
$self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
- } else {
- # Warn unless the user is using the "$VERSION = eval
- # $VERSION" idiom (though there are probably other idioms
- # that we should watch out for...)
- warn <<"EOM" unless $line =~ /=\s*eval/;
-Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
-ignoring subsequent declaration on line $line_num.
-EOM
}
# first non-comment line in undeclared package main is VERSION
@@ -533,12 +583,7 @@ EOM
unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
$vers{$pkg} = $v;
- } else {
- warn <<"EOM";
-Package '$pkg' already declared with version '$vers{$pkg}'
-ignoring new version '$v' on line $line_num.
-EOM
- }
+ }
}
@@ -730,27 +775,43 @@ without executing unsafe code.
=item C<< new_from_file($filename, collect_pod => 1) >>
-Construct a C<Module::Metadata> object given the path to a file. Takes an
-optional argument C<collect_pod> which is a boolean that determines whether POD
-data is collected and stored for reference. POD data is not collected by
-default. POD headings are always collected. Returns undef if the filename
-does not exist.
+Constructs a C<Module::Metadata> object given the path to a file. Returns
+undef if the filename does not exist.
+
+C<collect_pod> is a optional boolean argument that determines whether POD
+data is collected and stored for reference. POD data is not collected by
+default. POD headings are always collected.
+
+If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then
+it is skipped before processing, and the content of the file is also decoded
+appropriately starting from perl 5.8.
=item C<< new_from_handle($handle, $filename, collect_pod => 1) >>
This works just like C<new_from_file>, except that a handle can be provided
-as the first argument. Note that there is no validation to confirm that the
-handle is a handle or something that can act like one. Passing something that
-isn't a handle will cause a exception when trying to read from it. The
-C<filename> argument is mandatory or undef will be returned.
+as the first argument.
+
+Note that there is no validation to confirm that the handle is a handle or
+something that can act like one. Passing something that isn't a handle will
+cause a exception when trying to read from it. The C<filename> argument is
+mandatory or undef will be returned.
+
+You are responsible for setting the decoding layers on C<$handle> if
+required.
=item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >>
-Construct a C<Module::Metadata> object given a module or package name. In addition
-to accepting the C<collect_pod> argument as described above, this
-method accepts a C<inc> argument which is a reference to an array of
-of directories to search for the module. If none are given, the
-default is @INC. Returns undef if the module cannot be found.
+Constructs a C<Module::Metadata> object given a module or package name.
+Returns undef if the module cannot be found.
+
+In addition to accepting the C<collect_pod> argument as described above,
+this method accepts a C<inc> argument which is a reference to an array of
+directories to search for the module. If none are given, the default is
+@INC.
+
+If the file that contains the module begins by an UTF-8, UTF-16BE or
+UTF-16LE byte-order mark, then it is skipped before processing, and the
+content of the file is also decoded appropriately starting from perl 5.8.
=item C<< find_module_by_name($module, \@dirs) >>
@@ -897,7 +958,7 @@ Original code from Module::Build::ModuleInfo by Ken Williams
Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with
assistance from David Golden (xdg) <dagolden@cpan.org>.
-=head1 COPYRIGHT
+=head1 COPYRIGHT & LICENSE
Original code Copyright (c) 2001-2011 Ken Williams.
Additional code Copyright (c) 2010-2011 Matt Trout and David Golden.
diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/encoding.t b/gnu/usr.bin/perl/cpan/Module-Metadata/t/encoding.t
new file mode 100644
index 00000000000..a0970e051ce
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/encoding.t
@@ -0,0 +1,30 @@
+#!perl
+
+use strict;
+use File::Spec;
+use Test::More;
+
+use Module::Metadata;
+
+if ("$]" < 5.008_003) {
+ plan skip_all => 'Encoding test needs at least perl 5.8.3';
+}
+
+my %versions = (
+ UTF8 => 3,
+ UTF16BE => 4,
+ UTF16LE => 5,
+);
+
+plan tests => 4 * scalar(keys %versions);
+
+for my $enc (sort keys %versions) {
+ my $pkg = "BOMTest::$enc";
+ my $vers = $versions{$enc};
+ my $pm = File::Spec->catfile(qw<t lib BOMTest> => "$enc.pm");
+ my $info = Module::Metadata->new_from_file($pm);
+ is( $info->name, $pkg, "$enc: default package was found" );
+ is( $info->version, $vers, "$enc: version for default package" );
+ is( $info->version('Heart'), '1', 'version for ASCII package' );
+ is( $info->version("C\x{153}ur"), '2', 'version for Unicode package' );
+}
diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16BE.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16BE.pm
new file mode 100644
index 00000000000..17c6a4ad655
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16BE.pm
Binary files differ
diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16LE.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16LE.pm
new file mode 100644
index 00000000000..a46de6de4e8
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16LE.pm
Binary files differ
diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF8.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF8.pm
new file mode 100644
index 00000000000..9062ac60753
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF8.pm
@@ -0,0 +1,13 @@
+package Heart;
+
+our $VERSION = 1;
+
+package BOMTest::UTF8;
+
+our $VERSION = 3;
+
+package Cœur;
+
+our $VERSION = 2;
+
+1;
diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/metadata.t b/gnu/usr.bin/perl/cpan/Module-Metadata/t/metadata.t
index ab9c8c4127e..b7adb1ec4bd 100644
--- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/metadata.t
+++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/metadata.t
@@ -28,6 +28,15 @@ package Simple;
our $VERSION;
$VERSION = '1.23';
---
+ '1.23' => <<'---', # commented & defined on same line
+package Simple;
+our $VERSION = '1.23'; # our $VERSION = '4.56';
+---
+ '1.23' => <<'---', # commented & defined on separate lines
+package Simple;
+# our $VERSION = '4.56';
+our $VERSION = '1.23';
+---
'1.23' => <<'---', # use vars
package Simple;
use vars qw( $VERSION );
@@ -203,7 +212,7 @@ package Simple v1.2.3_4 {
);
my %modules = reverse @modules;
-plan tests => 42 + 2 * keys( %modules );
+plan tests => 54 + 2 * keys( %modules );
require_ok('Module::Metadata');
@@ -246,7 +255,7 @@ $pm_info = Module::Metadata->new_from_handle( $handle, $file );
ok( defined( $pm_info ), 'new_from_handle() succeeds' );
$pm_info = Module::Metadata->new_from_handle( $handle );
is( $pm_info, undef, "new_from_handle() without filename returns undef" );
-
+close($handle);
# construct from module name, using custom include path
$pm_info = Module::Metadata->new_from_module(
@@ -420,6 +429,9 @@ Simple - It's easy.
Simple Simon
+You can find me on the IRC channel
+#simon on irc.perl.org.
+
=cut
---
$dist->regen;
@@ -459,13 +471,59 @@ is( $pm_info->pod('NAME'), undef,
$pm_info = Module::Metadata->new_from_module(
$dist->name, inc => [ 'lib', @INC ], collect_pod => 1 );
-my $name = $pm_info->pod('NAME');
-if ( $name ) {
- $name =~ s/^\s+//;
- $name =~ s/\s+$//;
+{
+ my %pod;
+ for my $section (qw(NAME AUTHOR)) {
+ my $content = $pm_info->pod( $section );
+ if ( $content ) {
+ $content =~ s/^\s+//;
+ $content =~ s/\s+$//;
+ }
+ $pod{$section} = $content;
+ }
+ my %expected = (
+ NAME => q|Simple - It's easy.|,
+ AUTHOR => <<'EXPECTED'
+Simple Simon
+
+You can find me on the IRC channel
+#simon on irc.perl.org.
+EXPECTED
+ );
+ for my $text (values %expected) {
+ $text =~ s/^\s+//;
+ $text =~ s/\s+$//;
+ }
+ is( $pod{NAME}, $expected{NAME}, 'collected NAME pod section' );
+ is( $pod{AUTHOR}, $expected{AUTHOR}, 'collected AUTHOR pod section' );
}
-is( $name, q|Simple - It's easy.|, 'collected pod section' );
+{
+ # test things that look like POD, but aren't
+$dist->change_file( 'lib/Simple.pm', <<'---' );
+package Simple;
+
+=YES THIS STARTS POD
+
+our $VERSION = '999';
+
+=cute
+
+our $VERSION = '666';
+
+=cut
+
+*foo
+=*no_this_does_not_start_pod;
+
+our $VERSION = '1.23';
+
+---
+ $dist->regen;
+ $pm_info = Module::Metadata->new_from_file('lib/Simple.pm');
+ is( $pm_info->name, 'Simple', 'found default package' );
+ is( $pm_info->version, '1.23', 'version for default package' );
+}
{
# Make sure processing stops after __DATA__
@@ -582,3 +640,35 @@ is_deeply( $got_pvfd, $exp_pvfd, "package_version_from_directory()" )
is_deeply( $got_provides, $exp_provides, "provides()" )
or diag explain $got_provides;
}
+
+# Check package_versions_from_directory with regard to case-sensitivity
+{
+ $dist->change_file( 'lib/Simple.pm', <<'---' );
+package simple;
+$VERSION = '0.01';
+---
+ $dist->regen;
+
+ $pm_info = Module::Metadata->new_from_file('lib/Simple.pm');
+ is( $pm_info->name, undef, 'no default package' );
+ is( $pm_info->version, undef, 'version for default package' );
+ is( $pm_info->version('simple'), '0.01', 'version for lower-case package' );
+ is( $pm_info->version('Simple'), undef, 'version for capitalized package' );
+
+ $dist->change_file( 'lib/Simple.pm', <<'---' );
+package simple;
+$VERSION = '0.01';
+package Simple;
+$VERSION = '0.02';
+package SiMpLe;
+$VERSION = '0.03';
+---
+ $dist->regen;
+
+ $pm_info = Module::Metadata->new_from_file('lib/Simple.pm');
+ is( $pm_info->name, 'Simple', 'found default package' );
+ is( $pm_info->version, '0.02', 'version for default package' );
+ is( $pm_info->version('simple'), '0.01', 'version for lower-case package' );
+ is( $pm_info->version('Simple'), '0.02', 'version for capitalized package' );
+ is( $pm_info->version('SiMpLe'), '0.03', 'version for mixed-case package' );
+}
Copyright © 1996 – 2023 Jason A. Donenfeld. All Rights Reverse Engineered.