diff options
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 71 | ||||
| -rwxr-xr-x | sboremove | 2 | ||||
| -rwxr-xr-x | sboupgrade | 2 |
3 files changed, 30 insertions, 45 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 85459c5..94d8ef6 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -27,7 +27,6 @@ our @EXPORT = qw( slackbuilds_or_fetch fetch_tree update_tree - get_installed_sbos get_installed_packages get_inst_names get_available_updates @@ -202,66 +201,52 @@ sub slackbuilds_or_fetch() { } # pull an array of hashes, each hash containing the name and version of a -# package currently installed. -sub get_installed_packages() { +# package currently installed. Gets filtered using STD, SBO or ALL. +sub get_installed_packages($) { + exists $_[0] or script_error 'get_installed_packages requires an argument.'; + my $filter = shift; my @installed; - # $1 == name, $2 == version + my $regex = qr#/([^/]+)-([^-]+)-[^-]+-([^-]+)$#; for my $path (<$pkg_db/*>) { my ($name, $version, $build) = ($path =~ $regex)[0,1,2]; - # Is it a compat32 package? If so, strip compat32 from name - # for get_sbo_location - my $c32 = $name =~ /-compat32$/ ? 1 : 0; - my $search_name = $name; - $search_name =~ s/-compat32//g if $c32; - - # valid types: STD, SBO, C32 (Note: C32 only contains SBO-compat32) + # valid types: STD, SBO my $type = 'STD'; - if ($build =~ m/[0-9]*[a-zA-Z]/) { - my $is_native_c32; - if ($build =~ m/compat32/) { - unless ($build =~ m/SBo/) { - $is_native_c32 = 1; - } - } - unless ($is_native_c32) { - if (get_sbo_location($search_name)) { - $type = $c32 ? 'C32' : 'SBO'; - } + if ($build =~ m/_SBo*/) { + my $sbo = $name; + $sbo =~ s/-compat32//g if $name =~ /-compat32$/; + $type = 'SBO' if get_sbo_location($sbo); + } + if ($filter) { + if ($filter eq $type or $filter eq 'ALL') { + push @installed, {name => $name, version => $version}; } } - push @installed, {name => $name, version => $version, type => $type}; + } return \@installed; } # pull an array of hashes, each hash containing the name and version of an sbo # currently installed. -sub get_installed_sbos() { - my @installed; - # $1 == name, $2 == version - my $regex = qr#/([^/]+)-([^-]+)-[^-]+-[^-]+$#; - for my $path (<$pkg_db/*_SBo>) { - my ($name, $version) = ($path =~ $regex)[0,1]; - push @installed, {name => $name, version => $version}; - } - return \@installed; -} +# sub get_installed_sbos() { +# my @installed; +# # $1 == name, $2 == version +# my $regex = qr#/([^/]+)-([^-]+)-[^-]+-[^-]+$#; +# for my $path (<$pkg_db/*_SBo>) { +# my ($name, $version) = ($path =~ $regex)[0,1]; +# push @installed, {name => $name, version => $version}; +# } +# return \@installed; +# } # for a ref to an array of hashes of installed packages, return an array ref # consisting of just their names -sub get_inst_names { +sub get_inst_names($) { exists $_[0] or script_error 'get_inst_names requires an argument.'; my $inst = shift; my @installed; - my $filter = exists $_[0]; - if ($filter) { - for my $pkg (@$inst) { - push @installed, $$pkg{name} if $$pkg{type} eq $_[0]; - } - } else { - push @installed, $$_{name} for @$inst; - } + push @installed, $$_{name} for @$inst; return \@installed; } @@ -346,7 +331,7 @@ sub get_sbo_version($) { # newer, and compile an array of hashes containing those which are sub get_available_updates() { my @updates; - my $pkg_list = get_installed_sbos; + my $pkg_list = get_installed_packages 'SBO'; FIRST: for my $key (keys @$pkg_list) { my $location = get_sbo_location($$pkg_list[$key]{name}); # if we can't find a location, assume invalid and skip @@ -50,7 +50,7 @@ show_usage and exit 0 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 = get_inst_names(get_installed_packages 'SBO'); for my $sbo (@ARGV) { if (get_sbo_location($sbo)) { $sbo ~~ @$inst_names ? push @sbos, $sbo @@ -255,7 +255,7 @@ sub print_failures { } } -my $inst_names = get_inst_names(get_installed_packages); +my $inst_names = get_inst_names(get_installed_packages 'ALL'); my $upgrade_queue; @$upgrade_queue = (); # deal with any updates prior to any new installs. |