|
|
@ -1,208 +0,0 @@
|
|
|
|
diff --git a/t/02_list.t b/t/02_list.t
|
|
|
|
|
|
|
|
index a0b8206..507fd43 100644
|
|
|
|
|
|
|
|
--- a/t/02_list.t
|
|
|
|
|
|
|
|
+++ b/t/02_list.t
|
|
|
|
|
|
|
|
@@ -13,7 +13,13 @@ my @provides = qx($PERL_PROV $file);
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#
|
|
|
|
|
|
|
|
# Provides
|
|
|
|
|
|
|
|
-is(scalar(@provides), 0, 'No package is provided');
|
|
|
|
|
|
|
|
+my @expectedprovides = (
|
|
|
|
|
|
|
|
+ "$perl_ns(NoCleanA)\n",
|
|
|
|
|
|
|
|
+ "$perl_ns(NoCleanB)\n",
|
|
|
|
|
|
|
|
+ "$perl_ns(ToRemove)\n",
|
|
|
|
|
|
|
|
+ "$perl_ns(Foo)\n",
|
|
|
|
|
|
|
|
+);
|
|
|
|
|
|
|
|
+is_deeply([ sort @provides ], [ sort @expectedprovides ], "All expected provides were found.");
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#
|
|
|
|
|
|
|
|
# Requires
|
|
|
|
|
|
|
|
@@ -38,6 +44,8 @@ my @expectedrequires = (
|
|
|
|
|
|
|
|
"$perl_ns(TARGET_CLASS)\n",
|
|
|
|
|
|
|
|
"$perl_ns(XML::XQL::Element)\n",
|
|
|
|
|
|
|
|
"$perl_ns(Class::Accessor::Fast)\n",
|
|
|
|
|
|
|
|
+ "$perl_ns(NoCleanA)\n",
|
|
|
|
|
|
|
|
+ "$perl_ns(NoCleanB)\n",
|
|
|
|
|
|
|
|
);
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
is_deeply([ sort @requires ], [ sort @expectedrequires ], "Only expected requires were found.");
|
|
|
|
|
|
|
|
diff --git a/t/data/list b/t/data/list
|
|
|
|
|
|
|
|
index f7b1a19..a40c76b 100644
|
|
|
|
|
|
|
|
--- a/t/data/list
|
|
|
|
|
|
|
|
+++ b/t/data/list
|
|
|
|
|
|
|
|
@@ -36,3 +36,14 @@ use base TARGET_CLASS;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
# Do not ignore line which contains '->' in a coment
|
|
|
|
|
|
|
|
use base 'XML::XQL::Element'; # L -> L
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+use NoCleanA;
|
|
|
|
|
|
|
|
+package NoCleanA;
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+package NoCleanB;
|
|
|
|
|
|
|
|
+require NoCleanB;
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+package ToRemove;
|
|
|
|
|
|
|
|
+sub foo{}
|
|
|
|
|
|
|
|
+package Foo;
|
|
|
|
|
|
|
|
+use base 'ToRemove';
|
|
|
|
|
|
|
|
diff --git a/template/bin/perl.req b/template/bin/perl.req
|
|
|
|
|
|
|
|
index 9e2e016..45cbd1a 100755
|
|
|
|
|
|
|
|
--- a/template/bin/perl.req
|
|
|
|
|
|
|
|
+++ b/template/bin/perl.req
|
|
|
|
|
|
|
|
@@ -26,18 +26,29 @@ $HAVE_VERSION = 0;
|
|
|
|
|
|
|
|
eval { require version; $HAVE_VERSION = 1; };
|
|
|
|
|
|
|
|
use Fedora::VSP ();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
+use File::Basename;
|
|
|
|
|
|
|
|
+my $dir = dirname($0);
|
|
|
|
|
|
|
|
+$HAVE_PROV = 0;
|
|
|
|
|
|
|
|
+if ( -e "$dir/perl.prov" ) {
|
|
|
|
|
|
|
|
+ $HAVE_PROV = 1;
|
|
|
|
|
|
|
|
+ $prov_script = "$dir/perl.prov";
|
|
|
|
|
|
|
|
+}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if ("@ARGV") {
|
|
|
|
|
|
|
|
- foreach (@ARGV) {
|
|
|
|
|
|
|
|
- process_file($_);
|
|
|
|
|
|
|
|
+ foreach my $file (@ARGV) {
|
|
|
|
|
|
|
|
+ process_file($file);
|
|
|
|
|
|
|
|
+ process_file_provides($file);
|
|
|
|
|
|
|
|
+ compute_global_requires();
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
} else {
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
# notice we are passed a list of filenames NOT as common in unix the
|
|
|
|
|
|
|
|
# contents of the file.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
- foreach (<>) {
|
|
|
|
|
|
|
|
- process_file($_);
|
|
|
|
|
|
|
|
+ foreach my $file (<>) {
|
|
|
|
|
|
|
|
+ process_file($file);
|
|
|
|
|
|
|
|
+ process_file_provides($file);
|
|
|
|
|
|
|
|
+ compute_global_requires();
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
@@ -45,8 +56,9 @@ if ("@ARGV") {
|
|
|
|
|
|
|
|
foreach $perlver (sort keys %perlreq) {
|
|
|
|
|
|
|
|
print "$perl_ns(:VERSION) >= $perlver\n";
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
-foreach $module (sort keys %require) {
|
|
|
|
|
|
|
|
- if (length($require{$module}) == 0) {
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+foreach my $module (sort keys %global_require) {
|
|
|
|
|
|
|
|
+ if (length($global_require{$module}) == 0) {
|
|
|
|
|
|
|
|
print "$perl_ns($module)\n";
|
|
|
|
|
|
|
|
} else {
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
@@ -54,13 +66,48 @@ foreach $module (sort keys %require) {
|
|
|
|
|
|
|
|
# operators. Also I will need to change the processing of the
|
|
|
|
|
|
|
|
# $RPM_* variable when I upgrade.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
- print "$perl_ns($module) >= $require{$module}\n";
|
|
|
|
|
|
|
|
+ print "$perl_ns($module) >= $global_require{$module}\n";
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
exit 0;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
+sub compute_global_requires {
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+# restrict require_removable to all non provided by the file
|
|
|
|
|
|
|
|
+ foreach my $moduler (sort keys %require_removable) {
|
|
|
|
|
|
|
|
+ if (exists $provide{$moduler} && length($require_removable{$moduler}) == 0) {
|
|
|
|
|
|
|
|
+ $require_removable = delete $require_removable{$moduler};
|
|
|
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
+# store requires to global_requires
|
|
|
|
|
|
|
|
+ foreach my $module (sort keys %require) {
|
|
|
|
|
|
|
|
+ my $oldver = $global_require{$module};
|
|
|
|
|
|
|
|
+ my $newver = $require{$module};
|
|
|
|
|
|
|
|
+ if ($oldver) {
|
|
|
|
|
|
|
|
+ $global_require{$module} = $newver
|
|
|
|
|
|
|
|
+ if ($HAVE_VERSION && $newver && version->new($oldver) < $newver);
|
|
|
|
|
|
|
|
+ } else {
|
|
|
|
|
|
|
|
+ $global_require{$module} = $newver;
|
|
|
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
+# store requires_removable to global_requires
|
|
|
|
|
|
|
|
+ foreach my $module (sort keys %require_removable) {
|
|
|
|
|
|
|
|
+ my $oldver = $global_require{$module};
|
|
|
|
|
|
|
|
+ my $newver = $require_removable{$module};
|
|
|
|
|
|
|
|
+ if ($oldver) {
|
|
|
|
|
|
|
|
+ $global_require{$module} = $newver
|
|
|
|
|
|
|
|
+ if ($HAVE_VERSION && $newver && version->new($oldver) < $newver);
|
|
|
|
|
|
|
|
+ } else {
|
|
|
|
|
|
|
|
+ $global_require{$module} = $newver;
|
|
|
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
+# remove all local requires and provides
|
|
|
|
|
|
|
|
+ undef %require;
|
|
|
|
|
|
|
|
+ undef %require_removable;
|
|
|
|
|
|
|
|
+ undef %provide;
|
|
|
|
|
|
|
|
+}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub add_require {
|
|
|
|
|
|
|
|
my ($module, $newver) = @_;
|
|
|
|
|
|
|
|
@@ -82,6 +129,26 @@ sub add_require {
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
+sub add_require_removable {
|
|
|
|
|
|
|
|
+ my ($module, $newver) = @_;
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+ # __EXAMPLE__ is not valid requirement
|
|
|
|
|
|
|
|
+ return if ($module =~ m/^__[A-Z]+__$/o);
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+ # To prevent that module does not end with '::'
|
|
|
|
|
|
|
|
+ # Example: use base Object::Event::;
|
|
|
|
|
|
|
|
+ $module =~ s/::$//;
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+ my $oldver = $require_removable{$module};
|
|
|
|
|
|
|
|
+ if ($oldver) {
|
|
|
|
|
|
|
|
+ $require_removable{$module} = $newver
|
|
|
|
|
|
|
|
+ if ($HAVE_VERSION && $newver && version->new($oldver) < $newver);
|
|
|
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
+ else {
|
|
|
|
|
|
|
|
+ $require_removable{$module} = $newver;
|
|
|
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
+}
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
sub process_file {
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
my ($file) = @_;
|
|
|
|
|
|
|
|
@@ -312,7 +379,14 @@ sub process_file {
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
# use base|parent qw(Foo) dependencies
|
|
|
|
|
|
|
|
# use aliased qw(Foo::Bar) dependencies
|
|
|
|
|
|
|
|
- if ($statement eq "use" && ($module eq "base" || $module eq "aliased")) {
|
|
|
|
|
|
|
|
+ if ($statement eq "use" && $module eq "base") {
|
|
|
|
|
|
|
|
+ add_require($module, $version);
|
|
|
|
|
|
|
|
+ if (defined($list) && $list ne "") {
|
|
|
|
|
|
|
|
+ add_require_removable($_, undef) for split(' ', $list);
|
|
|
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
+ next;
|
|
|
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
+ if ($statement eq "use" && $module eq "aliased") {
|
|
|
|
|
|
|
|
add_require($module, $version);
|
|
|
|
|
|
|
|
if (defined($list) && $list ne "") {
|
|
|
|
|
|
|
|
add_require($_, undef) for split(' ', $list);
|
|
|
|
|
|
|
|
@@ -353,3 +427,17 @@ sub process_file {
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
return;
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+sub process_file_provides {
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+ my ($file) = @_;
|
|
|
|
|
|
|
|
+ chomp $file;
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+ return if (! $HAVE_PROV);
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+ my @result = readpipe( "$prov_script $file" );
|
|
|
|
|
|
|
|
+ foreach my $prov (@result) {
|
|
|
|
|
|
|
|
+ $provide{$1} = undef if $prov =~ /perl\(([_:a-zA-Z0-9]+)\)/;
|
|
|
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
+
|
|
|
|
|
|
|
|
+}
|
|
|
|
|