reverted last change
This commit is contained in:
parent
fad3472482
commit
40a02c934f
@ -46,7 +46,7 @@
|
||||
|
||||
# by Ken Estes Mail.com kestes@staff.mail.com
|
||||
# modified by Mikhail Zabaluev <mookid@mu.ru>
|
||||
# modified by Alexey Tourbin <at@altlinux.org>
|
||||
# modified by Alexey Tourbin <at@turbinal.org>
|
||||
|
||||
require v5.6.0;
|
||||
|
||||
@ -155,6 +155,10 @@ sub process_file {
|
||||
|
||||
my $inpackage = 0;
|
||||
|
||||
my ($package_name, $package_filename);
|
||||
my $module_path = $module_file;
|
||||
$module_path =~ s/(.+?)\/(.+)/$1\//;
|
||||
|
||||
while (<FILE>) {
|
||||
|
||||
# skip the documentation
|
||||
@ -163,7 +167,11 @@ sub process_file {
|
||||
# properly belongs in the over/back section) but people do not
|
||||
# read the perldoc.
|
||||
|
||||
if ((m/^=\w/) .. (m/^=cut/)) {
|
||||
if ((m/^=(head[12]|pod|over|item|for|begin)/) .. (m/^=(cut)/)) {
|
||||
next;
|
||||
}
|
||||
|
||||
if ( (m/^=(over)/) .. (m/^=(back)/) ) {
|
||||
next;
|
||||
}
|
||||
|
||||
@ -176,7 +184,22 @@ sub process_file {
|
||||
# package name so we browse through all namespaces
|
||||
|
||||
if (m/^\s*package\s+([\w:']+)\s*;/) {
|
||||
$inpackage = (module_filename($1) eq $module_file)? 1 : 0;
|
||||
|
||||
# AT:
|
||||
# $ grep '^[ \t]*package' /usr/lib/perl5/i386-linux/B/CC.pm
|
||||
# /usr/lib/perl5/i386-linux/B/CC.pm:package B::CC;
|
||||
# /usr/lib/perl5/i386-linux/B/CC.pm: package B::Pseudoreg;
|
||||
# /usr/lib/perl5/i386-linux/B/CC.pm: package B::Shadow;
|
||||
|
||||
$package_name = $1;
|
||||
$package_filename = module_filename($package_name);
|
||||
next if $package_filename eq $module_file;
|
||||
if ($module_path && index($package_filename, $module_path) == 0) {
|
||||
$provide{$package_filename} = undef;
|
||||
} else {
|
||||
undef $package_name;
|
||||
undef $package_filename;
|
||||
}
|
||||
next;
|
||||
}
|
||||
|
||||
@ -184,19 +207,20 @@ sub process_file {
|
||||
# $VERSION as the version number. Exporter requires that the
|
||||
# variable be called VERSION so we are safe.
|
||||
|
||||
if ($inpackage &&
|
||||
if ($package_filename &&
|
||||
s/^([\s(]*)(our\s*)?\$VERSION\s*=/$1\$VERSION =/) {
|
||||
|
||||
my $rest = $'; next unless $rest =~ /\d/;
|
||||
$provide{$module_file} = extract_version($_);
|
||||
$provide{$package_filename} = extract_version($_);
|
||||
next;
|
||||
}
|
||||
|
||||
# also consider version initializations with explicit package specification
|
||||
|
||||
if (s/^([\s(]*)(our\s*)?\$([\w:']+)::VERSION\s*=/$1\$VERSION =/) {
|
||||
if (module_filename($3) eq $module_file) {
|
||||
$provide{$module_file} = extract_version($_);
|
||||
my $filename = module_filename($3);
|
||||
if ($filename eq $module_file ||
|
||||
$module_path && index($filename, $module_path) == 0)
|
||||
{
|
||||
$provide{$filename} = extract_version($_);
|
||||
}
|
||||
next;
|
||||
}
|
||||
@ -251,20 +275,19 @@ sub extract_version {
|
||||
|
||||
return undef if $@ || length($version) == 0;
|
||||
|
||||
if ($version =~ /^v/ || $version =~ /\.[\d_]+\./) {
|
||||
if ($version =~ s/^\s*(\d[\d_]*(\.[\d_]*)?|\.[\d_]+)/$1/) {
|
||||
|
||||
# plain old numeric version
|
||||
|
||||
return '0:' . $version;
|
||||
}
|
||||
else {
|
||||
|
||||
# Supposedly, a new style version evaluated as a string constant.
|
||||
# Return an epoch 1 version
|
||||
|
||||
return sprintf('1:%vd', $version);
|
||||
}
|
||||
else {
|
||||
|
||||
# plain old numeric version
|
||||
|
||||
$version =~ s/_//g;
|
||||
return '0:' . $version;
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
@ -39,7 +39,7 @@
|
||||
|
||||
# by Ken Estes Mail.com kestes@staff.mail.com
|
||||
# modified by Mikhail Zabaluev <mookid@mu.ru>
|
||||
# modified by Alexey Tourbin <at@altlinux.org>
|
||||
# modified by Alexey Tourbin <at@turbinal.org>
|
||||
|
||||
use 5.005; # qr
|
||||
use Getopt::Long;
|
||||
@ -74,18 +74,15 @@ my @ignore_reqs = (
|
||||
qr(^sys/systeminfo\b),
|
||||
qr(^vmsish\b),
|
||||
qr(^MacPerl\b),
|
||||
qr(^VMS\b),
|
||||
qr(^Win32\b),
|
||||
qr(^OS2\b),
|
||||
qr(^Mac\b),
|
||||
qr(^VMS/),
|
||||
qr(^Win32/),
|
||||
qr(^OS2/),
|
||||
qr(^Mac/),
|
||||
qr(^ExtUtils/XSSymSet\b),
|
||||
qr(^Convert/EBCDIC\b),
|
||||
# old names
|
||||
qr(^Digest/Perl/MD5\b),
|
||||
qr(^Pod/PlainText\b),
|
||||
# so commonly used... just a database junk (guaranteed to be in perl-base)
|
||||
qr(^strict\.pm$),
|
||||
qr(^vars\.pm$),
|
||||
# wrong names
|
||||
qr(/\.),
|
||||
qr(\$),
|
||||
@ -124,12 +121,10 @@ foreach $module (sort keys %require) {
|
||||
}
|
||||
}
|
||||
|
||||
# nothing special? but the fact that we were called somehow...
|
||||
print "perl-base\n" unless %require;
|
||||
|
||||
exit 0;
|
||||
|
||||
|
||||
|
||||
sub process_file {
|
||||
|
||||
my ($file) = @_;
|
||||
@ -157,7 +152,11 @@ sub process_file {
|
||||
# properly belongs in the over/back section) but people do not
|
||||
# read the perldoc.
|
||||
|
||||
if ((m/^=\w/) .. (m/^=cut/)) {
|
||||
if ((m/^=(head[12]|pod|over|item|for|begin)/) .. (m/^=(cut)/)) {
|
||||
next;
|
||||
}
|
||||
|
||||
if ( (m/^=(over)/) .. (m/^=(back)/) ) {
|
||||
next;
|
||||
}
|
||||
|
||||
@ -350,11 +349,13 @@ sub module_filename {
|
||||
# floating-point version number
|
||||
|
||||
sub package_version {
|
||||
my ($version, $format) = (@_, '%s');
|
||||
if ($version =~ /^v/ || $version =~ /\.[\d_]+\./) {
|
||||
return '1:' . sprintf('%vd', $version);
|
||||
} else {
|
||||
$version =~ s/_//g;
|
||||
my $version = shift;
|
||||
if ($version =~ s/^v// || $version =~ /\.[\d_]+\./) {
|
||||
return "1:$version";
|
||||
}
|
||||
else {
|
||||
my $format = shift;
|
||||
$format = '%s' unless defined $format;
|
||||
return '0:' . sprintf($format, $version);
|
||||
}
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user