Index: head/ports-mgmt/pkg_cutleaves/Makefile =================================================================== --- head/ports-mgmt/pkg_cutleaves/Makefile (revision 209804) +++ head/ports-mgmt/pkg_cutleaves/Makefile (revision 209805) @@ -1,46 +1,46 @@ # New ports collection makefile for: pkg_cutleaves # Date created: 27 July 2003 # Whom: Stefan Walter # # $FreeBSD$ # PORTNAME= pkg_cutleaves -PORTVERSION= 20071021 +PORTVERSION= 20080320 CATEGORIES= ports-mgmt MASTER_SITES= # none DISTFILES= # none MAINTAINER= stefan@FreeBSD.org COMMENT= Interactive script for deinstalling 'leaf' packages NO_BUILD= yes USE_PERL5= yes WRKSRC= ${WRKDIR} MAN1= pkg_cutleaves.1 PLIST_FILES= sbin/pkg_cutleaves do-extract: ${MKDIR} ${WRKSRC} ${CP} ${FILESDIR}/pkg_cutleaves ${FILESDIR}/pkg_cutleaves.1 ${WRKSRC} post-patch: @${REINPLACE_CMD} -e \ 's,/usr/local/etc/pkg_leaves.exclude,${PREFIX}/etc/pkg_leaves.exclude,' \ ${WRKSRC}/pkg_cutleaves.1 @${REINPLACE_CMD} \ -e 's,/usr/local/etc/pkg_leaves.exclude,${PREFIX}/etc/pkg_leaves.exclude,' \ -e 's,/usr/sbin/pkg_delete,${PKG_DELETE},' \ -e 's,/usr/local/sbin/pkgdb,${LOCALBASE}/sbin/pkgdb,' \ -e 's,/var/db/pkg,${PKG_DBDIR},' \ -e 's,/usr/bin/perl,${PERL},' \ ${WRKSRC}/pkg_cutleaves do-install: ${INSTALL_SCRIPT} ${WRKSRC}/pkg_cutleaves ${PREFIX}/sbin/pkg_cutleaves ${INSTALL_MAN} ${WRKSRC}/pkg_cutleaves.1 ${MAN1PREFIX}/man/man1 .include Property changes on: head/ports-mgmt/pkg_cutleaves/Makefile ___________________________________________________________________ Modified: cvs2svn:cvs-rev ## -1 +1 ## -1.14 \ No newline at end of property +1.15 \ No newline at end of property Index: head/ports-mgmt/pkg_cutleaves/files/pkg_cutleaves =================================================================== --- head/ports-mgmt/pkg_cutleaves/files/pkg_cutleaves (revision 209804) +++ head/ports-mgmt/pkg_cutleaves/files/pkg_cutleaves (revision 209805) @@ -1,324 +1,385 @@ #!/usr/bin/perl +# $Id$ # # Copyright (c) 2003 Stefan Walter # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # Interactive script for deinstalling "leaf" packages # -# Syntax: pkg_cutleaves [-cFgLlRx] +# Syntax: pkg_cutleaves [-cFgLlRVx] # Options: # -c: Show comments, too; only works with '-l' (ignored otherwise) # -F: Fix package db after each deinstallation run (via 'pkgdb -F') # -g: Generate exclude list from kept/installed leaf packages # -L: Interpret exclude file as list of packages that *should* be installed # -l: List leaf packages only, don't ask if they should be deinstalled # -R: Autoprune new leaves +# -V: Visual mode, invoke $EDITOR # -x: Honor exclude list in $excludefile +use File::Temp qw/ tempfile /; use Getopt::Std; use strict; my $dbdir = "/var/db/pkg"; my $excludefile = "/usr/local/etc/pkg_leaves.exclude"; my $pkgdeinstall = "/usr/sbin/pkg_delete"; my @pkgdb_args = ("/usr/local/sbin/pkgdb", "-F"); my $exclpattern; my %leavestokeep; my %opt; -getopts('cFgLlRx', \%opt); +getopts('cFgLlRVx', \%opt); set_excl_pattern(); # LIST MODE if ($opt{l}) { # Just print out the list of leaves, one per line my %leaves = get_leaves(); foreach my $leaf (sort keys %leaves) { if ($opt{c}) { print "$leaf - $leaves{$leaf}\n"; } else { print "$leaf\n"; } $leavestokeep{$leaf} = 1; } } # LINT MODE elsif ($opt{L}) { my @excludes = get_excludelist(); my @pkgs = get_packages(); # For each installed package for my $pkg (@pkgs) { my ($file, $required) = @$pkg; # Clobber any exclude patterns that match this package for (my $i = 0; $i < @excludes; $i++) { if ($file =~ /\Q@excludes[$i]\E/) { splice(@excludes, $i--, 1); } } # If matches exclude list and is not a leaf if ($required && ($file =~ $exclpattern)) { print "$file matches exclude list, but is not a leaf\n" } else { $leavestokeep{$file} = 1; } } # In exclude list, but not installed # For each remaining entry in exclude list foreach my $exclude (@excludes) { print "Exclude pattern '$exclude' matches no installed packages\n"; } } # INTERACTIVE MODE else { my @cutleaves; my ($i, $again); # Get list of leaf packages and put them into a hash my %leaves = get_leaves(); # Any leaves to work with? my $nleaves = keys %leaves; if ($nleaves > 0) { # If we don't have superuser rights, notify the user. if ($< != 0) { print "You need to have root permissions for deinstalling packages.\n"; $again = 'n'; } else { $again = 'y'; } } else { # If not, don't go on, there's nothing to do. print "** Didn't find any leaves to work with, exiting.\n"; print "** If this is unexpected, check your exclude file, please.\n"; $again = 'n'; } # Loop while the user wants to ROUND: while($again eq 'y') { # Always start with an empty list of leaves to cut my %leavestocut; # Initialize counter for progress status $i = 1; - LEAVESLOOP: foreach my $leaf (sort keys %leaves) { - print "Package $i of $nleaves:\n"; - print "$leaf - $leaves{$leaf}\n"; - print "$leaf - [keep]/(d)elete/(f)lush marked pkgs/(a)bort? "; - # Get first character of input, without leading whitespace - my ($answer) = (lc() =~ m/(\S)/); - if ($answer eq 'd') { - print "** Marking $leaf for removal.\n\n"; - $leavestocut{$leaf} = 1; + if ($opt{V}) { + # Write list, including descriptions out to temp file + my ($fh, $filename) = tempfile() or die "Can't create file: $!"; + print $fh "# Delete the lines whose packages you want removed.\n"; + print $fh "# Simply save and quit, when you are done.\n"; + print $fh "# There are $nleaves (new) leaf packages:\n"; + foreach my $leaf (sort keys %leaves) { + # XXX Calculate maximum length first instead of 40? + printf $fh "%-40s - %s\n", $leaf, $leaves{$leaf}; } - elsif ($answer eq 'f') { - print "\n"; - last LEAVESLOOP; + close($fh); + + # Invoke $EDITOR, vi if no EDITOR set + my $editor = ($ENV{'EDITOR'} eq "") ? "vi" : $ENV{'EDITOR'}; + system "$editor $filename"; + if ($? == -1) { + print "failed to execute: $!\n"; + unlink($filename); + exit 1; } - elsif ($answer eq 'a') { - print "\n"; - $opt{aborted} = 1; - last ROUND; + + # Read back and parse list, the diff to the original list will be removed + open($fh, $filename) or die "Can't reopen file: $!"; + while(<$fh>) { + next if $_ =~ m/\s*#/; + next if $_ =~ m/^\s*$/; + my ($leaf, $desc) = split(/\s/, $_, 2); + + if (defined $leaves{$leaf}) { + delete $leaves{$leaf}; + $leavestokeep{$leaf} = 1; + } else { + print "Package \"$leaf\" not known, skipping\n"; + } } - else { - print "** Keeping $leaf.\n\n"; - $leavestokeep{$leaf} = 1; + close($fh); + unlink($filename); + + exit 0 if (keys %leaves == 0); + # print the lists of packages which will be removed, due to + # typos in the editor, the user might have 'removed' a package + # he is still interested in. This batch mode, really should get a last + # confirmation from the user. + print "The following packages will be removed:\n"; + # XXX Use map here? + # XXX check empty hash FIXME + foreach my $leaf (sort keys %leaves) { + $leavestocut{$leaf} = 1; + print " $leaf\n"; } - $i++; - } # LEAVESLOOP + print "Are you sure? [yes]: "; + my ($answer) = (lc() =~ /(\S)/o); + print "\n"; + exit 0 if $answer =~ /n/; + + # Fallthrough to actual package removal + } else { + LEAVESLOOP: foreach my $leaf (sort keys %leaves) { + print "Package $i of $nleaves:\n"; + print "$leaf - $leaves{$leaf}\n"; + print "$leaf - [keep]/(d)elete/(f)lush marked pkgs/(a)bort? "; + # Get first character of input, without leading whitespace + my ($answer) = (lc() =~ m/(\S)/); + if ($answer eq 'd') { + print "** Marking $leaf for removal.\n\n"; + $leavestocut{$leaf} = 1; + } + elsif ($answer eq 'f') { + print "\n"; + last LEAVESLOOP; + } + elsif ($answer eq 'a') { + print "\n"; + $opt{aborted} = 1; + last ROUND; + } + else { + print "** Keeping $leaf.\n\n"; + $leavestokeep{$leaf} = 1; + } + $i++; + } # LEAVESLOOP + } AUTOPRUNE: # The -R switch jump # Initialize 'progress meter' my $ncuts = keys %leavestocut; my $noff = 0; # loop through packages marked for removal and pkg_deinstall them foreach my $leaf (sort keys %leavestocut) { $noff++; print "Deleting $leaf (package $noff of $ncuts).\n"; my @deinstall_args = ($pkgdeinstall, $leaf); if ((my $status = system(@deinstall_args) >> 8) != 0) { print STDERR "\n\n$0: pkg_deinstall returned $status - exiting, fix this first.\n\n"; last ROUND; } push @cutleaves, $leaf; } # Run 'pkgdb -F' if requested if ($opt{F}) { print "Running 'pkgdb -F'.\n"; if ((my $status = system(@pkgdb_args) >> 8) != 0) { print STDERR "\n\n$0: pkgdb returned $status - exiting, fix this first.\n\n"; last ROUND; } } # Get new list of leaf packages and put them into a hash %leaves = get_leaves(); # Ignore all leaves the user already told us to keep foreach my $leaf (keys %leavestokeep) { delete $leaves{$leaf} } # Any leaves left? $nleaves = keys %leaves; if ($nleaves == 0) { # If not, don't go on, there's nothing left to do. print "** Didn't find any new leaves to work with, exiting.\n"; last ROUND; } if ($opt{R}) { # start autopruning new leaves print "\n** Autopruning new leaves (Ctrl-C now to stop!) **\n" x 2; sleep 1; %leavestocut = %leaves; goto AUTOPRUNE; } # AUTOPRUNE print "Go on with new leaf packages ((y)es/[no])? "; # Get first character of input, without leading whitespace ($again) = (lc() =~ /(\S)/o); print "\n"; } # ROUND # print list of removed packages, sorted lexically, and their number print "** Deinstalled packages:\n"; foreach my $cutleaf (sort @cutleaves) { print "$cutleaf\n"; } my $noff = @cutleaves; print "** Number of deinstalled packages: $noff\n"; } # Generate exclude file if ($opt{g}) { if ($opt{aborted}) { die "\n** Skipping exclude file generation on aborted session **\n"; } if (-e $excludefile) { print "\nExclude file ($excludefile) exists! Overwrite ((y)es/[no])? "; my $answer = ; unless ($answer =~ /^y(es)?$/io) { exit 0; } } create_excludelist(); } # # Set the exclude pattern # sub set_excl_pattern { my @excludes = get_excludelist(); $exclpattern = @excludes ? join('|', map{qr(\Q$_\E)} @excludes) : ' '; # default non-exclusive $exclpattern = qr{^($exclpattern)}o; } # # Read the exclude list if the file exists # Parameter: path of the exclude file # sub get_excludelist { my @excludelist; # XXX: Don't check command line params in a subroutine if (($opt{x} || $opt{L}) && -f $excludefile && -T $excludefile) { open(EXCLFILE, $excludefile) or die "Couldn't open $excludefile!"; while(my $exclude = ) { chomp($exclude); # Ignore comments and empty lines, add others to the list unless ($exclude =~ /(^ *#)|(^ *$)/o) { push(@excludelist, $exclude); } } close(EXCLFILE) or warn "Failed to close exclude file ($excludefile): $!\n"; } return @excludelist; } # # Return a list of all packages # sub get_packages { my @pkgs; opendir(DBDIR, $dbdir) or die "Can't open package db directory $dbdir!"; while (defined(my $file = readdir(DBDIR))) { my $path = join('/', $dbdir, $file); unless ($file =~ /^\.+$/o || !(-d $path)) { push @pkgs, [$file, -s $path . '/+REQUIRED_BY', join('/', $path, '+COMMENT')]; } } closedir DBDIR; return @pkgs; } # # Get a hash (name => comment) of all leaves # sub get_leaves { my %leaves; my @pkgs = get_packages(); foreach my $pkg (@pkgs) { my ($file, $required, $commentfile) = @$pkg; unless ($required) { if ($file =~ $exclpattern) { $leavestokeep{$file} = 1; } else { # Read package's short description/comment my $comment; if ((-s $commentfile) && (open(COMMENT, $commentfile))) { chomp($comment = ); } else { $comment = 'No short description'; } $leaves{$file} = $comment; } } } return %leaves; } # # Write the list of exclusions to a file # sub create_excludelist { open(EXCLFILE, ">$excludefile") or die "Failed to open exclude list ($excludefile): $!\n"; print EXCLFILE '# Auto-generated exclude list ', scalar localtime, "\n"; for (sort keys %leavestokeep) { /^(.+)-\d.+$/o ? print EXCLFILE $1, "\n" : warn 'Unable to extract exclude pattern from ', $_, "\n"; } print "New exclude list ($excludefile) generated.\n"; } Property changes on: head/ports-mgmt/pkg_cutleaves/files/pkg_cutleaves ___________________________________________________________________ Modified: cvs2svn:cvs-rev ## -1 +1 ## -1.1 \ No newline at end of property +1.2 \ No newline at end of property Index: head/ports-mgmt/pkg_cutleaves/files/pkg_cutleaves.1 =================================================================== --- head/ports-mgmt/pkg_cutleaves/files/pkg_cutleaves.1 (revision 209804) +++ head/ports-mgmt/pkg_cutleaves/files/pkg_cutleaves.1 (revision 209805) @@ -1,140 +1,154 @@ .\" PKG_CUTLEAVES 1 "Jul 2003" FreeBSD .\" -.Dd July 27, 2003 +.Dd March 20, 2008 .Dt PKG_CUTLEAVES 1 .Os FreeBSD .Sh NAME .Nm pkg_cutleaves .Nd deinstall 'leaf' packages .Sh SYNOPSIS .Nm -.Op Fl cFglRx +.Op Fl cFglRVx .Sh DESCRIPTION .Nm pkg_cutleaves finds installed .Dq Li "leaf" packages, i.e. packages that are not referenced by any other installed package, and lets you decide for each one if you want to keep or deinstall it (via pkg_delete(1)). Once the packages marked for removal have been flushed/deinstalled, you'll be asked if you want to do another run (i.e. to see packages that have become 'leaves' now because you've deinstalled the package(s) that depended on them. .Ar Note: see .Fl R below to bypass interactive dependency removal). In every run you will be shown only packages that you haven't marked for keeping, yet. .Pp Note that your package registry database should be up to date for this to work properly, so it might be a good idea to run pkgdb(1) before running .Nm . .Sh OPTIONS .Pp The following command line arguments are supported: .Pp .Bl -tag -width "-R" -compact .It Fl c When listing leaf packages, also print their comments/short descriptions. Will be ignored unless the .Fl l parameter is given, too. .Pp .It Fl F Run .Dq Li "pkgdb -F" after each deinstallation run, to make sure the package registry database is up to date. ( .Ar Note: This is mostly for convenience; it shouldn't be necessary to run .Dq Li "pkgdb -F" after each run, but it doesn't hurt, either.) .Pp .It Fl L Interpret exclude file as a list of leaf packages that .Ar should be installed. Report lint such as lines that match no installed packages or excluded packages that are not leaves. .Pp .It Fl g Generate the exclude list from kept or installed (when run with .Fl l or .Fl L ) leaf packages. .Pp .It Fl l List leaf packages only, one per line, and don't ask for anything to be deinstalled. .Pp +.It Fl V +Visual mode. Will compile a list of leaf packages and invoke the user's +.Ev EDITOR . +Lines or package names that are deleted in the editor will then be removed. +.Pp .It Fl R Autoprune mode. Automatically deinstall non-required packages on which the removed leaf packages depended. Will not remove packages on the exclude list if .Fl x is also in effect. .Pp .It Fl x Exclude packages matching expressions given in the exclude file. .El .Sh EXAMPLES .Pp .Bl -bullet .It Interactively cut leaf packages using the current exclude list: .Pp .Dl pkg_cutleaves -x .Pp .It List all current leaf packages with comments: .Pp .Dl pkg_cutleaves -lc .Pp .It List packages not currently excluded and regenerate a new exclude file with both the listed and previously excluded packages: .Pp .Dl pkg_cutleaves -lxg .Pp .It Interactively cut current leaf packages and remove newly discovered leaves, i.e. dependencies, automatically: .Pp .Dl pkg_cutleaves -R .Pp .It The same as the previous example but use the current exclude list to filter all first-level leaves and any newly discovered leaves. Generate a new exclude file with the remaining leaves: .Pp .Dl pkg_cutleaves -Rxg .Pp .It Find exclude patterns that match nothing and those that match required packages, i.e. non-leaves: .Pp .Dl pkg_cutleaves -L .El .Sh FILES .Bl -tag .It Pa /usr/local/etc/pkg_leaves.exclude An optional list for excluding packages when the .Fl x or .Fl L options are given. If the beginning of a package's name matches any line (except comment or empty lines) in this file, the package will not be listed/offered for removal (e.g., a line saying just .Ar XFree86 will exclude all packages with names starting with .Dq Li "XFree86" ). The list can be auto-generated with the .Fl g option. +.El +.Sh ENVIRONMENT +The following environment variables will be used in visual mode: +.Bl -tag -width EDITOR +.It Ev EDITOR +The editor specified by the variable +.Ev EDITOR +will be invoked instead of the default editor +.Xr vi 1 . .El .Sh SEE ALSO .Xr pkg_deinstall 1 , .Xr pkgdb 1 , .Xr portsclean 1 .Sh AUTHOR .An Stefan Walter Property changes on: head/ports-mgmt/pkg_cutleaves/files/pkg_cutleaves.1 ___________________________________________________________________ Modified: cvs2svn:cvs-rev ## -1 +1 ## -1.1 \ No newline at end of property +1.2 \ No newline at end of property