Additional Perl::Critic::Freenode fixes, and one missed prototype

9 files changed, 58 insertions, 42 deletions

diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index fadcbba..98d5517 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -36,6 +36,7 @@ our @EXPORT = qw(
 	make_distclean
 	do_upgradepkg
 	get_sbo_location
+	get_sbo_locations
 	get_from_info
 	get_tmp_extfn
 	get_arch
@@ -208,8 +209,8 @@ sub check_home {
 	my $sbo_home = $config{SBO_HOME};
 	if (-d $sbo_home) {
 		opendir(my $home_handle, $sbo_home);
-		FIRST: while (readdir $home_handle) {
-			next FIRST if /^\.[\.]{0,1}$/;
+		FIRST: while (my $dir = readdir $home_handle) {
+			next FIRST if $dir =~ /^\.[\.]{0,1}$/;
 			usage_error("$sbo_home exists and is not empty. Exiting.\n");
 		}
 	} else {
@@ -240,7 +241,7 @@ sub fetch_tree {
 }
 
 sub update_tree {
-	fetch_tree(), return unless chk_slackbuilds_txt();
+	fetch_tree(), return() unless chk_slackbuilds_txt();
 	say 'Updating SlackBuilds tree...';
 	rsync_sbo_tree(), return 1;
 }
@@ -297,6 +298,10 @@ sub get_inst_names {
 }
 
 # search the SLACKBUILDS.TXT for a given sbo's directory
+{
+	# a state variable for get_sbo_location and get_sbo_locations
+	my $store = {};
+
 sub get_sbo_location {
 	exists $_[0] or script_error('get_sbo_location requires an argument.');
 	my @sbos = @_;
@@ -304,11 +309,18 @@ sub get_sbo_location {
 		my $tmp = $sbos[0];
 		@sbos = @$tmp;
 	}
-	state $store = {};
-    ## NOTE this might cause a problem now that prototypes are removed
-	# if scalar context and we already have the location, return it now.
-	unless (wantarray) {
-		return $$store{$sbos[0]} if exists $$store{$sbos[0]};
+	# if we already have the location, return it now.
+	return $$store{$sbos[0]} if exists $$store{$sbos[0]};
+	my %locations = get_sbo_locations(@sbos);
+	return $locations{$sbos[0]};
+}
+
+sub get_sbo_locations {
+	exists $_[0] or script_error('get_sbo_locations requires an argument.');
+	my @sbos = @_;
+	if (ref $sbos[0] eq 'ARRAY') {
+		my $tmp = $sbos[0];
+		@sbos = @$tmp;
 	}
 	my %locations;
 	my ($fh, $exit) = open_read($slackbuilds_txt);
@@ -323,7 +335,6 @@ sub get_sbo_location {
 			if (my $loc = ($line =~ $regex)[0]) {
 				# save what we found for later requests
 				$$store{$sbo} = "$config{SBO_HOME}$loc";
-				return $$store{$sbo} unless wantarray;
 				$locations{$sbo} = $$store{$sbo};
 			}
 		}
@@ -354,7 +365,7 @@ sub get_from_info {
 	return $$store{$args{GET}} if $$store{PRGNAM}[0] eq $sbo;
 	# if we're here, we haven't read in the .info file yet.
 	my ($fh, $exit) = open_read("$args{LOCATION}/$sbo.info");
-	return if $exit;
+	return() if $exit;
 	# suck it all in, clean it all up, stuff it all in $store.
 	my $contents = do {local $/; <$fh>};
 	$contents =~ s/("|\\\n)//g;
@@ -421,11 +432,11 @@ sub get_download_info {
 		}
 	}
 	# if we still don't have any links, something is really wrong.
-	return unless $$downs[0];
+	return() unless $$downs[0];
 	# grab the md5s and build a hash
 	$get = $args{X64} ? 'MD5SUM_x86_64' : 'MD5SUM';
 	$md5s = get_from_info(LOCATION => $args{LOCATION}, GET => $get);
-	return unless $$md5s[0];
+	return() unless $$md5s[0];
 	$return{$$downs[$_]} = $$md5s[$_] for (keys @$downs);
 	return \%return;
 }
@@ -483,7 +494,7 @@ sub verify_distfile {
 	exists $_[1] or script_error('verify_distfile requires two arguments.');
 	my ($link, $info_md5) = @_;
 	my $filename = get_filename_from_link($link);
-	return unless -f $filename;
+	return() unless -f $filename;
 	my $md5sum = compute_md5sum($filename);
 	return $info_md5 eq $md5sum ? 1 : 0;
 }
@@ -526,7 +537,7 @@ sub check_x32 {
 # to determine whether or not an x86_64 system is setup for multilib
 sub check_multilib {
 	return 1 if -f '/etc/profile.d/32dev.sh';
-	return;
+	return();
 }
 
 # given a list of downloads, return just the filenames
@@ -647,7 +658,8 @@ sub check_distfiles {
 		return "Unable to get download info from $location/$sbo.info\n",
 			_ERR_NOINFO;
 	}
-	while (my ($link, $md5) = each %$downloads) {
+	for my $link (keys %$downloads) {
+		my $md5 = $downloads->{$link};
 		unless (verify_distfile($link, $md5)) {
 			my ($fail, $exit) = get_distfile($link, $md5);
 			return $fail, $exit if $exit;
@@ -757,9 +769,9 @@ sub perform_sbo {
 	my $src_ls_fh = tempfile(DIR => $tempdir);
 	my $tsbo = $env_tmp ? $env_tmp : "$tmpd/SBo";
 	if (opendir(my $tsbo_dh, '/tmp/SBo')) {
-		FIRST: while (readdir $tsbo_dh) {
-			next FIRST if /^\.[\.]{0,1}$/;
-			say {$src_ls_fh} $_;
+		FIRST: while (my $dir = readdir $tsbo_dh) {
+			next FIRST if $dir =~ /^\.[\.]{0,1}$/;
+			say {$src_ls_fh} $dir;
 		}
 	}
 	# get a tempfile to store the exit status of the slackbuild
@@ -923,7 +935,7 @@ sub do_upgradepkg {
 # wrapper to pull the list of requirements for a given sbo
 sub get_requires {
 	my $location = get_sbo_location(shift);
-	return unless $location;
+	return() unless $location;
 	my $info = get_from_info(LOCATION => $location, GET => 'REQUIRES');
 	return $$info[0] ne '' ? $info : undef;
 }
@@ -1057,19 +1069,19 @@ sub ask_opts {
         my $ask = sub {
             print "\nPlease supply any options here, or enter to skip: ";
             chomp(my $opts = <STDIN>);
-            return if $opts =~ /^\n/;
+            return() if $opts =~ /^\n/;
             return $opts;
         };
         my $kv_regex = qr/[A-Z0-9]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/;
         my $opts = $ask->();
-        return unless $opts;
+        return() unless $opts;
         while ($opts !~ $kv_regex) {
             warn "Invalid input received.\n";
             $opts = $ask->();
         }
         return $opts;
     }
-    return;
+    return();
 }
 
 # for a given sbo, check for cmds/opts, prompt the user as appropriate
diff --git a/sbocheck b/sbocheck
index f5bc2b7..cb56266 100755
--- a/sbocheck
+++ b/sbocheck
@@ -44,7 +44,7 @@ update_tree();
 sub get_update_list {
 	print "Checking for updated SlackBuilds...\n";
 	my $updates = get_available_updates();
-	return unless exists $$updates[0];
+	return() unless exists $$updates[0];
 	# consistent formatting - determine longest version string, which will tell
 	# us the max minimum length of the left side of the output for stuff that
 	# fits in 80 chars; stuff that doesn't will overflow.
diff --git a/sboclean b/sboclean
index 0883bb2..39c93e1 100755
--- a/sboclean
+++ b/sboclean
@@ -59,7 +59,7 @@ sub rm_full {
 	my $full = shift;
 	if ($interactive) {
 		print "Remove $full? [n] ";
-		return unless <STDIN> =~ /^[Yy]/;
+		return() unless <STDIN> =~ /^[Yy]/;
 	}
 	unlink $full if -f $full;
 	remove_tree($full) if -d $full;
diff --git a/sboconfig b/sboconfig
index 7c854b8..0bf7de4 100755
--- a/sboconfig
+++ b/sboconfig
@@ -79,7 +79,8 @@ show_usage() and exit 0 unless keys %options > 0;
 
 # setup what's being changed, sanity check.
 my %changes;
-while (my ($key, $value) = each %valid_confs) {
+for my $key (keys %valid_confs) {
+	my $value = $valid_confs{$key};
 	$changes{$value} = $options{$key} if exists $options{$key};
 }
 
@@ -141,11 +142,11 @@ sub config_write {
 			warn $conffh;
 			exit $exit;
 		}
-		print {$conffh} $contents or return;
+		print {$conffh} $contents or return();
 		close $conffh, close $tempfh;
 	} else {
 		# no config file, easiest case of all.
-		my ($fh, $exit) = open_fh($conf_file, '>') or return;
+		my ($fh, $exit) = open_fh($conf_file, '>') or return();
 		if ($exit) {
 			warn $fh;
 			exit $exit;
@@ -156,7 +157,8 @@ sub config_write {
 	return 1;
 }
 
-while (my ($key, $value) = each %changes) {
+for my $key (keys %changes) {
+	my $value = $changes{$key};
 	say "Setting $key to $value...";
 	config_write($key, $value);
 }
diff --git a/sbofind b/sbofind
index 958545b..c37c464 100755
--- a/sbofind
+++ b/sbofind
@@ -93,7 +93,7 @@ sub get_file_contents {
 	my ($fh, $exit) = open_read(shift);
 	if ($exit) {
 		warn $fh;
-		return;
+		return();
 	}
 	my $contents = do {local $/; <$fh>};
 	for ($contents) {
@@ -115,7 +115,8 @@ my $findings = perform_search($search);
 # pretty formatting
 if (exists $$findings[0]) {
 	for my $hash (@$findings) {
-		while (my ($key, $val) = each %$hash) {
+		for my $key (keys %$hash) {
+			my $val = $hash->{$key};
 			say "SBo:    $key";
 			say "Path:   $val";
 			say "info:   ". get_file_contents("$val/$key.info") if $show_info;
diff --git a/sboinstall b/sboinstall
index 7b5cdab..dcf5a6f 100755
--- a/sboinstall
+++ b/sboinstall
@@ -93,7 +93,7 @@ if ($no_reqs or $non_int) {
 }
 
 # populate %locations and sanity check
-%locations = get_sbo_location($build_queue);
+%locations = get_sbo_locations($build_queue);
 for my $sbo (@$build_queue) {
 	usage_error("Unable to locate $sbo in the SlackBuilds.org tree.") unless
 		$locations{$sbo};
diff --git a/sboremove b/sboremove
index b66325f..237fd69 100755
--- a/sboremove
+++ b/sboremove
@@ -75,7 +75,7 @@ for my $sbo (@sbos) {
 my (%required_by, @confirmed);
 
 # populates the required_by hash 
-sub get_reverse_reqs($) {
+sub get_reverse_reqs {
 	my $installed = shift;
 	FIRST: for my $inst (@$installed) {
 		my $require = get_requires($inst);
@@ -160,7 +160,7 @@ FIRST: for my $remove (@$remove_queue) {
 		say "It is recommended that you view the README before continuing.";
 		print "Display README now? [y]: ";
 		if (<STDIN> =~ /^[Yy\n]/) {
-			my ($readme, $exit) = get_readme_contents get_sbo_location($remove);
+			my ($readme, $exit) = get_readme_contents(get_sbo_location($remove));
 			if ($exit) {
 				warn "Unable to open README for $remove.\n";
 			} else {
diff --git a/sboupgrade b/sboupgrade
index c6121e2..8735b1c 100755
--- a/sboupgrade
+++ b/sboupgrade
@@ -163,14 +163,15 @@ unless ($force) {
 			$queue = $queue2;
 			my $cqueue;
 			# get locations for all the things
-			my %locs = get_sbo_location($queue);
+			my %locs = get_sbo_locations($queue);
 			my %clocs;
 			# -compat32-ify the queue and locations if appropriate
 			if ($sbo =~ /-compat32$/) {
 				$cqueue = $queue;
 				s/$/-compat32/g for @$cqueue;
 				$queue = $cqueue;
-				while (my ($key, $val) = each %locs) {
+				for my $key (keys %locs) {
+					my $val = $locs{$key};
 					$key =~ s/$/-compat32/;
 					$clocs{$key} = $val;
 				}
diff --git a/t/test.t b/t/test.t
index 07b8704..deb0464 100755
--- a/t/test.t
+++ b/t/test.t
@@ -105,21 +105,21 @@ for my $key (keys @$installed) {
 }
 print "completed pseudo-random testing of get_installed_packages 'ALL' \n";
 
-# get_sbo_location tests
+# get_sbo_location/get_sbo_locations tests
 is(get_sbo_location ('nginx'), "$sbo_home/network/nginx",
 	'get_sbo_location is good');
 is(get_sbo_location ('omgwtfbbq'), 0,
 	'get_sbo_location returns false with not-an-sbo input');
 my @finds = qw(nginx gmpc);
-my %locs = get_sbo_location(@finds);
+my %locs = get_sbo_locations(@finds);
 is($locs{nginx}, "$sbo_home/network/nginx",
-	'get_sbo_location passed array #1 good');
-is($locs{gmpc}, "$sbo_home/audio/gmpc", 'get_sbo_location passed array #2 good');
-%locs = get_sbo_location(\@finds);
+	'get_sbo_locations passed array #1 good');
+is($locs{gmpc}, "$sbo_home/audio/gmpc", 'get_sbo_locations passed array #2 good');
+%locs = get_sbo_locations(\@finds);
 is($locs{nginx}, "$sbo_home/network/nginx",
-	'get_sbo_location passed array ref #1 good');
+	'get_sbo_locations passed array ref #1 good');
 is($locs{gmpc}, "$sbo_home/audio/gmpc",
-	'get_sbo_location passed array ref #2 good');
+	'get_sbo_locations passed array ref #2 good');
 
 # get_available_updates tests
 my $updates = get_available_updates;