From 1dea749becfedf46c9bae6348bcc0f5612872199 Mon Sep 17 00:00:00 2001
From: Packit <packit>
Date: Sep 16 2020 12:30:35 +0000
Subject: Apply patch generators-1.10-remove-perl-provides-from-requires.patch


patch_name: generators-1.10-remove-perl-provides-from-requires.patch
present_in_specfile: true

---

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]+)\)/;
+  }
+
+}