diff options
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 23 | ||||
| -rwxr-xr-x | sboremove | 133 | ||||
| -rwxr-xr-x | sboupgrade | 18 |
3 files changed, 161 insertions, 13 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 378d0a7..d084b14 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -8,6 +8,8 @@ # author: Jacob Pipkin <j@dawnrazor.net> # date: Setting Orange, the 37th day of Discord in the YOLD 3178 # license: WTFPL <http://sam.zoy.org/wtfpl/COPYING> +# +# modified by: Luke Williams <xocel@iquidus.org> use 5.16.0; use strict; @@ -27,6 +29,7 @@ our @EXPORT = qw( fetch_tree update_tree get_installed_sbos + get_inst_names get_available_updates do_slackbuild make_clean @@ -203,6 +206,16 @@ sub get_installed_sbos () { return \@installed; } +# for a ref to an array of hashes of installed packages, return an array ref +# consisting of just their names +sub get_inst_names ($) { + exists $_[0] or script_error 'get_inst_names requires an argument.'; + my $inst = shift; + my @installed; + push @installed, $$_{name} for @$inst; + return \@installed; +} + # search the SLACKBUILDS.TXT for a given sbo's directory sub get_sbo_location ($) { exists $_[0] or script_error 'get_sbo_location requires an argument.'; @@ -705,14 +718,14 @@ sub do_upgradepkg ($) { return 1; } -# add slackbuild to build queue. +# add slackbuild plus reqs to build queue. sub add_to_queue (%); sub add_to_queue (%) { my %args = %{$_[0]}; - my $infopath = get_sbo_location($args{NAME}); + my $location = get_sbo_location($args{NAME}); push(@{$_[0]}{QUEUE}, $args{NAME}); return 1 unless $args{RECURSIVE}; - my $requires = get_from_info (LOCATION => $infopath, GET => 'REQUIRES'); + my $requires = get_from_info (LOCATION => $location, GET => 'REQUIRES'); return unless $$requires[0]; for my $req (@$requires) { unless (( $req eq "%README%") or ($req eq $args{NAME})) { @@ -722,7 +735,7 @@ sub add_to_queue (%) { } } -# get full build queue and prepare it for output. +# get full build queue. sub get_build_queue ($) { exists $_[0] or script_error 'get_build_queue requires an argument.'; my @temp_queue = (); @@ -740,5 +753,5 @@ sub get_build_queue ($) { next if $seen{ $sb }++; push @build_queue, $sb; } - return @build_queue; + return \@build_queue; }
\ No newline at end of file diff --git a/sboremove b/sboremove new file mode 100755 index 0000000..fc9cadc --- /dev/null +++ b/sboremove @@ -0,0 +1,133 @@ +#!/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|--nointeractive: + non-interactive; skips all prompts. + -R|--norequirements: + do not parse requirements. + -e|--exclude (package): + exclude package (do not remove). + -f|--force: + force remove, even if required by other packages on system. + +EOF +} + +my ($help, $vers, $non_int, $no_reqs, @excluded); + +GetOptions ( + 'help|h' => \$help, + 'version|v' => \$vers, + 'nointeractive|r' => \$non_int, + 'norequirements|R' => \$no_reqs, + 'exclude|e=s' => \@excluded, +); + +show_usage and exit 0 if $help; +show_version and exit 0 if $vers; +show_usage and exit 0 unless exists $ARGV[0]; + +my $remove_queue; +push(@$remove_queue, $ARGV[0]); +my %ignore; + +unless ($no_reqs) { + for my $ex (@excluded) { + $ignore{$ex}="excluded by user"; + } + $remove_queue = get_build_queue($ARGV[0]); + my $installed = get_installed_sbos; + my $inst_names = get_inst_names $installed; + #print files... + for my $pkg (@$inst_names) { + unless ($pkg ~~ @$remove_queue) { + my $location = get_sbo_location($pkg); + my $requires = get_from_info (LOCATION => $location, GET => 'REQUIRES'); + next unless $$requires[0]; + for my $req (@$requires) { + if ($req ~~ @$remove_queue) { + $ignore{$req}="required by $pkg"; + push(@excluded, $req); + } + } + } + } +} +my $queue = join(" ", @$remove_queue); +say "Remove: $queue\n"; +# Removed excluded +my $exclude; +my @new = (); +for my $sb (@$remove_queue) { + $exclude = 0; + foreach (@excluded) { + if ( $_ eq $sb ) { + $exclude = 1; + } + } + unless ($exclude) { + push(@new, $sb); + } +} + +$remove_queue = \@new; + +# Show ignored +my $ignore_count = keys(%ignore); +if ($ignore_count) { + say "Ignoring $ignore_count package(s)."; + while ( my ($key, $value) = each(%ignore) ) { + say "$key : $value"; + } + print "\n"; +} + +# Show remove queue +my $remove_count = @$remove_queue; +if ($remove_count) { + say "Removing $remove_count package(s)."; + for my $i (@$remove_queue) { + print "$i\n"; + } + print "\n"; +} else { + say "Nothing to remove."; + exit 0; +} + +print 'Do you wish to proceed? [n] '; +unless (<STDIN> =~ /^[Yy]/) { + say "Exiting."; + exit 0; +} + +for my $instpkg (@$remove_queue) { + system("/sbin/removepkg $instpkg"); +} + +say "All operations completed successfully." @@ -108,13 +108,13 @@ sub get_readme_path ($) { # for a ref to an array of hashes of installed packages, return an array ref # consisting of just their names -sub get_inst_names ($) { - exists $_[0] or script_error 'get_inst_names requires an argument.'; - my $inst = shift; - my @installed; - push @installed, $$_{name} for @$inst; - return \@installed; -} +# sub get_inst_names ($) { +# exists $_[0] or script_error 'get_inst_names requires an argument.'; +# my $inst = shift; +# my @installed; +# push @installed, $$_{name} for @$inst; +# return \@installed; +# } # pull list of requirements sub get_requires ($$) { @@ -289,7 +289,9 @@ sub process_sbos ($) { if ($@) { $failures{$sbo} = $@; } else { - do_upgradepkg $pkg unless $no_install; + + do_upgradepkg $pkg unless $no_install; + unless ($distclean) { make_clean (SBO => $sbo, SRC => $src, VERSION => $version) unless $noclean; |