use strict;
use vars qw($VERSION);
-$VERSION = '1.000010';
+$VERSION = '1.000011';
$VERSION = eval $VERSION;
use Carp qw/croak/;
=[^=~] # = 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 $filename = File::Spec->rel2abs( shift );
}
{
-
+
my $compare_versions = sub {
my ($v1, $op, $v2) = @_;
$v1 = version->new($v1)
unless UNIVERSAL::isa($v1,'version');
-
+
my $eval_str = "\$v1 $op \$v2";
my $result = eval $eval_str;
log_info { "error comparing versions: '$eval_str' $@" } if $@;
-
+
return $result;
};
my $resolve_module_versions = sub {
my $packages = shift;
-
+
my( $file, $version );
my $err = '';
foreach my $p ( @$packages ) {
}
$file ||= $p->{file} if defined( $p->{file} );
}
-
+
if ( $err ) {
$err = " $file ($version)\n" . $err;
}
-
+
my %result = (
file => $file,
version => $version,
err => $err
);
-
+
return \%result;
};
my $mapped_filename = File::Spec::Unix->abs2rel( $file, $dir );
my @path = split( /\//, $mapped_filename );
(my $prime_package = join( '::', @path )) =~ s/\.pm$//;
-
+
my $pm_info = $class->new_from_file( $file );
-
+
foreach my $package ( $pm_info->packages_inside ) {
next if $package eq 'main'; # main can appear numerous times, ignore
next if $package eq 'DB'; # special debugging package, ignore
next if grep /^_/, split( /::/, $package ); # private package, ignore
-
+
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} ) ) {
}
}
}
-
+
# Then we iterate over all the packages found above, identifying conflicts
# and selecting the "best" candidate for recording the file & version
# for each package.
foreach my $package ( keys( %alt ) ) {
my $result = $resolve_module_versions->( $alt{$package} );
-
+
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
" $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
" $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 {
# 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}
};
}
-
+
# Despite possible conflicting versions, we choose to record
# something rather than nothing
$prime{$package}{file} = $result->{file};
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
for (grep defined $_->{version}, values %prime) {
$_->{version} = $normalize_version->( $_->{version} );
}
-
+
return \%prime;
}
-}
-
+}
+
sub _init {
my $class = shift;
chomp( $line );
+ # From toke.c : any line that begins by "=X", where X is an alphabetic
+ # character, introduces a POD segment.
my $is_cut;
- if ( $line =~ /$PODSECT_REGEXP/o ) {
- $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 ) {
if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) {
# 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 ) =
($line =~ /VERSION/)
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
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
}
}
projects / p5sagit/Module-Metadata.git / blobdiff