summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Module/Metadata.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Module/Metadata.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Metadata.pm266
1 files changed, 210 insertions, 56 deletions
diff --git a/Master/tlpkg/tlperl/lib/Module/Metadata.pm b/Master/tlpkg/tlperl/lib/Module/Metadata.pm
index 9d602261d5d..e52a0e24968 100644
--- a/Master/tlpkg/tlperl/lib/Module/Metadata.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Metadata.pm
@@ -11,9 +11,10 @@ package Module::Metadata;
use strict;
use vars qw($VERSION);
-$VERSION = '1.000004';
+$VERSION = '1.000009';
$VERSION = eval $VERSION;
+use Carp qw/croak/;
use File::Spec;
use IO::File;
use version 0.87;
@@ -36,7 +37,7 @@ my $PKG_REGEXP = qr{ # match a package declaration
\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
@@ -69,6 +70,18 @@ sub new_from_file {
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;
@@ -148,6 +161,44 @@ sub new_from_module {
return \%result;
};
+ sub provides {
+ my $class = shift;
+
+ croak "provides() requires key/value pairs \n" if @_ % 2;
+ my %args = @_;
+
+ croak "provides() takes only one of 'dir' or 'files'\n"
+ if $args{dir} && $args{files};
+
+ croak "provides() requires a 'version' argument"
+ unless defined $args{version};
+
+ croak "provides() does not support version '$args{version}' metadata"
+ unless grep { $args{version} eq $_ } qw/1.4 2/;
+
+ $args{prefix} = 'lib' unless defined $args{prefix};
+
+ my $p;
+ if ( $args{dir} ) {
+ $p = $class->package_versions_from_directory($args{dir});
+ }
+ else {
+ croak "provides() requires 'files' to be an array reference\n"
+ unless ref $args{files} eq 'ARRAY';
+ $p = $class->package_versions_from_directory($args{files});
+ }
+
+ # Now, fix up files with prefix
+ if ( length $args{prefix} ) { # check in case disabled with q{}
+ $args{prefix} =~ s{/$}{};
+ for my $v ( values %$p ) {
+ $v->{file} = "$args{prefix}/$v->{file}";
+ }
+ }
+
+ return $p
+ }
+
sub package_versions_from_directory {
my ( $class, $dir, $files ) = @_;
@@ -183,8 +234,7 @@ sub new_from_module {
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";
+ croak "Unexpected conflict in '$package'; multiple versions found.\n";
} else {
$prime{$package}{file} = $mapped_filename;
$prime{$package}{version} = $version if defined( $version );
@@ -282,6 +332,7 @@ sub _init {
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} );
@@ -302,7 +353,12 @@ sub _init {
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});
@@ -330,7 +386,7 @@ sub _init {
# class method
sub _do_find_module {
my $class = shift;
- my $module = shift || die 'find_module_by_name() requires a package name';
+ my $module = shift || croak 'find_module_by_name() requires a package name';
my $dirs = shift || \@INC;
my $file = File::Spec->catfile(split( /::/, $module));
@@ -380,7 +436,7 @@ sub _parse_file {
my $filename = $self->{filename};
my $fh = IO::File->new( $filename )
- or die( "Can't open '$filename': $!" );
+ or croak( "Can't open '$filename': $!" );
$self->_parse_fh($fh);
}
@@ -517,9 +573,9 @@ sub _evaluate_version_line {
use version;
no strict;
- local $sigil$var;
- \$$var=undef;
\$vsub = sub {
+ local $sigil$var;
+ \$$var=undef;
$line;
\$$var
};
@@ -537,15 +593,15 @@ sub _evaluate_version_line {
warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
if $@;
(ref($vsub) eq 'CODE') or
- die "failed to build version sub for $self->{filename}";
+ croak "failed to build version sub for $self->{filename}";
my $result = eval { $vsub->() };
- die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
+ croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
if $@;
# Upgrade it into a version object
my $version = eval { _dwim_version($result) };
- die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
+ croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
unless defined $version; # "0" is OK!
return $version;
@@ -603,7 +659,7 @@ sub _evaluate_version_line {
last if defined $version;
}
- die $error unless defined $version;
+ croak $error unless defined $version;
return $version;
}
@@ -648,76 +704,120 @@ sub pod {
Module::Metadata - Gather package and POD information from perl module files
+=head1 SYNOPSIS
+
+ use Module::Metadata;
+
+ # information about a .pm file
+ my $info = Module::Metadata->new_from_file( $file );
+ my $version = $info->version;
+
+ # CPAN META 'provides' field for .pm files in a directory
+ my $provides = Module::Metadata->provides(
+ dir => 'lib', version => 2
+ );
+
=head1 DESCRIPTION
+This module provides a standard way to gather metadata about a .pm file
+without executing unsafe code.
+
+=head1 USAGE
+
+=head2 Class methods
+
=over 4
-=item new_from_file($filename, collect_pod => 1)
+=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.
-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.
+=item C<< new_from_handle($handle, $filename, collect_pod => 1) >>
-=item new_from_module($module, collect_pod => 1, inc => \@dirs)
+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.
-Construct a C<ModuleInfo> object given a module or package name. In addition
+=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.
+default is @INC. Returns undef if the module cannot be found.
-=item name()
+=item C<< find_module_by_name($module, \@dirs) >>
-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'.
+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
+@INC is searched.
-=item version($package)
+Can be called as either an object or a class method.
-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<< find_module_dir_by_name($module, \@dirs) >>
-=item filename()
+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
+optional parameter, otherwise @INC is searched.
-Returns the absolute path to the file.
+Can be called as either an object or a class method.
-=item packages_inside()
+=item C<< provides( %options ) >>
-Returns a list of packages.
+This is a convenience wrapper around C<package_versions_from_directory>
+to generate a CPAN META C<provides> data structure. It takes key/value
+pairs. Valid option keys include:
-=item pod_inside()
+=over
-Returns a list of POD sections.
+=item version B<(required)>
-=item contains_pod()
+Specifies which version of the L<CPAN::Meta::Spec> should be used as
+the format of the C<provides> output. Currently only '1.4' and '2'
+are supported (and their format is identical). This may change in
+the future as the definition of C<provides> changes.
-Returns true if there is any POD in the file.
+The C<version> option is required. If it is omitted or if
+an unsupported version is given, then C<provides> will throw an error.
-=item pod($section)
+=item dir
-Returns the POD data in the given section.
+Directory to search recursively for F<.pm> files. May not be specified with
+C<files>.
-=item find_module_by_name($module, \@dirs)
+=item files
-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
-@INC is searched.
+Array reference of files to examine. May not be specified with C<dir>.
-Can be called as either an object or a class method.
+=item prefix
-=item find_module_dir_by_name($module, \@dirs)
+String to prepend to the C<file> field of the resulting output. This defaults
+to F<lib>, which is the common case for most CPAN distributions with their
+F<.pm> files in F<lib>. This option ensures the META information has the
+correct relative path even when the C<dir> or C<files> arguments are
+absolute or have relative paths from a location other than the distribution
+root.
-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
-optional parameter, otherwise @INC is searched.
+=back
-Can be called as either an object or a class method.
+For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value
+is a hashref of the form:
+
+ {
+ 'Package::Name' => {
+ version => '0.123',
+ file => 'lib/Package/Name.pm'
+ },
+ 'OtherPackage::Name' => ...
+ }
-=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,
@@ -731,23 +831,77 @@ returning a hashref of the form:
'OtherPackage::Name' => ...
}
-=item log_info (internal)
+The C<DB> and C<main> packages are always omitted, as are any "private"
+packages that have leading underscores in the namespace (e.g.
+C<Foo::_private>)
+
+Note that the file path is relative to C<$dir> if that is specified.
+This B<must not> be used directly for CPAN META C<provides>. See
+the C<provides> method instead.
+
+=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. Note: this is a raw list of packages
+discovered (or assumed, in the case of C<main>). It is not
+filtered for C<DB>, C<main> or private packages the way the
+C<provides> method does.
+
+=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-2011 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.