Merge branch 'smartmatch'

5 files changed, 66 insertions, 36 deletions

diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index d0e42c4..ed5f74c 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -191,7 +191,7 @@ sub get_slack_version() {
 	close $fh;
 	my $version = ($line =~ /\s+(\d+[^\s]+)$/)[0];
 	usage_error "Unsupported Slackware version: $version\n"
-		unless $version ~~ %supported;
+		unless $supported{$version};
 	return $supported{$version};
 }
 
@@ -882,7 +882,7 @@ sub make_clean {
 		-d "$tmpsbo/package-$args{SBO}";
 	# clean up after convertpkg-compat32
 	remove_tree("$tmpd/package-$args{SBO}") if
-		-d "$tmpd/package-$args{SBO}" and $args{SBO} ~~ /-compat32$/;
+		-d "$tmpd/package-$args{SBO}" and $args{SBO} =~ /-compat32$/;
 	return 1;
 }
 
@@ -970,8 +970,11 @@ sub merge_queues {
     my $queue_a = $_[0];
     my $queue_b = $_[1];
 
+	my %queue_a;
+	$queue_a{$_} = 1 for @$queue_a;
+
     for my $item (reverse @$queue_b) {
-        push @$queue_a, $item unless $item ~~ @$queue_a;
+		push @$queue_a, $item unless $queue_a{$item};
     }
     return $queue_a;
 }
diff --git a/sboinstall b/sboinstall
index 0f87d5a..ad28349 100755
--- a/sboinstall
+++ b/sboinstall
@@ -111,26 +111,33 @@ s/::/-/g for @$pms;
 # check for already-installeds and prompt for the rest
 my (@temp_queue, %commands, %options);
 my $added = ' added to install queue.';
