sboremove: minor fixes, moved get_requires to lib.pm, added tests, updated man page, more comments

8 files changed, 237 insertions, 62 deletions

diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index 5844868..47a379d 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -30,6 +30,7 @@ our @EXPORT = qw(
 	get_installed_sbos
 	get_inst_names
 	get_available_updates
+	get_requires
 	do_slackbuild
 	make_clean
 	make_distclean
@@ -722,6 +723,13 @@ sub do_upgradepkg ($) {
 	return 1;
 }
 
+# wrapper to pull the list of requirements for a given sbo
+sub get_requires ($) {
+	my $location = get_sbo_location(shift);
+	return unless $location;
+	my $info = get_from_info(LOCATION => $location, GET => 'REQUIRES');
+	return $$info[0] ne '' ? $info : undef;
+}
 
 # avoid being called to early to check prototype when add_to_queue calls itself
 sub add_to_queue ($);
@@ -731,9 +739,7 @@ sub add_to_queue ($) {
 	my $sbo = \${$args}{NAME};
 	return unless $$sbo;
 	push @$args{QUEUE}, $$sbo;
-	my $location = get_sbo_location ($$sbo);
-	return unless $location;
-	my $requires = get_from_info (LOCATION => $location, GET => 'REQUIRES');
+	my $requires = get_requires $$sbo;
 	FIRST: for my $req (@$requires) {
 		next FIRST if $req eq $$sbo;
 		if ($req eq "%README%") {
diff --git a/man1/sboremove.1 b/man1/sboremove.1
index eea766a..9c075cf 100644
--- a/man1/sboremove.1
+++ b/man1/sboremove.1
@@ -4,7 +4,7 @@
 sboremove - remove packages installed from slackbuilds
 .SH SYNAPSES
 .P
-sboremove [-h|-v] [-aR] sbo_name
+sboremove [-h|-v] [-a] sbo_name
 .SH DESCRIPTION
 .P
 sboremove is used to remove packages installed from slackbuilds. It pulls the list of requirements from the .info file for any specified slackbuild. If such a list exists, sboremove will look to see whether or not those requirements are installed. Those that are will then be checked to see whether they are requirements of other packages also installed. If a package is no longer required, or the -a flag is specified sboremove will ask whether or not it should also remove it from the system.  
@@ -20,11 +20,6 @@ Show help information.
 Show version information.
 .RE
 .P
--R|--norequirements
-.RS
-This option causes sboremove to skip requirement handling, removing a single package only. 
-.RE
-.P
 -a|--alwaysask
 .RS
 Always ask to remove requirements, even those required by other packages currently installed (ignored by default)
@@ -35,6 +30,8 @@ None known, but there may be some. Please report any found to xocel@iquidus.org;
 .SH SEE ALSO
 .P
 sboupgrade(1), sbocheck(1), sboclean(1), sboconfig(1), sbofind(1), sboinstall(1), sbosnap(1), sbotools.conf(5)
-.SH AUTHOR
+.SH AUTHORS
 .P
 Luke Williams <xocel@iquidus.org>
+.P
+Jacob Pipkin <j@dawnrazor.net>
diff --git a/sboremove b/sboremove
index 995bc5a..8e5b79b 100755
--- a/sboremove
+++ b/sboremove
@@ -48,32 +48,29 @@ 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;
+my @sbos;
+my $inst_names = get_inst_names(get_installed_sbos);
 for my $sbo (@ARGV) {
 	if (get_sbo_location($sbo)) {
-		$sbo ~~ @$inst_names ? push @arguments, $sbo
+		$sbo ~~ @$inst_names ? push @sbos, $sbo
                              : say "$sbo is not installed";
 	} else {
 		say "Unable to locate $sbo in the SlackBuilds.org tree."
 	}
 }
-
-# one array of each cli-specified sbo to remove...
-my @sbos = @arguments;
 exit 0 unless exists $sbos[0];
 
-# 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');
-}
+# # wrapper to pull the list of requirements for a given sbo
+# sub get_requires ($) {
+# 	my $location = get_sbo_location(shift);
+# 	return unless $location;
+# 	my $info = get_from_info(LOCATION => $location, GET => 'REQUIRES');
+# 	return $$info[0] ne '' ? $info : undef;
+# }
 
-my ($remove_queue, %required_by, %warnings, @confirmed);
 # Create full queue. 
+my ($remove_queue, %warnings);
 for my $sbo (@sbos) {
     my $queue = get_build_queue ([$sbo], \%warnings);
     @$queue = reverse(@$queue);
@@ -81,28 +78,30 @@ for my $sbo (@sbos) {
 }
 
 # Read requires for each item in queue (needed for later on, %README% etc)
-# TODO: look at returning this info back from the queue subs as they process
-# this info to make the queues, however they do not store it anywhere, resulting 
-# in the current double handling of the .info files :/ 
 my %req_store;
 $req_store{$_} = get_requires $_ for @$remove_queue;
-#print "Q: " . join(' ', @$remove_queue) . "\n";
 
 # Determine required by for all installed sbo's
-sub get_reverse_reqs() {
-	FIRST: for my $inst (@$inst_names) {
+my (%required_by, @confirmed);
+
+# populates the required_by hash 
+sub get_reverse_reqs ($) {
+	my $installed = shift;
+	FIRST: for my $inst (@$installed) {
 		my $require = get_requires $inst;
 		next FIRST unless $$require[0];
 		for my $req (@$require) {
 			unless ( $req eq '%README%' ) {
-				push @{$required_by{$req}}, $inst if $req ~~ $inst_names;
+				push @{$required_by{$req}}, $inst if $req ~~ @$installed;
 			}		
 		}	
 	}
 }
-get_reverse_reqs;
+get_reverse_reqs $inst_names;
 
-sub get_required_by($) {
+# returns a list of installed sbo's that list the given sbo as a requirement,
+# excluding any installed sbo's that have already been confirmed for removal
+sub get_required_by ($) {
 	my $sbo = shift;
 	my @dep_of;
 	if ( $required_by{$sbo} ) {
@@ -112,10 +111,10 @@ sub get_required_by($) {
 			}
 		}
 	}
-	return \@dep_of;
+	return exists $dep_of[0] ? \@dep_of : undef;
 }
 
-sub confirm_remove($) {
+sub confirm_remove ($) {
 	my $sbo = shift;
 	push @confirmed, $sbo unless $sbo ~~ @confirmed;
 }
@@ -134,24 +133,28 @@ if ($non_int) {
 	confirm_remove $_ for @$remove_queue;
 	goto CONFIRMED;
 }
-# Prompt user
+
+# Begin prompts
 FIRST: for my $remove (@$remove_queue) {
+	# Determine whether $remove is still needed on system.
 	my $required_by = get_required_by $remove;
-	my $needed = 0; # True if sbo is still needed on system, otherwise false.
+	my $needed = 0;
 	for my $rq (@$required_by) {
 		$needed = 1 unless $rq ~~ @confirmed or $remove ~~ @sbos;
-	}
-	
+		# still needed, unless required_by is already confirmed for removal or
+		# the sbo in question was cli-specified.
+	}	
 	if ( $needed ) {
-		next FIRST unless $alwaysask;
+		next FIRST unless $alwaysask; #ignore sbo and skip prompt
 		print "$remove : required by " . join(' ', @$required_by) . "\n";
 	} else {
 		say "$remove";
 	}
 
+	# Check for %README% value and inform user.
 	my @reqz = $req_store{$remove};
 	if ( "%README%" ~~ @reqz ) {
-		print "It is recommended that you view the README before continuing..\n";
+		say "It is recommended that you view the README before continuing.";
 		print "Display README now? [y]: ";
 		my $location = get_sbo_location($remove);
 		my $fh = open_read ($location .'/README');
@@ -160,9 +163,17 @@ FIRST: for my $remove (@$remove_queue) {
 
 		print "\n" . $readme if <STDIN> =~ /^[Yy\n]/;
 	}
-	print "Remove $remove? [y]: ";
-	 
-	if ( <STDIN> =~ /^[Yy\n]/ ) {
+
+	# Determine default behavior for prompt
+	my $default = 'y';
+	my $regex = "[Yy\n]";
+	if ($needed) {
+		$default = 'n'; 
+		$regex = "[Yy]"; 
+	}
+	# Ask user to confirm removal
+	print "Remove $remove? [$default]: ";
+	if (<STDIN> =~ /^$regex/) {
 		confirm_remove($remove);
 		say " * Added to remove queue\n";
 	} else {
@@ -171,19 +182,19 @@ FIRST: for my $remove (@$remove_queue) {
 }	
 
 CONFIRMED:
-
 # Show remove queue
 my $remove_count = @confirmed;
 if ($remove_count) {
 	say "Removing $remove_count package(s)";
-	print join(' ', @confirmed) . "\n\n";
+	print join(' ', @confirmed) . "\n";
 } else {
 	say 'Nothing to remove.';
 	exit 0;
 }
 
+# Final confirmation
 unless ($non_int) {
-	print 'Are you sure you want to continue? [n] : ';
+	print "\nAre you sure you want to continue? [n] : ";
 	unless (<STDIN> =~ /^[Yy]/) {
 		say 'Exiting.';
 		exit 0;
diff --git a/t/packages/unetbootin-575-x86_64-1_SBo b/t/packages/unetbootin-575-x86_64-1_SBo
new file mode 100644
index 0000000..885b0cf
--- /dev/null
+++ b/t/packages/unetbootin-575-x86_64-1_SBo
@@ -0,0 +1,124 @@
+PACKAGE NAME:     unetbootin-575-x86_64-1_SBo
+COMPRESSED PACKAGE SIZE:     564K
+UNCOMPRESSED PACKAGE SIZE:     1.9M
+PACKAGE LOCATION: /tmp/unetbootin-575-x86_64-1_SBo.tgz
+PACKAGE DESCRIPTION:
+unetbootin: UNetbootin (create bootable Live USB drives)
+unetbootin:
+unetbootin: UNetbootin lets you create bootable live usb drives for Linux
+unetbootin: distributions without burning a CD.
+unetbootin:
+unetbootin: Homepage: http://unetbootin.sourceforge.net
+unetbootin:
+unetbootin:
+unetbootin:
+unetbootin:
+unetbootin:
+FILE LIST:
+./
+install/
+install/doinst.sh
+install/slack-desc
+usr/
+usr/bin/
+usr/bin/unetbootin
+usr/share/
+usr/share/pixmaps/
+usr/share/pixmaps/unetbootin.svg
+usr/share/unetbootin/
+usr/share/unetbootin/unetbootin_el.qm
+usr/share/unetbootin/unetbootin_eu.qm
+usr/share/unetbootin/unetbootin_he.qm
+usr/share/unetbootin/unetbootin_es.qm
+usr/share/unetbootin/unetbootin_bn.qm
+usr/share/unetbootin/unetbootin_cs.qm
+usr/share/unetbootin/unetbootin_hr.qm
+usr/share/unetbootin/unetbootin_lt.qm
+usr/share/unetbootin/unetbootin_pl.qm
+usr/share/unetbootin/unetbootin_lv.qm
+usr/share/unetbootin/unetbootin_da.qm
+usr/share/unetbootin/unetbootin_am.qm
+usr/share/unetbootin/unetbootin_ml.qm
+usr/share/unetbootin/unetbootin_ja.qm
+usr/share/unetbootin/unetbootin_nb.qm
+usr/share/unetbootin/unetbootin_gl.qm
+usr/share/unetbootin/unetbootin_tr.qm
+usr/share/unetbootin/unetbootin_nn.qm
+usr/share/unetbootin/unetbootin_fr.qm
+usr/share/unetbootin/unetbootin_ms.qm
+usr/share/unetbootin/unetbootin_vi.qm
+usr/share/unetbootin/unetbootin_it.qm
+usr/share/unetbootin/unetbootin_nan.qm
+usr/share/unetbootin/unetbootin_uk.qm
+usr/share/unetbootin/unetbootin_fo.qm
+usr/share/unetbootin/unetbootin_be.qm
+usr/share/unetbootin/unetbootin_fi.qm
+usr/share/unetbootin/unetbootin_ru.qm
+usr/share/unetbootin/unetbootin_ca.qm
+usr/share/unetbootin/unetbootin_sk.qm
+usr/share/unetbootin/unetbootin.qm
+usr/share/unetbootin/unetbootin_ast.qm
+usr/share/unetbootin/unetbootin_id.qm
+usr/share/unetbootin/unetbootin_sv.qm
+usr/share/unetbootin/unetbootin_sr.qm
+usr/share/unetbootin/unetbootin_sw.qm
+usr/share/unetbootin/unetbootin_pt_BR.qm
+usr/share/unetbootin/unetbootin_eo.qm
+usr/share/unetbootin/unetbootin_zh_TW.qm
+usr/share/unetbootin/unetbootin_hu.qm
+usr/share/unetbootin/unetbootin_pt.qm
+usr/share/unetbootin/unetbootin_zh_CN.qm
+usr/share/unetbootin/unetbootin_de.qm
+usr/share/unetbootin/unetbootin_ro.qm
+usr/share/unetbootin/unetbootin_nl.qm
+usr/share/unetbootin/unetbootin_bg.qm
+usr/share/unetbootin/unetbootin_ar.qm
+usr/share/unetbootin/unetbootin_et.qm
+usr/share/unetbootin/unetbootin_sl.qm
+usr/share/unetbootin/unetbootin_ur.qm
+usr/share/icons/
+usr/share/icons/hicolor/
+usr/share/icons/hicolor/32x32/
+usr/share/icons/hicolor/32x32/apps/
+usr/share/icons/hicolor/32x32/apps/unetbootin.png
+usr/share/icons/hicolor/128x128/
+usr/share/icons/hicolor/128x128/apps/
+usr/share/icons/hicolor/128x128/apps/unetbootin.png
+usr/share/icons/hicolor/14x14/
+usr/share/icons/hicolor/14x14/apps/
+usr/share/icons/hicolor/14x14/apps/unetbootin.png
+usr/share/icons/hicolor/scalable/
+usr/share/icons/hicolor/scalable/apps/
+usr/share/icons/hicolor/scalable/apps/unetbootin.svg
+usr/share/icons/hicolor/22x22/
+usr/share/icons/hicolor/22x22/apps/
+usr/share/icons/hicolor/22x22/apps/unetbootin.png
+usr/share/icons/hicolor/48x48/
+usr/share/icons/hicolor/48x48/apps/
+usr/share/icons/hicolor/48x48/apps/unetbootin.png
+usr/share/icons/hicolor/256x256/
+usr/share/icons/hicolor/256x256/apps/
+usr/share/icons/hicolor/256x256/apps/unetbootin.png
+usr/share/icons/hicolor/16x16/
+usr/share/icons/hicolor/16x16/apps/
+usr/share/icons/hicolor/16x16/apps/unetbootin.png
+usr/share/icons/hicolor/64x64/
+usr/share/icons/hicolor/64x64/apps/
+usr/share/icons/hicolor/64x64/apps/unetbootin.png
+usr/share/icons/hicolor/192x192/
+usr/share/icons/hicolor/192x192/apps/
+usr/share/icons/hicolor/192x192/apps/unetbootin.png
+usr/share/icons/hicolor/24x24/
+usr/share/icons/hicolor/24x24/apps/
+usr/share/icons/hicolor/24x24/apps/unetbootin.png
+usr/share/icons/hicolor/512x512/
+usr/share/icons/hicolor/512x512/apps/
+usr/share/icons/hicolor/512x512/apps/unetbootin.png
+usr/share/applications/
+usr/share/applications/unetbootin.desktop
+usr/doc/
+usr/doc/unetbootin-575/
+usr/doc/unetbootin-575/INSTALL
+usr/doc/unetbootin-575/README.TXT
+usr/doc/unetbootin-575/README.issues
+usr/doc/unetbootin-575/unetbootin.SlackBuild
diff --git a/t/prep.pl b/t/prep.pl
index c0f7035..5c40495 100755
--- a/t/prep.pl
+++ b/t/prep.pl
@@ -22,6 +22,8 @@ for my $thing (qw(interactive compat32 no_readme jobs distclean noclean
 	pr $thing;
 }
 
+print {$write} "my \%required_by;\n";
+print {$write} "our \@confirmed;\n";
 print {$write} "my \%locations;\n";
 print {$write} "my \%commands;\n";
 print {$write} "my \%options = (nothing => 'to see here');\n";
@@ -50,7 +52,7 @@ sub get_subs ($) {
 	}
 }
 
-for my $file (qw(sbocheck sboclean sboconfig sbofind sboupgrade)) {
+for my $file (qw(sbocheck sboclean sboconfig sbofind sboupgrade sboremove)) {
 	open my $read, '<', "../$file";
 	get_subs $read;
 	close $read;
diff --git a/t/sbo/games/doomseeker/doomseeker.info b/t/sbo/games/doomseeker/doomseeker.info
new file mode 100644
index 0000000..3374966
--- /dev/null
+++ b/t/sbo/games/doomseeker/doomseeker.info
@@ -0,0 +1,10 @@
+PRGNAM="doomseeker"
+VERSION="0.9b"
+HOMEPAGE="http://doomseeker.drdteam.org/"
+DOWNLOAD="http://doomseeker.drdteam.org/files/doomseeker-0.9b_src.tar.bz2"
+MD5SUM="bd922eb6b0f883bbc07155b3b75bb63b"
+DOWNLOAD_x86_64=""
+MD5SUM_x86_64=""
+REQUIRES="%README%"
+MAINTAINER="B. Watson"
+EMAIL="yalhcru@gmail.com"
diff --git a/t/sbo/system/unetbootin/unetbootin.info b/t/sbo/system/unetbootin/unetbootin.info
new file mode 100644
index 0000000..0c4d250
--- /dev/null
+++ b/t/sbo/system/unetbootin/unetbootin.info
@@ -0,0 +1,10 @@
+PRGNAM="unetbootin"
+VERSION="575"
+HOMEPAGE="http://unetbootin.sourceforge.net"
+DOWNLOAD="http://sourceforge.net/projects/unetbootin/files/UNetbootin/575/unetbootin-source-575.tar.gz"
+MD5SUM="40311d948104d29031e9fa0baec1504c"
+DOWNLOAD_x86_64=""
+MD5SUM_x86_64=""
+REQUIRES="p7zip"
+MAINTAINER="Jens Weber"
+EMAIL="jens@tuxane.com"
diff --git a/t/test.t b/t/test.t
index 952b601..f8b918b 100755
--- a/t/test.t
+++ b/t/test.t
@@ -66,8 +66,8 @@ for my $key (keys @$installed) {
 		'libdvdnav';
 	is ($$installed[$key]{version}, '0.8.8.4') if $$installed[$key]{name} eq
 		'libmodplug';
-	is ($$installed[$key]{version}, '3.12.4') if $$installed[$key]{name} eq
-		'mozilla-nss';
+	is ($$installed[$key]{version}, '575') if $$installed[$key]{name} eq
+		'unetbootin';
 	is ($$installed[$key]{version}, '2.6.0') if $$installed[$key]{name} eq
 		'zdoom';
 }
@@ -293,18 +293,17 @@ ok ('zdoom' ~~ @$inst_names, 'get_inst_names is good');
 
 # get_reqs tests
 # $SBO::Lib::no_reqs = 0;
-# # no longer valid - there are no longer any circular requirements.
-# #ok (! (get_requires 'zarafa', "$sbo_home/network/zarafa"),
-# #	'get_requires good for circular requirements');
-# my $reqs = get_requires 'gmpc', "$sbo_home/audio/gmpc";
-# my $say = 'get_requires good for normal req list';
-# is ($$reqs[0], 'gob2', $say);
-# is ($$reqs[1], 'libmpd', $say);
-# is ($$reqs[2], 'vala', $say);
-# ok (! (get_requires 'smc', "$sbo_home/games/smc"),
-# 	'get_requires good for REQUIRES="%README%"');
-# ok (! (get_requires 'krb5', "$sbo_home/network/krb5"),
-# 	'get_requires good for REQUIRES=""');
+# no longer valid - there are no longer any circular requirements.
+# ok (! (get_requires 'zarafa', "$sbo_home/network/zarafa"),
+#	'get_requires good for circular requirements');
+my $reqs = get_requires 'gmpc';#, "$sbo_home/audio/gmpc";
+my $say = 'get_requires good for normal req list';
+is ($$reqs[0], 'gob2', $say);
+is ($$reqs[1], 'libmpd', $say);
+is ($$reqs[2], 'vala', $say);
+$reqs = get_requires 'doomseeker';
+is ($$reqs[0], '%README%', 'get_requires good for REQUIRES="%README%"');
+is (get_requires 'krb5', undef, 'get_requires good for REQUIRES=""');
 
 # get_user_group tests
 $fh = open_read "$sbo_home/network/nagios/README";
@@ -374,5 +373,21 @@ is ($$queue[0], 'p7zip', 'get_build_queue first entry correct for single sbo');
 is ($$queue[2], 'eawpats', 'get_build_queue third entry correct for single sbo');
 is ($$queue[4], 'zdoom', 'get_build_queue fifth entry correct for single sbo');
 
+# test get_required_by
+get_reverse_reqs $inst_names;
+my $required = get_required_by 'p7zip';
+is ($$required[0], 'unetbootin', 'get_required_by good for populated req_by list');
+is ($$required[1], 'zdoom', 'get_required_by good for populated req_by list');
+is ( get_required_by 'zdoom', undef, 'get_required_by good for empty req_by list');
+
+# test confirm_remove
+@SBO::Lib::confirmed=('p7zip', 'eawpats', 'bsnes');
+confirm_remove('zdoom');
+$count = @SBO::Lib::confirmed;
+is ($count, 4, 'confirm_remove good for new sbo');
+confirm_remove('zdoom');
+$count = @SBO::Lib::confirmed;
+is ($count, 4, 'confirm_remove good for duplicate sbo');
+
 # end of tests.
 done_testing();