#!/usr/bin/perl # mudler # 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;