sabayon-detectobsolete: more perlish ✨

move up the adjustment of emerge/equo arguments, avoid to copy artifacts when PRETEND mode is on

builder

@@ -316,6 +316,15 @@ say "\t* " . $_ for @ARGV;
 
 say "[*] Syncing configurations files, Layman and Portage";
 
+
+if($pretend){
+  say "[*] PRETEND enabled, no real action will be performed.";
+  say "    Bear in mind that in such way the list of packages";
+  say "    that emerge will try to compile will be bigger";
+  $equo_install_args.=" -p";
+  $emerge_defaults_args.=" -p"
+}
+
 # Syncronizing portage configuration and adding overlays
 system("echo 'en_US.UTF-8 UTF-8' > /etc/locale.gen");    #be sure about that.
 
@@ -550,18 +559,12 @@ if ( $qualityassurance_checks == 1 ) {
 
 say "*** Ready to compile, finger crossed ***";
 
-if($pretend){
-  say "----> PRETEND mode <----";
-  $equo_install_args.=" -p";
-  $emerge_defaults_args.=" -p"
-}
-
 system("emerge --info")
     ; #always give detailed information about the building environment, helpful to debug
 
 my $rt;
 
-if ( $emerge_remove and $emerge_remove ne "" and !$pretend) {
+if ( $emerge_remove and $emerge_remove ne "") {
     say "Removing with emerge: $emerge_remove";
     system("emerge -C $_") for split( / /, $emerge_remove );
 }
@@ -598,6 +601,6 @@ if ( $qualityassurance_checks == 1 ) {
 # Copy files to artifacts folder
 system(
     "mkdir -p $artifacts_folder;cp -rfv /usr/portage/packages $artifacts_folder"
-) if ( $artifacts_folder and !$return );
+) if ( $artifacts_folder and !$return and !$pretend);
 
 exit($return);

sabayon-detectobsolete

@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+# mudler <mudler@sabayon.org>
+# this tool requires querypkg
+use Getopt::Long;
+use strict;
+use warnings;
+my $arch;
+my $verbose;
+my $overlay;
+GetOptions(
+    "arch=s"    => \$arch,
+    "overlay=s" => \$overlay,
+    "verbose"   => \$verbose
+) or die("Error in command line arguments\n");
+
+die("You should at least supply an overlay with --overlay") if !$overlay;
+
+# Input: Overlay absolute path
+# Output: array with package names (category/name)
+sub get_packages {
+    keys %{
+        {   map {
+                s/$overlay\/|\.ebuild//g;
+                $_ = join( '/', ( split( /\//, $_ ) )[ 0, 1 ] );
+                $_ => 1
+            } glob( $_[0] . "/*/*/*.ebuild" )
+        }
+    };
+}
+
+# Input: package (category/name)
+# Output: returns 1 if obsolete and can be removed
+sub obsolete_package($$) {
+    my $package = $_[0];
+    my $arch    = $_[1];
+    my $l_arch  = ( defined $arch and $arch ne "" ? "--arch $arch" : "" );
+    print "querypkg -q $l_arch $package --show spm_repo\n" if $verbose;
+    my @out = `querypkg -q $l_arch $package --show spm_repo`;
+    chomp(@out);
+    return 1 if "@out" eq "";
+    foreach my $l (@out) {
+        print " >> $l\n" if $verbose;
+        return 1 if ( $l =~ /$package.*\{spm_repo\:gent.*/ );
+    }
+    return 0;
+}
+
+my @packages = get_packages($overlay);
+my @obsoletes;
+
+foreach my $p (@packages) {
+    print "[$p] Checking if there is a version in the repositories.... ";
+    print "\n" if $verbose;
+    if ( obsolete_package( $p, $arch ) ) {
+        print " OBSOLETE! \n";
+        push( @obsoletes, $p );
+    }
+    else {
+        print " ok  \n";
+    }
+}
+
+print "\n";
+print "Obsoletes found:\n\n";
+print "$_\n" for @obsoletes;