# parrot future to look at other types of modules).
use strict;
-use vars qw($VERSION);
-$VERSION = '1.000009';
+use vars qw($VERSION $V_CLASS);
+$VERSION = '1.000010';
$VERSION = eval $VERSION;
use Carp qw/croak/;
use File::Spec;
use IO::File;
-use version 0.87;
+use version;
+BEGIN {
+ $V_CLASS = 'version';
+ unless (eval { version->VERSION(0.87) }) {
+ require version::fallback;
+ version::fallback->VERSION(0.87);
+ version::fallback->import;
+ $V_CLASS = 'version::fallback';
+ }
+}
BEGIN {
if ($INC{'Log/Contextual.pm'}) {
Log::Contextual->import('log_info');
=[^=~] # = but not ==, nor =~
}x;
+my $PODSECT_REGEXP = qr{
+ ^=(cut|pod|head[1-4]|over|item|back|begin|end|for|encoding)\b
+}x;
sub new_from_file {
my $class = shift;
my $compare_versions = sub {
my ($v1, $op, $v2) = @_;
- $v1 = version->new($v1)
- unless UNIVERSAL::isa($v1,'version');
+ $v1 = $V_CLASS->new($v1)
+ unless UNIVERSAL::isa($v1,$V_CLASS);
my $eval_str = "\$v1 $op \$v2";
my $result = eval $eval_str;
if ( $version =~ /[=<>!,]/ ) { # logic, not just version
# take as is without modification
}
- elsif ( ref $version eq 'version' ) { # version objects
+ elsif ( ref $version eq $V_CLASS ) { # version objects
$version = $version->is_qv ? $version->normal : $version->stringify;
}
elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
# 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$//;
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 );
}
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;
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) = @_;
my $line_num = $.;
chomp( $line );
- next if $line =~ /^\s*#/;
my $is_cut;
- if ( $line =~ /^=(.{0,3})/ ) {
+ if ( $line =~ /$PODSECT_REGEXP/o ) {
$is_cut = $1 eq 'cut';
$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;
}
$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*#/;
# 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
$pn++; # everybody gets their own package
my $eval = qq{BEGIN { q# Hide from _packages_inside()
#; package Module::Metadata::_version::p$pn;
- use version;
+ use $V_CLASS;
no strict;
\$vsub = sub {
sub _dwim_version {
my ($result) = shift;
- return $result if ref($result) eq 'version';
+ return $result if ref($result) eq $V_CLASS;
my ($version, $error);
for my $f (@version_prep) {
$result = $f->($result);
- $version = eval { version->new($result) };
+ $version = eval { $V_CLASS->new($result) };
$error ||= $@ if $@; # capture first failure
last if defined $version;
}
=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) >>
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.