# vim:ts=8:sw=2:et:sta:sts=2
package Module::Metadata;
-# stolen from Module::Build::Version and ::Base - this is perl licensed code,
-# copyright them.
+# Adapted from Perl-licensed code originally distributed with
+# Module-Build by Ken Williams
# This module provides routines to gather information about
# perl modules (assuming this may be expanded in the distant
use strict;
use vars qw($VERSION);
-$VERSION = '0.36_04';
+$VERSION = '1.000006';
$VERSION = eval $VERSION;
use File::Spec;
use IO::File;
-use Module::Metadata::Version;
+use version 0.87;
BEGIN {
if ($INC{'Log/Contextual.pm'}) {
Log::Contextual->import('log_info');
\s* # optional whitespace
($V_NUM_REGEXP)? # optional version number
\s* # optional whitesapce
- ; # semicolon line terminator
+ [;\{] # semicolon line terminator or block start (since 5.16)
}x;
my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
return $class->_init(undef, $filename, @_);
}
+sub new_from_handle {
+ my $class = shift;
+ my $handle = shift;
+ my $filename = shift;
+ return undef unless defined($handle) && defined($filename);
+ $filename = File::Spec->rel2abs( $filename );
+
+ return $class->_init(undef, $filename, @_, handle => $handle);
+
+}
+
+
sub new_from_module {
my $class = shift;
my $module = shift;
my $compare_versions = sub {
my ($v1, $op, $v2) = @_;
- $v1 = Module::Metadata::Version->new($v1)
- unless UNIVERSAL::isa($v1,'Module::Metadata::Version');
+ $v1 = version->new($v1)
+ unless UNIVERSAL::isa($v1,'version');
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' ||
- ref $version eq 'Module::Metadata::Version' ) { # version objects
+ elsif ( ref $version eq 'version' ) { # version objects
$version = $version->is_qv ? $version->normal : $version->stringify;
}
elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
if ( $package eq $prime_package ) {
if ( exists( $prime{$package} ) ) {
- # M::B::ModuleInfo will handle this conflict
die "Unexpected conflict in '$package'; multiple versions found.\n";
} else {
$prime{$package}{file} = $mapped_filename;
my $filename = shift;
my %props = @_;
+ my $handle = delete $props{handle};
my( %valid_props, @valid_props );
@valid_props = qw( collect_pod inc );
@valid_props{@valid_props} = delete( @props{@valid_props} );
my $self = bless(\%data, $class);
- $self->_parse_file();
+ if ( $handle ) {
+ $self->_parse_fh($handle);
+ }
+ else {
+ $self->_parse_file();
+ }
unless($self->{module} and length($self->{module})) {
my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
$pn++; # everybody gets their own package
my $eval = qq{BEGIN { q# Hide from _packages_inside()
#; package Module::Metadata::_version::p$pn;
- use Module::Metadata::Version;
+ use version;
no strict;
- local $sigil$var;
- \$$var=undef;
\$vsub = sub {
+ local $sigil$var;
+ \$$var=undef;
$line;
\$$var
};
die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
if $@;
- # Activestate apparently creates custom versions like '1.23_45_01', which
- # cause M::B::Version to think it's an invalid alpha. So check for that
- # and strip them
- my $num_dots = () = $result =~ m{\.}g;
- my $num_unders = () = $result =~ m{_}g;
- if ( substr($result,0,1) ne 'v' && $num_dots < 2 && $num_unders > 1 ) {
- $result =~ s{_}{}g;
- }
+ # Upgrade it into a version object
+ my $version = eval { _dwim_version($result) };
- # Bless it into our own version class
- eval { $result = Module::Metadata::Version->new($result) };
die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
- if $@;
+ unless defined $version; # "0" is OK!
- return $result;
+ return $version;
}
}
+# Try to DWIM when things fail the lax version test in obvious ways
+{
+ my @version_prep = (
+ # Best case, it just works
+ sub { return shift },
+
+ # If we still don't have a version, try stripping any
+ # trailing junk that is prohibited by lax rules
+ sub {
+ my $v = shift;
+ $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
+ return $v;
+ },
+
+ # Activestate apparently creates custom versions like '1.23_45_01', which
+ # cause version.pm to think it's an invalid alpha. So check for that
+ # and strip them
+ sub {
+ my $v = shift;
+ my $num_dots = () = $v =~ m{(\.)}g;
+ my $num_unders = () = $v =~ m{(_)}g;
+ my $leading_v = substr($v,0,1) eq 'v';
+ if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
+ $v =~ s{_}{}g;
+ $num_unders = () = $v =~ m{(_)}g;
+ }
+ return $v;
+ },
+
+ # Worst case, try numifying it like we would have before version objects
+ sub {
+ my $v = shift;
+ no warnings 'numeric';
+ return 0 + $v;
+ },
+
+ );
+
+ sub _dwim_version {
+ my ($result) = shift;
+
+ return $result if ref($result) eq 'version';
+
+ my ($version, $error);
+ for my $f (@version_prep) {
+ $result = $f->($result);
+ $version = eval { version->new($result) };
+ $error ||= $@ if $@; # capture first failure
+ last if defined $version;
+ }
+
+ die $error unless defined $version;
+
+ return $version;
+ }
+}
############################################################
Module::Metadata - Gather package and POD information from perl module files
-=head1 DESCRIPTION
-
-=over 4
+=head1 SYNOPSIS
-=item new_from_file($filename, collect_pod => 1)
+ use Module::Metadata;
-Construct a C<ModuleInfo> 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.
+ # information about a .pm file
+ my $info = Module::Metadata->new_from_file( $file );
+ my $version = $info->version;
-=item new_from_module($module, collect_pod => 1, inc => \@dirs)
+ # information about a directory full of .pm files
+ my $provides =
+ Module::Metadata->package_versions_from_directory('lib');
-Construct a C<ModuleInfo> 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.
-
-=item name()
-
-Returns the name of the package represented by this module. If there
-are more than one packages, it makes a best guess based on the
-filename. If it's a script (i.e. not a *.pm) the package name is
-'main'.
-
-=item version($package)
-
-Returns the version as defined by the $VERSION variable for the
-package as returned by the C<name> method if no arguments are
-given. If given the name of a package it will attempt to return the
-version of that package if it is specified in the file.
+=head1 DESCRIPTION
-=item filename()
+This module provides a standard way to gather metadata about a .pm file
+without executing unsafe code.
-Returns the absolute path to the file.
+=head1 USAGE
-=item packages_inside()
+=head2 Class methods
-Returns a list of packages.
+=over 4
-=item pod_inside()
+=item C<< new_from_file($filename, collect_pod => 1) >>
-Returns a list of POD sections.
+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.
-=item contains_pod()
+=item C<< new_from_handle($handle, $filename, collect_pod => 1) >>
-Returns true if there is any POD in the file.
+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.
-=item pod($section)
+=item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >>
-Returns the POD data in the given section.
+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.
-=item find_module_by_name($module, \@dirs)
+=item C<< find_module_by_name($module, \@dirs) >>
Returns the path to a module given the module or package name. A list
of directories can be passed in as an optional parameter, otherwise
Can be called as either an object or a class method.
-=item find_module_dir_by_name($module, \@dirs)
+=item C<< find_module_dir_by_name($module, \@dirs) >>
Returns the entry in C<@dirs> (or C<@INC> by default) that contains
the module C<$module>. A list of directories can be passed in as an
Can be called as either an object or a class method.
-=item package_versions_from_directory($dir, \@files?)
+=item C<< package_versions_from_directory($dir, \@files?) >>
Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks
for those files in C<$dir> - and reads each file for packages and versions,
'OtherPackage::Name' => ...
}
-=item log_info (internal)
+=item C<< log_info (internal) >>
Used internally to perform logging; imported from Log::Contextual if
Log::Contextual has already been loaded, otherwise simply calls warn.
=back
+=head2 Object methods
+
+=over 4
+
+=item C<< name() >>
+
+Returns the name of the package represented by this module. If there
+are more than one packages, it makes a best guess based on the
+filename. If it's a script (i.e. not a *.pm) the package name is
+'main'.
+
+=item C<< version($package) >>
+
+Returns the version as defined by the $VERSION variable for the
+package as returned by the C<name> method if no arguments are
+given. If given the name of a package it will attempt to return the
+version of that package if it is specified in the file.
+
+=item C<< filename() >>
+
+Returns the absolute path to the file.
+
+=item C<< packages_inside() >>
+
+Returns a list of packages.
+
+=item C<< pod_inside() >>
+
+Returns a list of POD sections.
+
+=item C<< contains_pod() >>
+
+Returns true if there is any POD in the file.
+
+=item C<< pod($section) >>
+
+Returns the POD data in the given section.
+
+=back
+
=head1 AUTHOR
-Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
+Original code from Module::Build::ModuleInfo by Ken Williams
+<kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with
-assistance from David Golden (xdg) <dagolden@cpan.org>
+assistance from David Golden (xdg) <dagolden@cpan.org>.
=head1 COPYRIGHT
-Copyright (c) 2001-2006 Ken Williams. All rights reserved.
+Original code Copyright (c) 2001-2011 Ken Williams.
+Additional code Copyright (c) 2010-2011 Matt Trout and David Golden.
+All rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
-=head1 SEE ALSO
-
-perl(1), L<Module::Build::ModuleInfo>(3)
-
=cut
projects / p5sagit/Module-Metadata.git / blobdiff