|
Lines 25-31
Link Here
|
| 25 |
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
25 |
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
| 26 |
# SUCH DAMAGE. |
26 |
# SUCH DAMAGE. |
| 27 |
# |
27 |
# |
| 28 |
# $FreeBSD: ports/sysutils/pkg_cutleaves/src/pkg_cutleaves,v 1.4 2003/12/31 15:12:54 pav Exp $ |
28 |
# $FreeBSD$ |
| 29 |
|
29 |
|
| 30 |
# Interactive script for deinstalling "leaf" packages; |
30 |
# Interactive script for deinstalling "leaf" packages; |
| 31 |
# requires the portupgrade tools |
31 |
# requires the portupgrade tools |
|
Lines 47-55
Link Here
|
| 47 |
my ($opt_comments, $opt_listonly, $opt_excludelist, $opt_recursive, $opt_pkgdb); |
47 |
my ($opt_comments, $opt_listonly, $opt_excludelist, $opt_recursive, $opt_pkgdb); |
| 48 |
my $exclpattern; |
48 |
my $exclpattern; |
| 49 |
|
49 |
|
|
|
50 |
# |
| 50 |
# Read the exclude list if the file exists |
51 |
# Read the exclude list if the file exists |
|
|
52 |
# Parameter: path of the exclude file |
| 53 |
# |
| 51 |
sub get_excl_pattern { |
54 |
sub get_excl_pattern { |
| 52 |
my $excl_file = $_[0]; |
55 |
my $excl_file = shift; |
| 53 |
my $excl_pattern; |
56 |
my $excl_pattern; |
| 54 |
# Does the exclude file exist? |
57 |
# Does the exclude file exist? |
| 55 |
if (($excl_file) && (-f $excl_file) && (-T $excl_file)) { |
58 |
if (($excl_file) && (-f $excl_file) && (-T $excl_file)) { |
|
Lines 62-72
Link Here
|
| 62 |
# Ignore comments and empty lines, add others as regular expressions |
65 |
# Ignore comments and empty lines, add others as regular expressions |
| 63 |
unless (($exclude =~ m/(^ *#)|(^ *$)/)) { |
66 |
unless (($exclude =~ m/(^ *#)|(^ *$)/)) { |
| 64 |
$exclude = "^" . $exclude . ".*"; |
67 |
$exclude = "^" . $exclude . ".*"; |
| 65 |
@excludes = (@excludes, $exclude); |
68 |
push @excludes, $exclude; |
| 66 |
} |
69 |
} |
| 67 |
} |
70 |
} |
| 68 |
close(EXCLFILE); |
71 |
close(EXCLFILE); |
| 69 |
$excl_pattern = join("|", @excludes); |
72 |
# Provide a dummy exclusion pattern if @excludes is empty |
|
|
73 |
$excl_pattern = scalar(@excludes) ? join("|", @excludes) : " "; |
| 70 |
} else { |
74 |
} else { |
| 71 |
# Dummy exclusion pattern -> doesn't exclude anything |
75 |
# Dummy exclusion pattern -> doesn't exclude anything |
| 72 |
$excl_pattern = " "; |
76 |
$excl_pattern = " "; |
|
Lines 74-83
Link Here
|
| 74 |
return $excl_pattern; |
78 |
return $excl_pattern; |
| 75 |
} |
79 |
} |
| 76 |
|
80 |
|
|
|
81 |
# |
| 77 |
# Get a hash (name => comment) of all leaves |
82 |
# Get a hash (name => comment) of all leaves |
|
|
83 |
# Parameters: - path to package database |
| 84 |
# - pattern of packages to exclude |
| 85 |
# |
| 78 |
sub get_leaves { |
86 |
sub get_leaves { |
| 79 |
my $db_dir = $_[0]; |
87 |
my $db_dir = shift; |
| 80 |
my $excl_pattern = $_[1]; |
88 |
my $excl_pattern = shift; |
| 81 |
my %leaves; |
89 |
my %leaves; |
| 82 |
opendir(DBDIR, $db_dir) |
90 |
opendir(DBDIR, $db_dir) |
| 83 |
or die "Can't open package db directory $db_dir!"; |
91 |
or die "Can't open package db directory $db_dir!"; |
|
Lines 151-156
Link Here
|
| 151 |
my %leavestokeep; |
159 |
my %leavestokeep; |
| 152 |
my %leavestocut; |
160 |
my %leavestocut; |
| 153 |
my @cutleaves; |
161 |
my @cutleaves; |
|
|
162 |
my ($nleaves, $i); |
| 154 |
# Loop while the user wants to |
163 |
# Loop while the user wants to |
| 155 |
my $again = "y"; |
164 |
my $again = "y"; |
| 156 |
ROUND: while($again eq "y") { |
165 |
ROUND: while($again eq "y") { |
|
Lines 163-177
Link Here
|
| 163 |
} |
172 |
} |
| 164 |
} |
173 |
} |
| 165 |
# Any leaves left? |
174 |
# Any leaves left? |
| 166 |
if (keys(%leaves) == 0) { |
175 |
$nleaves = keys %leaves; |
|
|
176 |
if ($nleaves == 0) { |
| 167 |
# If not, don't go on, there's nothing left to do. |
177 |
# If not, don't go on, there's nothing left to do. |
| 168 |
print "Didn't find any new leaves, exiting.\n"; |
178 |
print "Didn't find any new leaves, exiting.\n"; |
| 169 |
last ROUND; |
179 |
last ROUND; |
| 170 |
} |
180 |
} |
| 171 |
# Always start with an empty list of leaves to cut |
181 |
# Always start with an empty list of leaves to cut |
| 172 |
%leavestocut = (); |
182 |
%leavestocut = (); |
|
|
183 |
# Initialize counter for progress status |
| 184 |
$i = 1; |
| 173 |
|
185 |
|
| 174 |
LEAVESLOOP: foreach my $leaf (sort keys %leaves) { |
186 |
LEAVESLOOP: foreach my $leaf (sort keys %leaves) { |
|
|
187 |
print "Package $i of $nleaves:\n"; |
| 175 |
print "$leaf - $leaves{$leaf}\n"; |
188 |
print "$leaf - $leaves{$leaf}\n"; |
| 176 |
print "$leaf - [keep]/(d)elete/(f)lush marked pkgs/(a)bort? "; |
189 |
print "$leaf - [keep]/(d)elete/(f)lush marked pkgs/(a)bort? "; |
| 177 |
# Get first character of input, without leading whitespace |
190 |
# Get first character of input, without leading whitespace |
|
Lines 192-197
Link Here
|
| 192 |
print "** Keeping $leaf.\n\n"; |
205 |
print "** Keeping $leaf.\n\n"; |
| 193 |
$leavestokeep{$leaf} = 1; |
206 |
$leavestokeep{$leaf} = 1; |
| 194 |
} |
207 |
} |
|
|
208 |
$i++; |
| 195 |
} # LEAVESLOOP |
209 |
} # LEAVESLOOP |
| 196 |
|
210 |
|
| 197 |
# Initialize 'progress meter' |
211 |
# Initialize 'progress meter' |
|
Lines 211-217
Link Here
|
| 211 |
print STDERR "\n\n$0: pkg_deinstall returned $status - exiting, fix this first.\n\n"; |
225 |
print STDERR "\n\n$0: pkg_deinstall returned $status - exiting, fix this first.\n\n"; |
| 212 |
last ROUND; |
226 |
last ROUND; |
| 213 |
} |
227 |
} |
| 214 |
@cutleaves = (@cutleaves, $leaf); |
228 |
push @cutleaves, $leaf; |
| 215 |
} |
229 |
} |
| 216 |
|
230 |
|
| 217 |
# Run 'pkgdb -F' if requested |
231 |
# Run 'pkgdb -F' if requested |