diff options
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 9 | ||||
| -rwxr-xr-x | sboinstall | 23 | ||||
| -rwxr-xr-x | sboremove | 34 | ||||
| -rwxr-xr-x | sboupgrade | 21 | ||||
| -rwxr-xr-x | t/test.t | 15 |
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; } @@ -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) { @@ -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. } @@ -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}; } } } @@ -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; |