Blob Blame History Raw
--- rpm-4.11.3/scripts/perl.req.old	2019-01-02 13:14:10.258068525 +0100
+++ rpm-4.11.3/scripts/perl.req	2019-02-28 11:00:57.200220227 +0100
@@ -42,18 +42,29 @@
 $HAVE_VERSION = 0;
 eval { require version; $HAVE_VERSION = 1; };
 
+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();
   }
 }
 
@@ -61,8 +72,9 @@
 foreach $perlver (sort keys %perlreq) {
   print "perl >= $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($module)\n";
   } else {
 
@@ -70,13 +82,35 @@
     # operators. Also I will need to change the processing of the
     # $RPM_* variable when I upgrade.
 
-    print "perl($module) >= $require{$module}\n";
+    print "perl($module) >= $global_require{$module}\n";
   }
 }
 
 exit 0;
 
-
+sub compute_global_requires {
+ 
+# restrict require to all non provided by the file
+  foreach my $moduler (sort keys %require) {
+    if (exists $provide{$moduler} && length($require{$moduler}) == 0) {
+      $require = delete $require{$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;
+    }
+  }
+# remove all local requires and provides
+  undef %require;
+  undef %provide;
+}
 
 sub add_require {
   my ($module, $newver) = @_;
@@ -328,3 +362,17 @@
 
   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]+)\)/;
+  }
+
+}