From 61bfcae1742705b6c456ff1777236282ff285652 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Sun, 19 Aug 2012 11:31:51 +0100 Subject: [PATCH] Upgrade Module-Metadata to 1.000011 --- MANIFEST | 4 + Porting/Maintainers.pl | 2 +- cpan/Module-Metadata/lib/Module/Metadata.pm | 139 ++++++++++++++++++-------- cpan/Module-Metadata/t/encoding.t | 30 ++++++ cpan/Module-Metadata/t/lib/BOMTest/UTF16BE.pm | Bin 0 -> 238 bytes cpan/Module-Metadata/t/lib/BOMTest/UTF16LE.pm | Bin 0 -> 238 bytes cpan/Module-Metadata/t/lib/BOMTest/UTF8.pm | 13 +++ cpan/Module-Metadata/t/metadata.t | 70 +++++++++++-- pod/perldelta.pod | 5 +- 9 files changed, 211 insertions(+), 52 deletions(-) create mode 100644 cpan/Module-Metadata/t/encoding.t create mode 100644 cpan/Module-Metadata/t/lib/BOMTest/UTF16BE.pm create mode 100644 cpan/Module-Metadata/t/lib/BOMTest/UTF16LE.pm create mode 100644 cpan/Module-Metadata/t/lib/BOMTest/UTF8.pm diff --git a/MANIFEST b/MANIFEST index 25f2546..ed489cc 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1772,8 +1772,12 @@ cpan/Module-Load/t/to_load/Must/Be/Loaded.pm Module::Load tests cpan/Module-Load/t/to_load/TestModule.pm Module::Load tests cpan/Module-Load/t/to_load/ToBeLoaded Module::Load tests cpan/Module-Metadata/lib/Module/Metadata.pm +cpan/Module-Metadata/t/encoding.t cpan/Module-Metadata/t/lib/0_1/Foo.pm cpan/Module-Metadata/t/lib/0_2/Foo.pm +cpan/Module-Metadata/t/lib/BOMTest/UTF16BE.pm +cpan/Module-Metadata/t/lib/BOMTest/UTF16LE.pm +cpan/Module-Metadata/t/lib/BOMTest/UTF8.pm cpan/Module-Metadata/t/lib/DistGen.pm cpan/Module-Metadata/t/lib/MBTest.pm cpan/Module-Metadata/t/lib/Tie/CPHash.pm diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 4e6283c..ae977fe 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1289,7 +1289,7 @@ use File::Glob qw(:case); 'Module::Metadata' => { 'MAINTAINER' => 'dagolden', - 'DISTRIBUTION' => 'VPIT/Module-Metadata-1.000010.tar.gz', + 'DISTRIBUTION' => 'APEIRON/Module-Metadata-1.000011.tar.gz', 'FILES' => q[cpan/Module-Metadata], 'EXCLUDED' => [ qr{^maint}, diff --git a/cpan/Module-Metadata/lib/Module/Metadata.pm b/cpan/Module-Metadata/lib/Module/Metadata.pm index ce21787..e3c2504 100644 --- a/cpan/Module-Metadata/lib/Module/Metadata.pm +++ b/cpan/Module-Metadata/lib/Module/Metadata.pm @@ -11,7 +11,7 @@ package Module::Metadata; use strict; use vars qw($VERSION); -$VERSION = '1.000010'; +$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 ); @@ -440,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) = @_; @@ -456,20 +495,21 @@ sub _parse_fh { my $line_num = $.; chomp( $line ); - next if $line =~ /^\s*#/; + # From toke.c : any line that begins by "=X", where X is an alphabetic + # character, introduces a POD segment. my $is_cut; - if ( $line =~ /^=(.{0,3})/ ) { - $is_cut = $1 eq '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; } - # Would be nice if we could also check $in_string or something too - last if !$in_pod && $line =~ /^__(?:DATA|END)__$/; - - if ( $in_pod || $is_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; @@ -477,16 +517,26 @@ 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 ) = @@ -497,7 +547,7 @@ sub _parse_fh { 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 @@ -508,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 @@ -541,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 - } + } } @@ -738,27 +775,43 @@ without executing unsafe code. =item C<< new_from_file($filename, collect_pod => 1) >> -Construct a C object given the path to a file. Takes an -optional argument C 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 object given the path to a file. Returns +undef if the filename does not exist. + +C 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, 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 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 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 object given a module or package name. In addition -to accepting the C argument as described above, this -method accepts a C 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 object given a module or package name. +Returns undef if the module cannot be found. + +In addition to accepting the C argument as described above, +this method accepts a C 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) >> @@ -905,7 +958,7 @@ Original code from Module::Build::ModuleInfo by Ken Williams Released as Module::Metadata by Matt S Trout (mst) with assistance from David Golden (xdg) . -=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/cpan/Module-Metadata/t/encoding.t b/cpan/Module-Metadata/t/encoding.t new file mode 100644 index 0000000..a0970e0 --- /dev/null +++ b/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 => "$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/cpan/Module-Metadata/t/lib/BOMTest/UTF16BE.pm b/cpan/Module-Metadata/t/lib/BOMTest/UTF16BE.pm new file mode 100644 index 0000000000000000000000000000000000000000..17c6a4ad6555c18a6c3f0d6f18d7a2ebb0838609 GIT binary patch literal 238 zcmezOpP_&uks+BO8%U-zq%tTlcmT;nh9ZU%25SZ`Ak1ed1@aUaR2ae-Tp5BGf*Cv+ z{2Ba!BDO$m2vvn{iW5+cFGC2>tYV-^RzMgE6%^}8Y6C7qcGX{g*M2s0m JP&2^p1OUt=BB1~P literal 0 HcmV?d00001 diff --git a/cpan/Module-Metadata/t/lib/BOMTest/UTF16LE.pm b/cpan/Module-Metadata/t/lib/BOMTest/UTF16LE.pm new file mode 100644 index 0000000000000000000000000000000000000000..a46de6de4e8bda2a8ca00bb952ed9349af34edf9 GIT binary patch literal 238 zcmezWuYe(uA( <<'---', # 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 => 51 + 2 * keys( %modules ); +plan tests => 54 + 2 * keys( %modules ); require_ok('Module::Metadata'); @@ -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__ diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 101b602..4854d0e 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -201,9 +201,10 @@ Various enhancements include the new use of Module::Metadata. =item * -L has been upgraded from version 1.000009 to 1.000010. The +L has been upgraded from version 1.000009 to 1.000011. The creation of a Module::Metadata object for a typical module file has been sped -up by about 40%. +up by about 40%, and some spurious warnings about C<$VERSION>s have been +suppressed. =item * -- 2.7.4