1 files changed, 144 insertions, 179 deletions

diff --git a/sboupgrade b/sboupgrade
index 2daedb9..cf4468a 100755
--- a/sboupgrade
+++ b/sboupgrade
@@ -9,6 +9,7 @@
 # date: Boomtime, the 39th day of Discord in the YOLD 3178
 # license: WTFPL <http://sam.zoy.org/wtfpl/COPYING>
 
+use 5.16.0;
 use SBO::Lib;
 use File::Basename;
 use Getopt::Std;
@@ -19,7 +20,7 @@ use warnings FATAL => 'all';
 my %config = %SBO::Lib::config;
 my $self = basename ($0);
 
-sub show_usage {
+sub show_usage () {
 	print <<EOF
 Usage: $self (options) [package]
 
@@ -45,17 +46,17 @@ EOF
 my %options;
 getopts ('hvacdfj:NriopR', \%options);
 
-show_usage () && exit (0) if exists $options{h};
-show_version () && exit (0) if exists $options{v};
+show_usage && exit 0 if exists $options{h};
+show_version && exit 0 if exists $options{v};
 my $noclean = exists $options{c} ? 'TRUE' : $config{NOCLEAN};
 my $distclean = exists $options{d} ? 'TRUE' : $config{DISTCLEAN};
-my $force = exists $options{f} ? 'TRUE' : 'FALSE';
-my $install_new = exists $options{N} ? 'TRUE' : 'FALSE';
-my $no_readme = exists $options{r} ? 'TRUE' : 'FALSE';
-my $no_install = exists $options{i} ? 'TRUE' : 'FALSE';
-my $only_new = exists $options{o} ? 'TRUE' : 'FALSE';
-my $compat32 = exists $options{p} ? 'TRUE' : 'FALSE';
-my $no_reqs = exists $options{R} ? 'TRUE' : 'FALSE';
+my $force = exists $options{f} ? 1 : 0;
+my $install_new = exists $options{N} ? 1 : 0;
+my $no_readme = exists $options{r} ? 1 : 0;
+my $no_install = exists $options{i} ? 1 : 0;
+my $only_new = exists $options{o} ? 1 : 0;
+my $compat32 = exists $options{p} ? 1 : 0;
+my $no_reqs = exists $options{R} ? 1 : 0;
 
 if (exists $options{j}) {
 	die "You have provided an invalid parameter for -j\n" unless
@@ -63,103 +64,71 @@ if (exists $options{j}) {
 }
 my $jobs = exists $options{j} ? $options{j} : $config{JOBS};
 
-show_usage () and exit (1) unless exists $ARGV[0];
+show_usage and exit 1 unless exists $ARGV[0];
 
 # if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree
-slackbuilds_or_fetch ();
+slackbuilds_or_fetch; 
 
 # build a hash of locations for each item provided on command line, at the same
 # time verifying each item is a valid slackbuild
 my %locations;
 for my $sbo_name (@ARGV) {
-	$locations{$sbo_name} = get_sbo_location ($sbo_name);
+	$locations{$sbo_name} = get_sbo_location $sbo_name;
 	die "Unable to locate $sbo_name in the SlackBuilds.org tree.\n" unless
 		defined $locations{$sbo_name};
 }
 
-sub get_readme_path {
-	exists $_[0] or script_error ('get_readme_path requires an argument.');
+sub get_readme_path ($) {
+	exists $_[0] or script_error 'get_readme_path requires an argument.';
 	my $sbo = shift;
 	return $locations{$sbo} .'/README';
 }
 
-# this subroutine may be getting a little out of hand.
-sub grok_requirements {
-	exists $_[1] or script_error ('grok_requirements requires two arguments');
-	return if $no_reqs eq 'TRUE';
-	my ($sbo, $readme) = @_;
-	my $readme_orig = $readme;
-	for ($readme) {
-		# deal with and at end of line
-		s/and/and /g;
-		# work around missing period at end of list of requirements (given 2
-		# \ns), or no period at end of whole thing.
-		s/$/./;
-		# yet another nasty hack. yanh!
-		s/[Oo]ptional/./g;
-		s/\n\n/./g;
-		s/\n//g;
-	}
-	return unless my $string = 
-		($readme =~ /([Tt]his|\Q$sbo\E|)\s*[Rr]equire(s|)(|:)\s+([^\.]+)/)[3];
-	for ($string) {
-		# remove anything in brackets or parens
-		s/(\s)*\[[^\]]+\](\s)*//g;
-		s/(\s)*\([^\)]+\)(\s)*//g;
-		# convert and to comma
-		s/(\s+|,)and\s+/,/g;
-		s/,\s+/,/g;
-	}
-	my @deps = split /,/, $string;
-	# if anything has a space, we didn't parse correctly, so remove it, also
-	# remove anything that's blank or has an equal sign in
-	my @remove;
-	for my $key (keys @deps) {
-		push @remove, $key if ($deps[$key] =~ /[\s=]/ || $deps[$key] =~ /^$/);
-	}
-	for my $rem (@remove) {
-		splice @deps, $rem, 1;
-		$_-- for @remove;
-	}
-	return unless exists $deps[0];
-	FIRST: for my $need (@deps) {
-		# compare against installed slackbuilds
-		my $tempname = $compat32 eq 'TRUE' ? "$need-compat32" : $need;
-		my @inst = get_installed_sbos ();
-		SECOND: for my $key (keys @inst) {
-			next FIRST if $tempname eq $inst[$key]{name};
-		}
-		print "\n". $readme_orig;
-		print "\nIt looks like this slackbuild requires $tempname; shall I";
-		print " attempt to install it first? [y] ";
-		if (<STDIN> =~ /^[Yy\n]/) {
-			my @args = ("/usr/sbin/sboupgrade", '-oN');
-			# populate args so that they carry over correctly
-			push @args, "-c" if exists $options{c};
-			push @args, "-d" if exists $options{d};
-			push @args, "-j $options{j}" if exists $options{j};
-			push @args, "-p" if $compat32 eq 'TRUE';
-			push @args, $need;
-			system (@args) == 0 or
-				die "Requirement failure, unable to proceed.\n";
+# 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;
+}
+
+# pull list of requirements, offer to install them
+sub grok_requirements ($$$) {
+	exists $_[1] or script_error 'grok_requirements requires an argument.';
+	my ($sbo, $location, $readme) = @_;
+	my $requires = get_from_info (LOCATION => $location, GET => 'REQUIRES');
+	return unless $$requires[0];
+	for my $req (@$requires) {
+		my $inst = get_installed_sbos;
+		my $inst_names= get_inst_names $inst;;
+		unless ($req ~~ @$inst_names) {
+			say $readme;
+			say "$sbo has $req listed as a requirement.";
+			print "Shall I attempt to install it first? [y] ";
+			if (<STDIN> =~ /^[Yy\n]/) {
+				my @cmd = ('/usr/sbin/sboupgrade', '-oN', $req);
+				system (@cmd) == 0 or die "$req failed to install.\n";
+			}
 		}
 	}
-	return;
+	return 1;
 }
 
 # look for any (user|group)add commands in the README
-sub grok_user_group {
-	exists $_[0] or script_error ('grok_user_group requires an argument');
+sub grok_user_group ($) {
+	exists $_[0] or script_error 'grok_user_group requires an argument';
 	my $readme = shift;
-	my @readme_array = split /\n/, $readme;
-	my @cmds;
+	my $readme_array = [split /\n/, $readme];
 	my $cmd_regex = qr/^\s*#\s+((user|group)add.*)/;
-	push @cmds, ($_ =~ $cmd_regex)[0] for @readme_array;
+	my @cmds;
+	push @cmds, ($_ =~ $cmd_regex)[0] for @$readme_array;
 	return unless exists $cmds[0];
-	print "\n". $readme ."\n";;
+	say "\n". $readme;
 	print "\nIt looks like this slackbuild requires the following command(s)";
-	print " to be run first:\n";
-	print "    # $_\n" for @cmds;
+	say " to be run first:";
+	say "    # $_" for @cmds;
 	print "Shall I run it/them now? [y] ";
 	if (<STDIN> =~ /^[Yy\n]/) {
 		for my $cmd (@cmds) {
@@ -170,73 +139,81 @@ sub grok_user_group {
 }
 
 # see if the README mentions any options
-sub grok_options {
-	exists $_[0] or script_error ('grok_options requires an argument');
+sub grok_options ($) {
+	exists $_[0] or script_error 'grok_options requires an argument';
 	my $readme = shift;
-	return 7 unless $readme =~ /[A-Z]+=[^\s]/;
-	my @readme_array = split /\n/, $readme;
-	print "\n". $readme;
+	return unless $readme =~ /[A-Z]+=[^\s]/;
+	say "\n". $readme;
 	print "\nIt looks this slackbuilds has options; would you like to set any";
 	print " when the slackbuild is run? [n] ";
 	if (<STDIN> =~ /^[Yy]/) {
-		my $ask = sub {
+		my $ask = sub () {
 			print "\nPlease supply any options here, or enter to skip: ";
 			chomp (my $opts = <STDIN>);
-			return 7 if $opts =~ /^$/;
-			return $opts; };
+			return if $opts =~ /^$/;
+			return $opts;
+		};
 		my $kv_regex = qr/[A-Z]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/;
-		my $opts = &$ask ();
+		my $opts = &$ask; 
 		FIRST: while ($opts !~ $kv_regex) {
 			warn "Invalid input received.\n";
-			$opts = &$ask ();
-			return 7 if $opts eq "7";
+			$opts = &$ask; 
 		}
 		return $opts;
 	}
-	return 7;
+	return;
 }
 
-# prompt for the readme, and grok the readme at this time also.
-sub readme_prompt {
-	exists $_[0] or script_error ('readme_prompt requires an argument.');
-	my $sbo = shift;
-	my $fh = open_read (get_readme_path ($sbo) );
+# prompt for the readme
+sub readme_prompt ($$) {
+	exists $_[0] or script_error 'readme_prompt requires an argument.';
+	my ($sbo, $location) = @_;
+	my $fh = open_read (get_readme_path $sbo);
 	my $readme = do {local $/; <$fh>};
 	close $fh;
-	grok_requirements ($sbo, $readme); 
-	grok_user_group ($readme);
-	my $opts = grok_options ($readme);
-	print "\n". $readme if ($opts eq "7" || ! $opts);
-	my $name = $compat32 eq 'TRUE' ? "$sbo-compat32" : $sbo;
+	# check for requirements, useradd/groupadd, options
+	grok_requirements $sbo, $location, $readme;
+	grok_user_group $readme;
+	my $opts = grok_options $readme;
+	print "\n". $readme unless $opts;
+	# present the name as -compat32 if appropriate
+	my $name = $compat32 ? "$sbo-compat32" : $sbo;
 	print "\nProceed with $name? [y]: ";
 	exit 0 unless <STDIN> =~ /^[Yy\n]/;
-	return $opts if defined $opts;
-	return 1;
+	return $opts;
 }
 
 # do the things with the provided sbos - whether upgrades or new installs.
 sub process_sbos {
-	exists $_[0] or script_error ('process_sbos requires an argument.');
-	my @todo = @_;
+	exists $_[0] or script_error 'process_sbos requires an argument.';
+	my $todo = shift;
 	my @failures;
-	FIRST: for my $sbo (@todo) {
+	FIRST: for my $sbo (keys %$todo) {
 		my $opts = 0;
-		$opts = readme_prompt ($sbo) unless $no_readme eq 'TRUE';
-		$opts = 'FALSE' if ($opts =~ /\d+/ || ! $opts);
+		$opts = readme_prompt $sbo, $$todo{$sbo} unless $no_readme;
 		# switch compat32 on if upgrading a -compat32
-		$compat32 = 'TRUE' if $sbo =~ /-compat32$/;
+		$compat32 = 1 if $sbo =~ /-compat32$/;
 		my ($version, $pkg, $src);
-		my @sb_args = ($opts, $jobs, $sbo, $locations{$sbo}, $compat32);
-		eval { ($version, $pkg, $src) = do_slackbuild (@sb_args); };
+		eval { ($version, $pkg, $src) = do_slackbuild (
+			OPTS		=> $opts,
+			JOBS		=> $jobs,
+			LOCATION	=> $locations{$sbo},
+			COMPAT32	=> $compat32,
+		); };
 		if ($@) {
 			push @failures, $sbo;
 		} else {
 			unless ($distclean eq 'TRUE') {
-				make_clean ($sbo, $src, $version) if $noclean eq 'FALSE';
+				make_clean $sbo, $src, $version unless $noclean eq 'TRUE';
 			} else {
-				make_distclean ($sbo, $src, $version, $locations{$sbo});
+				make_distclean (
+					SBO			=> $sbo,
+					SRC			=> $src,
+					VERSION		=> $version,
+					LOCATION	=> $locations{$sbo},
+				);
 			}
-			do_upgradepkg ($pkg) unless $no_install eq 'TRUE';
+			do_upgradepkg $pkg unless $no_install;
 			# move package to $config{PKG_DIR} if defined
 			unless ($config{PKG_DIR} eq 'FALSE') {
 				my $dir = $config{PKG_DIR};
@@ -244,7 +221,7 @@ sub process_sbos {
 					mkdir ($dir) or warn "Unable to create $dir\n";
 				}
 				if (-d $dir) {
-					move ($pkg, $dir), print "$pkg stored in $dir\n";
+					move ($pkg, $dir), say "$pkg stored in $dir";
 				} else {
 					warn "$pkg left in /tmp\n";
 				}
@@ -256,80 +233,68 @@ sub process_sbos {
 	return @failures;
 }
 
-my @failed;
-
-sub print_failures {
-	if (exists $failed[0]) {
-		print "Failures:\n";
-		print "  $_\n" for @failed;
+sub print_failures (;@) {
+	if (exists $_[0]) {
+		say "Failures:";
+		say "  $_" for @_;
 		exit 1;
 	}
 }
 
 # deal with any updates prior to any new installs.
 # no reason to bother if only_new is specified, ie running from sboinstall.
-unless ($only_new eq 'TRUE') {
-	# doesn't matter what's updatable and what's not if force is specified
-	my @updates unless $force eq 'TRUE';
-	unless ($force eq 'TRUE') {
-		my @updates_array = get_available_updates ();
-		push @updates, $updates_array[$_]{name} for keys @updates_array;
+goto INSTALL_NEW if $only_new;
+
+# doesn't matter what's updatable and what's not if force is specified
+my @updates unless $force;
+unless ($force) {
+	my $updates = get_available_updates; 
+	push @updates, $$_{name} for @$updates;
+}
+my $todo_upgrade;
+# but without force, we only want to update what there are updates for
+unless ($force) {
+	for my $sbo (@ARGV) {
+		$$todo_upgrade{$sbo} = $locations{$sbo} if $sbo ~~ @updates;
 	}
-	my @todo_upgrade;
-	# but without force, we only want to update what there are updates for
-	unless ($force eq 'TRUE') {
-		for my $sbo (@ARGV) {
-			push @todo_upgrade, $sbo if $sbo ~~ @updates;
-		}
-	} else {
-		my @inst = get_installed_sbos ();
-		FIRST: for my $sbo (@ARGV) {
-			SECOND: for my $key (keys @inst) {
-				if ($sbo eq $inst[$key]{name}) {
-					push @todo_upgrade, $sbo;
-					last SECOND;
-				}
-			}
+} else {
+	my $inst = get_installed_sbos; 
+	my $inst_names= get_inst_names $inst;;
+	FIRST: for my $sbo (@ARGV) {
+		if ($sbo ~~ @$inst_names) {
+			$$todo_upgrade{$sbo} = $locations{$sbo};
 		}
 	}
-	@failed = process_sbos (@todo_upgrade) if exists $todo_upgrade[0];
-	print_failures () unless $install_new eq 'TRUE';
 }
+my @failures = process_sbos $todo_upgrade if keys %$todo_upgrade > 0;
+print_failures @failures;
 
-if ($install_new eq 'TRUE') {
-	my @todo_install;
-	FIRST: for my $sbo (@ARGV) {
-		my $has = 'FALSE';
-		my $name = $compat32 eq 'TRUE' ? "$sbo-compat32" : $sbo;
-		my @inst = get_installed_sbos ();
-		SECOND: for my $key (keys @inst) {
-			$has = 'TRUE', last SECOND if $name eq $inst[$key]{name};
-		}
-		# if compat32 is TRUE, we need to see if the non-compat version exists.
-		if ($compat32 eq 'TRUE') {
-			my $has64 = 'FALSE';
-			my @inst = get_installed_sbos ();
-			THIRD: for my $key (keys @inst) {
-				$has64 = 'TRUE', last THIRD if $sbo eq $inst[$key]{name};
-			}
-			unless ($has64 eq 'TRUE') {
-				print "\nYou are attempting to install $sbo-compat32, however,";
-				print " $sbo is not yet installed. Shall I install it first?";
-				print " [y] ";
-				if (<STDIN> =~ /^[Yy\n]/) {
-					my @args = ('/usr/sbin/sboupgrade', '-oN', $sbo);
-					system (@args) == 0 or exit 1;
-				} else {
-					print "Please install $sbo\n" and exit 0;
-				}
+INSTALL_NEW:
+exit 0 unless $install_new;
+my $todo_install;
+FIRST: for my $sbo (@ARGV) {
+	my $name = $compat32 ? "$sbo-compat32" : $sbo;
+	my $inst = get_installed_sbos; 
+	my $inst_names = get_inst_names $inst;;
+	warn "$name already installed\n", next FIRST if $name ~~ @$inst_names;
+	# if compat32 is TRUE, we need to see if the non-compat version exists.
+	if ($compat32) {
+		my $inst = get_installed_sbos; 
+		my $inst_names = get_inst_names $inst;
+		unless ($sbo ~~ @$inst_names) {
+			print "\nYou are attempting to install $name, however, $sbo is not";
+			print " yet installed. Shall I install it first? [y] ";
+			if (<STDIN> =~ /^[Yy\n]/) {
+				my @args = ('/usr/sbin/sboupgrade', '-oN', $sbo);
+				system (@args) == 0 or exit 1;
+			} else {
+				warn "Please install $sbo\n" and exit 0;
 			}
 		}
-		$has eq 'TRUE' ? warn "$name already installed.\n" :
-			push @todo_install, $sbo;
 	}
-	@failed = process_sbos (@todo_install) if exists $todo_install[0];
-	print_failures ();
+	$$todo_install{$sbo} = $locations{$sbo};
 }
+@failures = process_sbos $todo_install if keys %$todo_install > 0;
+print_failures @failures;
 
-exit 1 if exists $failed[0];
 exit 0;