# parrot future to look at other types of modules).
use strict;
-use vars qw($VERSION);
-$VERSION = '1.000013';
+use warnings;
+
+our $VERSION = '1.000019';
$VERSION = eval $VERSION;
use Carp qw/croak/;
$VARNAME_REGEXP # without parens
)
\s*
- =[^=~] # = but not ==, nor =~
+ =[^=~>] # = but not ==, nor =~, nor =>
}x;
sub new_from_file {
my $err = '';
foreach my $p ( @$packages ) {
if ( defined( $p->{version} ) ) {
- if ( defined( $version ) ) {
- if ( $compare_versions->( $version, '!=', $p->{version} ) ) {
- $err .= " $p->{file} ($p->{version})\n";
- } else {
- # same version declared multiple times, ignore
- }
- } else {
- $file = $p->{file};
- $version = $p->{version};
- }
+ if ( defined( $version ) ) {
+ if ( $compare_versions->( $version, '!=', $p->{version} ) ) {
+ $err .= " $p->{file} ($p->{version})\n";
+ } else {
+ # same version declared multiple times, ignore
+ }
+ } else {
+ $file = $p->{file};
+ $version = $p->{version};
+ }
}
- $file ||= $p->{file} if defined( $p->{file} );
- }
+ $file ||= $p->{file} if defined( $p->{file} );
+ }
if ( $err ) {
$err = " $file ($version)\n" . $err;
if ( exists( $prime{$package} ) ) { # primary package selected
if ( $result->{err} ) {
- # Use the selected primary package, but there are conflicting
- # errors among multiple alternative packages that need to be
- # reported
+ # Use the selected primary package, but there are conflicting
+ # errors among multiple alternative packages that need to be
+ # reported
log_info {
- "Found conflicting versions for package '$package'\n" .
- " $prime{$package}{file} ($prime{$package}{version})\n" .
- $result->{err}
+ "Found conflicting versions for package '$package'\n" .
+ " $prime{$package}{file} ($prime{$package}{version})\n" .
+ $result->{err}
};
} elsif ( defined( $result->{version} ) ) {
- # There is a primary package selected, and exactly one
- # alternative package
-
- if ( exists( $prime{$package}{version} ) &&
- defined( $prime{$package}{version} ) ) {
- # Unless the version of the primary package agrees with the
- # version of the alternative package, report a conflict
- if ( $compare_versions->(
+ # There is a primary package selected, and exactly one
+ # alternative package
+
+ if ( exists( $prime{$package}{version} ) &&
+ defined( $prime{$package}{version} ) ) {
+ # Unless the version of the primary package agrees with the
+ # version of the alternative package, report a conflict
+ if ( $compare_versions->(
$prime{$package}{version}, '!=', $result->{version}
)
) {
log_info {
"Found conflicting versions for package '$package'\n" .
- " $prime{$package}{file} ($prime{$package}{version})\n" .
- " $result->{file} ($result->{version})\n"
+ " $prime{$package}{file} ($prime{$package}{version})\n" .
+ " $result->{file} ($result->{version})\n"
};
- }
+ }
- } else {
- # The prime package selected has no version so, we choose to
- # use any alternative package that does have a version
- $prime{$package}{file} = $result->{file};
- $prime{$package}{version} = $result->{version};
- }
+ } else {
+ # The prime package selected has no version so, we choose to
+ # use any alternative package that does have a version
+ $prime{$package}{file} = $result->{file};
+ $prime{$package}{version} = $result->{version};
+ }
} else {
- # no alt package found with a version, but we have a prime
- # package so we use it whether it has a version or not
+ # no alt package found with a version, but we have a prime
+ # package so we use it whether it has a version or not
}
} else { # No primary package was selected, use the best alternative
if ( $result->{err} ) {
log_info {
"Found conflicting versions for package '$package'\n" .
- $result->{err}
+ $result->{err}
};
}
# something rather than nothing
$prime{$package}{file} = $result->{file};
$prime{$package}{version} = $result->{version}
- if defined( $result->{version} );
+ if defined( $result->{version} );
}
}
# Normalize versions. Can't use exists() here because of bug in YAML::Node.
- # XXX "bug in YAML::Node" comment seems irrelvant -- dagolden, 2009-05-18
+ # XXX "bug in YAML::Node" comment seems irrelevant -- dagolden, 2009-05-18
for (grep defined $_->{version}, values %prime) {
$_->{version} = $normalize_version->( $_->{version} );
}
foreach my $dir ( @$dirs ) {
my $testfile = File::Spec->catfile($dir, $file);
return [ File::Spec->rel2abs( $testfile ), $dir ]
- if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
+ if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
- if -e "$testfile.pm";
+ if -e "$testfile.pm";
}
return;
}
if ( $in_pod ) {
if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) {
- push( @pod, $1 );
- if ( $self->{collect_pod} && length( $pod_data ) ) {
+ push( @pod, $1 );
+ if ( $self->{collect_pod} && length( $pod_data ) ) {
$pod{$pod_sect} = $pod_data;
$pod_data = '';
}
- $pod_sect = $1;
+ $pod_sect = $1;
} elsif ( $self->{collect_pod} ) {
- $pod_data .= "$line\n";
+ $pod_data .= "$line\n";
}
# VERSION defined with full package spec, i.e. $Module::VERSION
} elsif ( $vers_fullname && $vers_pkg ) {
- push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
- $need_vers = 0 if $vers_pkg eq $pkg;
+ push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
+ $need_vers = 0 if $vers_pkg eq $pkg;
- unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
- $vers{$vers_pkg} =
- $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
- }
+ unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
+ $vers{$vers_pkg} = $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
+ }
# first non-comment line in undeclared package main is VERSION
} elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
- $need_vers = 0;
- my $v =
- $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
- $vers{$pkg} = $v;
- push( @pkgs, 'main' );
+ $need_vers = 0;
+ my $v = $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
+ $vers{$pkg} = $v;
+ push( @pkgs, 'main' );
# first non-comment line in undeclared package defines package main
} elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
- $need_vers = 1;
- $vers{main} = '';
- push( @pkgs, 'main' );
+ $need_vers = 1;
+ $vers{main} = '';
+ push( @pkgs, 'main' );
# only keep if this is the first $VERSION seen
} elsif ( $vers_fullname && $need_vers ) {
- $need_vers = 0;
- my $v =
- $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
-
-
- unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
- $vers{$pkg} = $v;
- }
+ $need_vers = 0;
+ my $v = $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
+ unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
+ $vers{$pkg} = $v;
+ }
}
-
}
-
}
if ( $self->{collect_pod} && length($pod_data) ) {
# compiletime/runtime issues with local()
my $vsub;
$pn++; # everybody gets their own package
- my $eval = qq{BEGIN { q# Hide from _packages_inside()
+ my $eval = qq{BEGIN { my \$dummy = q# Hide from _packages_inside()
#; package Module::Metadata::_version::p$pn;
use version;
no strict;
+ no warnings;
\$vsub = sub {
local $sigil$var;
};
}};
+ $eval = $1 if $eval =~ m{^(.+)}s;
+
local $^W;
# Try to get the $VERSION
eval $eval;
my $mod = shift || $self->{module};
my $vers;
if ( defined( $mod ) && length( $mod ) &&
- exists( $self->{versions}{$mod} ) ) {
- return $self->{versions}{$mod};
+ exists( $self->{versions}{$mod} ) ) {
+ return $self->{versions}{$mod};
} else {
- return undef;
+ return undef;
}
}
my $self = shift;
my $sect = shift;
if ( defined( $sect ) && length( $sect ) &&
- exists( $self->{pod}{$sect} ) ) {
- return $self->{pod}{$sect};
+ exists( $self->{pod}{$sect} ) ) {
+ return $self->{pod}{$sect};
} else {
- return undef;
+ return undef;
}
}
+sub is_indexable {
+ my ($self, $package) = @_;
+
+ my @indexable_packages = grep { $_ ne 'main' } $self->packages_inside;
+
+ # check for specific package, if provided
+ return !! grep { $_ eq $package } @indexable_packages if $package;
+
+ # otherwise, check for any indexable packages at all
+ return !! @indexable_packages;
+}
+
1;
=head1 NAME
=head1 DESCRIPTION
-This module provides a standard way to gather metadata about a .pm file
-without executing unsafe code.
+This module provides a standard way to gather metadata about a .pm file through
+(mostly) static analysis and (some) code execution. When determining the
+version of a module, the C<$VERSION> assignment is C<eval>ed, as is traditional
+in the CPAN toolchain.
=head1 USAGE
=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
+is more than one package, 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 POD data in the given section.
+=item C<< is_indexable($package) >> or C<< is_indexable() >>
+
+Returns a boolean indicating whether the package (if provided) or any package
+(otherwise) is eligible for indexing by PAUSE, the Perl Authors Upload Server.
+Note This only checks for valid C<package> declarations, and does not take any
+ownership information into account.
+
=back
=head1 AUTHOR
projects / p5sagit/Module-Metadata.git / blobdiff