+my %inst_names;
+$inst_names{$_} = 1 for @$inst_names;
+
 FIRST: for my $sbo (@$build_queue) {
     my $name = $compat32 ? "$sbo-compat32" : $sbo;
-    if ($name ~~ @$inst_names) {
-        say "$name already installed.";
-        next FIRST;
-    } else {
+
+	if ($inst_names{$name}) {
+		say "$name already installed.";
+		next FIRST;
+	} else {
 		if ($sbo =~ /^perl-/) {
 			my $pm_name = $sbo;
 			$pm_name =~ s/^perl-//;
-			if (/^$pm_name$/i ~~ @$pms) {
-				say "$sbo installed via the cpan.";
-				next FIRST;
+			for my $pm (@$pms) {
+				if ($pm =~ /^$pm_name$/i) {
+					say "$sbo installed via the cpan.";
+					next FIRST;
+				}
 			}
 		}
 	}
+
     $locations{$name} = get_sbo_location($sbo) if $compat32;
     unless ($non_int) {
         # if compat32 is TRUE, we need to see if the non-compat version exists.
         if ($compat32) {
-            unless ($sbo ~~ @$inst_names) {
+			unless ($inst_names{$sbo}) {
 				say "$name requires $sbo.";
                 my ($cmds, $opts, $exit) = user_prompt($sbo, $locations{$sbo});
 				if ($exit) {
diff --git a/sboremove b/sboremove
index 838ec8b..4017d2b 100755
--- a/sboremove
+++ b/sboremove
@@ -51,10 +51,12 @@ show_usage and exit 1 unless exists $ARGV[0];
 # ensure that all provided arguments are valid sbos
 my @sbos;
 my $inst_names = get_inst_names(get_installed_packages 'SBO');
+my %inst_names;
+$inst_names{$_} = 1 for @$inst_names;
 for my $sbo (@ARGV) {
 	if (get_sbo_location($sbo)) {
-		$sbo ~~ @$inst_names ? push @sbos, $sbo
-                             : say "$sbo is not installed";
+		$inst_names{$sbo} ? push @sbos, $sbo
+						  : say "$sbo is not installed";
 	} else {
 		say "Unable to locate $sbo in the SlackBuilds.org tree."
 	}
@@ -78,9 +80,14 @@ sub get_reverse_reqs($) {
 	FIRST: for my $inst (@$installed) {
 		my $require = get_requires $inst;
 		next FIRST unless $$require[0];
-		for my $req (@$require) {
+		SECOND: for my $req (@$require) {
 			unless ( $req eq '%README%' ) {
-				push @{$required_by{$req}}, $inst if $req ~~ @$installed;
+				THIRD: for my $inst_two (@$installed) {
+					if ($req eq $inst_two) {
+						push @{$required_by{$req}}, $inst;
+						last THIRD;
+					}
+				}
 			}		
 		}	
 	}
@@ -94,9 +101,11 @@ sub get_required_by($) {
 	my @dep_of;
 	if ( $required_by{$sbo} ) {
 		for my $req_by (@{$required_by{$sbo}}) {
-			unless ($req_by ~~ @confirmed) {
-				push @dep_of, $req_by;
+			my $found = 0;
+			for my $conf (@confirmed) {
+				$found++ if $req_by eq $conf;
 			}
+			push @dep_of, $req_by unless $found;
 		}
 	}
 	return exists $dep_of[0] ? \@dep_of : undef;
@@ -104,14 +113,18 @@ sub get_required_by($) {
 
 sub confirm_remove($) {
 	my $sbo = shift;
-	push @confirmed, $sbo unless $sbo ~~ @confirmed;
+	my $found = 0;
+	for my $conf (@confirmed) {
+		$found++ if $sbo eq $conf;
+	}
+	push @confirmed, $sbo unless $found;
 }
 
 # 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;
+		push @temp, $sbo if $inst_names{$sbo};
 	}
 	$remove_queue = \@temp;
 }
@@ -127,8 +140,11 @@ FIRST: for my $remove (@$remove_queue) {
 	# Determine whether $remove is still needed on system.
 	my $required_by = get_required_by $remove;
 	my $needed = 0;
+	my (%confirmed, %sbos);
+	$confirmed{$_} = 1 for @confirmed;
+	$sbos{$_} = 1 for @sbos;
 	for my $rq (@$required_by) {
-		$needed = 1 unless $rq ~~ @confirmed or $remove ~~ @sbos;
+		$needed = 1 unless $confirmed{$rq} or $sbos{$remove};
 		# still needed, unless required_by is already confirmed for removal or
 		# the sbo in question was cli-specified.
 	}	
diff --git a/sboupgrade b/sboupgrade
index 7caea68..a0e354c 100755
--- a/sboupgrade
+++ b/sboupgrade
@@ -108,6 +108,8 @@ for my $sbo (@sbos) {
 
 # get a list of installed SBos to check upgradability against
 my $inst_names = get_inst_names(get_installed_packages 'SBO');
+my %inst_names;
+$inst_names{$_} = 1 for @$inst_names;
 
 # backwards compatibility
 if ($install_new) {
@@ -121,7 +123,7 @@ if ($install_new) {
 	for my $sbo (@sbos) {
 		my $name = $sbo;
 		$name =~ s/$/-compat32/ if $compat32 && $sbo !~ /-compat32$/;
-		unless ($name ~~ @$inst_names) {
+		unless ($inst_names{$name}) {
 			my @args = ('/usr/sbin/sboinstall');
 			push @args, $noclean ? '-cTRUE' : '-cFALSE';
 			push @args, $distclean ? '-dTRUE' : '-dFALSE';
@@ -138,17 +140,14 @@ if ($install_new) {
 
 my $upgrade_queue;
 
-# 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;
-}
-
+# doesn't matter what's updatable and what's not if force is specified,
 # but without force, we only want to update what there are updates for
 unless ($force) {
+	my %updates;
+	my $updates = get_available_updates;
+	$updates{$$_{name}} = 1 for @$updates;
     for my $sbo (@sbos) {
-		push @$upgrade_queue, $sbo if $sbo ~~ @updates;
+		push @$upgrade_queue, $sbo if $updates{$sbo};
     }
 } else {
     if ($force_reqs && ! $non_int) {
@@ -159,7 +158,7 @@ unless ($force) {
 			my $queue = get_build_queue([$name], my $warnings);
 			my $queue2;
 			for my $item (@$queue) {
-				push @$queue2, $item if $item ~~ @$inst_names;
+				push @$queue2, $item if $inst_names{$item};
 			}
 			$queue = $queue2;
 			my $cqueue;
@@ -183,7 +182,7 @@ unless ($force) {
 		$upgrade_queue = $temp_queue;
     } else {
 		for my $sbo (@sbos) {
-			push @$upgrade_queue, $sbo if $sbo ~~ @$inst_names;
+			push @$upgrade_queue, $sbo if $inst_names{$sbo};
 		}
     }
 }
diff --git a/t/test.t b/t/test.t
index 6e3bcf3..52524f4 100755
--- a/t/test.t
+++ b/t/test.t
@@ -187,10 +187,13 @@ ok(check_multilib, 'check_multilib good');
 # create_symlinks tests
 $downloads = get_sbo_downloads(LOCATION => "$sbo_home/system/wine", 32 => 1);
 my $symlinks = create_symlinks "$sbo_home/system/wine", $downloads;
-is($$symlinks[0], "$sbo_home/system/wine/wine-1.4.1.tar.bz2",
-	'$symlinks[0] good for create_symlinks');
-is($$symlinks[1], "$sbo_home/system/wine/dibeng-max-2010-11-12.zip",
-	'$symlinks[1] good for create_symlinks');
+my ($have1, $have2);
+for my $sl (@$symlinks) {
+	$have1++ if $sl eq "$sbo_home/system/wine/wine-1.4.1.tar.bz2";
+	$have2++ if $sl eq "$sbo_home/system/wine/dibeng-max-2010-11-12.zip";
+}
+ok($have1, '$create_symlinks test 1 passed.');
+ok($have2, '$create_symlinks test 2 passed.');
 
 # grok_temp_file, get_src_dir/get_pkg_name tests
 my $tempdir = tempdir(CLEANUP => 1);
@@ -334,7 +337,9 @@ for my $found (@$findings) {
 # get_inst_names test
 $installed = get_installed_packages 'SBO';
 my $inst_names = get_inst_names $installed;
-ok('zdoom' ~~ @$inst_names, 'get_inst_names is good');
+my %inst_names;
+$inst_names{$_} = 1 for @$inst_names;
+ok($inst_names{zdoom}, 'get_inst_names is good');
 
 # get_reqs tests
 # $SBO::Lib::no_reqs = 0;