Files
devkit/sabayon-detectobsolete
2017-05-21 14:13:59 +02:00

66 lines
1.6 KiB
Perl
Executable File

#!/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;