66 lines
1.6 KiB
Perl
66 lines
1.6 KiB
Perl
#!/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;
|