diff options
Diffstat (limited to 'ports-mgmt/pkg_cutleaves/src/pkg_cutleaves')
| -rw-r--r-- | ports-mgmt/pkg_cutleaves/src/pkg_cutleaves | 254 |
1 files changed, 0 insertions, 254 deletions
diff --git a/ports-mgmt/pkg_cutleaves/src/pkg_cutleaves b/ports-mgmt/pkg_cutleaves/src/pkg_cutleaves deleted file mode 100644 index 8c3507a06eee..000000000000 --- a/ports-mgmt/pkg_cutleaves/src/pkg_cutleaves +++ /dev/null @@ -1,254 +0,0 @@ -#!/usr/bin/perl -# -# Copyright (c) 2003 Stefan Walter <sw@gegenunendlich.de> -# -# 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. -# -# $FreeBSD$ - -# Interactive script for deinstalling "leaf" packages; -# requires the portupgrade tools -# -# Syntax: pkg_cutleaves [-c] [-F] [-l] [-R] [-x] -# Options: -# -c: Show comments, too; only works with '-l' (ignored otherwise) -# -F: Fix package db after each deinstallation run (via 'pkgdb -F') -# -l: List leaf packages only, don't ask if they should be deinstalled -# -R: Run 'pkg_deinstall -R' instead of plain 'pkg_deinstall' -# -x: Honor exclude list in $excludefile - -use strict; - -my $dbdir = "/var/db/pkg"; -my $excludefile = "/usr/local/etc/pkg_leaves.exclude"; -my $pkgdeinstall = "/usr/local/sbin/pkg_deinstall"; -my @pkgdb_args = ("/usr/local/sbin/pkgdb", "-F"); -my ($opt_comments, $opt_listonly, $opt_excludelist, $opt_recursive, $opt_pkgdb); -my $exclpattern; - -# -# Read the exclude list if the file exists -# Parameter: path of the exclude file -# -sub get_excl_pattern { - my $excl_file = shift; - my $excl_pattern; - # Does the exclude file exist? - if (($excl_file) && (-f $excl_file) && (-T $excl_file)) { - # Read the patterns to be excluded - my @excludes; - open(EXCLFILE, $excl_file) - or die "Couldn't open $excl_file!"; - while(my $exclude = <EXCLFILE>) { - chomp($exclude); - # Ignore comments and empty lines, add others as regular expressions - unless (($exclude =~ m/(^ *#)|(^ *$)/)) { - $exclude = "^" . $exclude . ".*"; - push @excludes, $exclude; - } - } - close(EXCLFILE); - # Provide a dummy exclusion pattern if @excludes is empty - $excl_pattern = scalar(@excludes) ? join("|", @excludes) : " "; - } else { - # Dummy exclusion pattern -> doesn't exclude anything - $excl_pattern = " "; - } - return $excl_pattern; -} - -# -# Get a hash (name => comment) of all leaves -# Parameters: - path to package database -# - pattern of packages to exclude -# -sub get_leaves { - my $db_dir = shift; - my $excl_pattern = shift; - my %leaves; - opendir(DBDIR, $db_dir) - or die "Can't open package db directory $db_dir!"; - while(defined(my $file = readdir(DBDIR))) { - my $path = $db_dir . '/' . $file; - my $reqlist = $path . '/+REQUIRED_BY'; - my $commentfile = $path . '/+COMMENT'; - # Exclude non-directories, "." and ".." - if (($file ne ".") && ($file ne "..") && (-d $path) && (!-s $reqlist)) { - # Exclude packages matching exclude pattern, if requested - unless ($file =~ m/$excl_pattern/) { - # Read package's short description/comment - my $comment; - if ((-s $commentfile) && (open(COMMENT, $commentfile))) { - $comment = <COMMENT>; - chomp($comment); - close(COMMENT); - } else { - $comment = "No short description"; - } - $leaves{$file} = $comment; - } - } - } - closedir(DBDIR); - return %leaves; -} - -# Examine command line arguments -while(@ARGV) { - my $arg = shift(@ARGV); - if ($arg eq "-c") { - $opt_comments = 1; - } - elsif ($arg eq "-F") { - $opt_pkgdb = 1; - } - elsif ($arg eq "-l") { - $opt_listonly = 1; - } - elsif ($arg eq "-R") { - $opt_recursive = 1; - } - elsif ($arg eq "-x") { - $opt_excludelist = 1; - } else { - warn "Unrecognized command line argument $arg ignored.\n"; - } -} - -# Exclusion requested? -if ($opt_excludelist) { - # Get exclusion pattern - $exclpattern = get_excl_pattern($excludefile); -} else { - # Spaces don't appear in package names -> this doesn't exclude anything - $exclpattern = " "; -} - -if ($opt_listonly) { - # Just print out the list of leaves, one per line - my %leaves = get_leaves($dbdir, $exclpattern); - foreach my $leaf (sort keys %leaves) { - if ($opt_comments) { - print "$leaf - $leaves{$leaf}\n"; - } else { - print "$leaf\n"; - } - } -} else { - my %leavestokeep; - my %leavestocut; - my @cutleaves; - my ($nleaves, $i); - # Loop while the user wants to - my $again = "y"; - ROUND: while($again eq "y") { - # Get list of leaf packages and put them into a hash - my %leaves = get_leaves($dbdir, $exclpattern); - # Ignore all leaves the user already told us to keep - foreach my $leaf (keys %leavestokeep) { - if ($leaves{$leaf}) { - 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, exiting.\n"; - last ROUND; - } - # Always start with an empty list of leaves to cut - %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(<STDIN>) =~ 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"; - last ROUND; - } - else { - print "** Keeping $leaf.\n\n"; - $leavestokeep{$leaf} = 1; - } - $i++; - } # LEAVESLOOP - - # 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; - if ($opt_recursive) { - @deinstall_args = ($pkgdeinstall, '-R', $leaf); - } else { - @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_pkgdb) { - 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; - } - } - - print "Go on with new leaf packages ((y)es/[no])? "; - # Get first character of input, without leading whitespace - ($again) = (lc(<STDIN>) =~ m/(\S)/); - 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"; -} - |