diff options
Diffstat (limited to 'sboremove')
| -rwxr-xr-x | sboremove | 201 |
1 files changed, 201 insertions, 0 deletions
diff --git a/sboremove b/sboremove new file mode 100755 index 0000000..d814afd --- /dev/null +++ b/sboremove @@ -0,0 +1,201 @@ +#!/usr/bin/env perl +# +# vim: set ts=4:noet +# +# sboremove +# script to remove an installed SlackBuild +# +# author: Luke Williams <xocel@iquidus.org> +# license: WTFPL <http://sam.zoy.org/wtfpl/COPYING> + +use 5.16.0; +use strict; +use warnings FATAL => 'all'; +use SBO::Lib; +use Getopt::Long qw(:config bundling); +use File::Basename; + +my $self = basename ($0); + +sub show_usage () { + print <<EOF +Usage: $self [options] sbo + +Options (defaults shown first where applicable): + -h|--help: + this screen. + -v|--version: + version information. + -R|--norequirements: + do not parse requirements. + -a|--alwaysask: + always ask to remove, even if required by other packages on system. + +Note: optional dependencies need to be removed separately. + +EOF +} + +my ($help, $vers, $non_int, $no_reqs, $alwaysask, @excluded); + +GetOptions ( + 'help|h' => \$help, + 'version|v' => \$vers, + 'norequirements|R' => \$no_reqs, + 'nointeractive' => \$non_int, + 'alwaysask|a' => \$alwaysask, +); + +show_usage and exit 0 if $help; +show_version and exit 0 if $vers; +show_usage and exit 0 unless exists $ARGV[0]; + +my $inst_names = get_inst_names (get_installed_sbos); + +# ensure that all provided arguments are valid sbos +my @arguments; +for my $sbo (@ARGV) { + if (get_sbo_location($sbo)) { + if ($sbo ~~ @$inst_names) { + push @arguments, $sbo; + } else { + say "$sbo is not installed"; + } + } else { + say "Unable to locate $sbo in the SlackBuilds.org tree." + } +} + +my %sbos{$_} = [] for @arguments; + +# wrapper to pull the list of requirements for a given sbo +# TODO: look at moving this into Lib.pm +sub get_requires ($) { + my $location = get_sbo_location (shift); + return get_from_info(LOCATION => $location, GET => 'REQUIRES') +} + +# populate the %sbos hash with requirements for each sbo +$sbos{$_} = get_requires $_ for keys $sbos; + +# clean the %sbos hash of anything that's already a hash key +while (my ($key, $val) = each %sbos) { + my @remove; + for my $key (keys @$val) { + push @remove, $key if $$val[$key] ~~ %sbos; + } + for my $rem (@remove) { + splice(@$val, $rem, 1); + $_-- for @remove; + } +} + +# now we have to go backwards - starting from the end, check every requirement +# to ensure that it's not already listed earlier. +for my $key (reverse %sbos) { + for my $sbo (@$key) { + # running out of var names, so prefix these with n for "next" + FIRST: while (my ($nkey, $nval) = each %sbos) { + # move on if we're looking at the same key we're starting with + next FIRST if $key == $nkey; + my @remove; + for my $key (keys @$nval) { + push @remove, $key if $key $$nval[$key] == $sbo; + } + for my $rem (@remove) { + splice(@$nval, $rem, 1) + $_-- for @remove; + } + } + } +} + +my ($remove_queue, %required_by, %warnings, @confirmed); + +# Determine required by for all installed sbo's +sub get_reverse_reqs () { + FIRST: for my $inst (@$inst_names) { + my $requires = get_requires $inst; + next FIRST unless $$requires[0]; + for my $req (@$requires) { + unless ( $req eq '%README%' ) { + push @{$required_by{$req}}, $inst if $req ~~ $inst_names; + } + } + } +} + +get_reverse_reqs unless $no_reqs; + +sub get_required_by ($) { + my $sbo = shift; + my @dep_of; + if ( $required_by{$sbo} ) { + for my $req_by (@{$required_by{$sbo}}) { + unless ($req_by ~~ @confirmed) { + push @dep_of, $req_by; + } + } + } + return \@dep_of; +} + +sub confirm_remove ($) { + my $sbo = shift; + push @confirmed, @sbo unless $sbo ~~ @confirmed; +} + +# Determine dependencies & warnings +if ($no_reqs) { + $remove_queue = \@remove; +} else { + $remove_queue = get_build_queue(\@remove, \%warnings); + @$remove_queue = reverse(@$remove_queue); +} + +# Check if packages in queue are actually installed on system +my @temp; +if ($inst_names) { + for my $sbo (@$remove_queue) { + push @temp, $sbo if $sbo ~~ @$inst_names; + } + $remove_queue = \@temp; +} + +if ($non_int) { + confirm_remove $_ for @$remove_queue; + goto CONFIRMED; +} + +for my $remove (@$remove_queue) { + my $required_by = get_required_by $remove; + + +CONFIRMED: + +# Show remove queue +my $remove_count = @confirmed; +if ($remove_count) { + say "Removing $remove_count package(s)"; + for my $pkg (@confirmed) { + print "$pkg "; + } + say "\n"; +} else { + say 'Nothing to remove.'; + exit 0; +} + +unless ($non_int) { + print 'Are you sure you want to continue? [n] : '; + unless (<STDIN> =~ /^[Yy]/) { + say 'Exiting.'; + exit 0; + } +} + +system ("/sbin/removepkg $_") for @confirmed; + +say "All operations have completed successfully."; + +exit 0; |