Re: Get rid of leaf packages

[Pierre-Yves Ritschard]

On Thu, 30 Aug 2007 09:22:18 +0100
"Edd Barrett" <[EMAIL PROTECTED]> wrote:

> Hi,
> 
> On 30/08/2007, Jona Joachim <[EMAIL PROTECTED]> wrote:
> > You can find it here:
> > http://hcl-club.lu/svn/development/python/cutleaves
> 
> This is useful! Why not write a port?
> 
Why write it in python ?
The package system was written in perl and there are lots of
supporting modules readily available in the system.

Here's what I use (top-level-delete.pl), of course you will have
to change the last statement to call pkg_delete for actual deletion:

#!/usr/bin/perl

use strict;
use warnings;
use OpenBSD::Search;
use OpenBSD::PackageInfo;
use OpenBSD::PackageName;
use OpenBSD::PackageRepository::Installed;
use OpenBSD::RequiredBy;

die "not enough args" if (@ARGV < 1);
        
sub find_pkg
{
        my $children = shift;
        my $pname = shift;
        my $repo = OpenBSD::PackageRepository::Installed->new;;
        my $pkg = $repo->find($pname);

        if (!defined($pkg) && OpenBSD::PackageName::is_stem($pname)) {
                my @l = sort ($repo->match(OpenBSD::Search::Stem->new($pname)));
                $pkg = $repo->find($l[0]) if (@l == 1);
        }
        $children->{$pkg->{name}} = 1 if (defined($pkg));
}

sub find_children
{
        my $children = shift;
        my @packages = OpenBSD::PackageInfo::installed_packages();
        my $pkg;
        my $nfound = 0;

        FINDLOOP: foreach $pkg (@packages) {
                next if grep $pkg eq $_,keys(%$children);
                
                my @reqlist = OpenBSD::RequiredBy->new($pkg)->list;
                next if (@reqlist == 0);

                foreach my $req (@reqlist) {
                        next FINDLOOP if (!defined($children->{$req}));
                }

                if (!defined($children->{$pkg})) {
                        $children->{$pkg} = 1;
                        $nfound++;
                }
        }
        return ($nfound);
}

my $children = {};
map { find_pkg $children, $_ } @ARGV;

# call while new removeable packages are found
1 while (find_children($children) > 0);

map { print "removing: $_\n" } keys(%$children);