diff options
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 42 | ||||
| -rwxr-xr-x | sboremove | 30 | ||||
| -rwxr-xr-x[-rw-r--r--] | sboupgradex | 25 |
3 files changed, 45 insertions, 52 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 7b9dff7..c2c1f4c 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -1,3 +1,4 @@ + #!/usr/bin/env perl # # vim: set ts=4:noet @@ -366,7 +367,7 @@ sub get_filename_from_link ($) { my $fn = shift; my $regex = qr#/([^/]+)$#; my $filename = $fn =~ $regex ? $distfiles .'/'. ($fn =~ $regex)[0] : undef; - $filename =~ s/%2B/+/g; + $filename =~ s/%2B/+/g if $filename; return $filename; } @@ -733,16 +734,12 @@ sub add_to_queue ($) { my $args = shift; my $sbo = \${$args}{NAME}; return unless $$sbo; - push(@{$args}{QUEUE}, $$sbo); - my @locations = get_sbo_location $$sbo; - my $location; - for my $loc (@locations) { - $location = $loc if basename($loc) eq $$sbo; - } + unshift @$args{QUEUE}, $$sbo; + my $location = get_sbo_location $$sbo; return unless $location; my $requires = get_from_info (LOCATION => $location, GET => 'REQUIRES'); - for my $req (@$requires) { - next if $req eq $$sbo; + FIRST: for my $req (@$requires) { + next FIRST if $req eq $$sbo; if ($req eq "%README%") { ${$args}{WARNINGS}{$$sbo}="%README%"; } else { @@ -754,21 +751,22 @@ sub add_to_queue ($) { # recursively add a sbo's requirements to the build queue. sub get_build_queue ($$) { - unless ($_[0] && $_[1]) { - script_error 'get_build_queue requires two arguments.'; + exists $_[1] or script_error 'get_build_queue requires two arguments.'; + my ($sbos, $warnings) = @_; + my $temp_queue = []; + for my $sbo (@$sbos) { + my %args = ( + QUEUE => $temp_queue,, + NAME => $sbo, + WARNINGS => $warnings + ); + add_to_queue(\%args); } - my (@temp_queue, @build_queue); - my %args = ( - QUEUE => \@temp_queue, - NAME => $_[0], - WARNINGS => \%{$_[1]} - ); - add_to_queue(\%args); # Remove duplicate entries (leaving first occurrence) - my %seen; - for my $sb( reverse(@temp_queue) ) { - next if $seen{ $sb }++; + my (%seen, @build_queue); + FIRST: for my $sb (@$temp_queue) { + next FIRST if $seen{$sb}++; push @build_queue, $sb; } return \@build_queue; -}
\ No newline at end of file +} @@ -49,10 +49,15 @@ show_usage and exit 0 if $help; show_version and exit 0 if $vers; show_usage and exit 0 unless exists $ARGV[0]; -my $rootpkg = $ARGV[0]; -my $test = get_sbo_location $rootpkg; -die "Unable to locate $rootpkg in the SlackBuilds.org tree.\n" unless - defined $test; +my @remove; +for my $sbo (@ARGV) { + my $test = get_sbo_location $sbo; + if ( defined $test ) { + push @remove, $sbo; + } else { + say "Unable to locate $sbo in the SlackBuilds.org tree." + } +} my $remove_queue; my %required_by; @@ -60,7 +65,7 @@ my %warnings; my @confirmed; sub get_requires ($) { - my $location = get_sbo_location(shift); + my $location = get_sbo_location shift; my $requires = get_from_info (LOCATION => $location, GET => 'REQUIRES'); return $requires; } @@ -71,7 +76,7 @@ sub get_required_by ($) { if ( $required_by{$sbo} ) { for my $req_by (@{$required_by{$sbo}}) { unless ($req_by ~~ @confirmed) { - push (@dep_of, $req_by); + push @dep_of, $req_by; } } } @@ -81,16 +86,15 @@ sub get_required_by ($) { sub confirm_remove ($) { my $sbo = shift; unless ($sbo ~~ @confirmed) { - push(@confirmed, $sbo); + push @confirmed, $sbo; } } -# Determine dependencies & warnings of root package -$remove_queue = get_build_queue($rootpkg, \%warnings); +# Determine dependencies & warnings sbo's +$remove_queue = get_build_queue(\@remove, \%warnings); @$remove_queue = reverse(@$remove_queue); if ($no_reqs) { - @$remove_queue = (); - push(@$remove_queue, $rootpkg); + $remove_queue = \@remove; } # Determine required by for all installed sbo's @@ -102,7 +106,7 @@ for my $inst (@$inst_names) { for my $req (@$requires) { unless ( $req eq "%README%" ) { if ( $req ~~ $inst_names ) { - push(@{$required_by{$req}}, $inst); + push @{$required_by{$req}}, $inst; } } } @@ -113,7 +117,7 @@ my @temp; if ($inst_names) { for my $sbo (@$remove_queue) { if ($sbo ~~ $inst_names) { - push(@temp, $sbo); + push @temp, $sbo; } } $remove_queue = \@temp; diff --git a/sboupgradex b/sboupgradex index 178adee..b48fed8 100644..100755 --- a/sboupgradex +++ b/sboupgradex @@ -77,18 +77,17 @@ show_usage and exit 0 unless exists $ARGV[0]; $noclean = $noclean eq 'TRUE' ? 1 : 0; $distclean = $distclean eq 'TRUE' ? 1 : 0; - my $rootpkg = $ARGV[0]; my %warnings; my %options; my $build_queue; my %locations; +my $build = 0; if ($no_reqs) { - @$build_queue = (); - push(@$build_queue, $rootpkg); + $build_queue = \@ARGV; } else { - $build_queue = get_build_queue($rootpkg, \%warnings); + $build_queue = get_build_queue(\@ARGV, \%warnings); } for my $sbo (@$build_queue) { @@ -250,14 +249,9 @@ sub print_failures (;%) { } } -#if (@$build_queue gt 1) { -# my $reqline = join(' ', @$build_queue); -# $reqline =~ s/$rootpkg//; -# say "Requires: " . $reqline; -#} - my $installed = get_installed_sbos; my $inst_names = get_inst_names $installed; +my $upgrade_queue; # deal with any updates prior to any new installs. # no reason to bother if only_new is specified, ie running from sboinstall. @@ -269,21 +263,18 @@ unless ($force) { my $updates = get_available_updates; push @updates, $$_{name} for @$updates; } -my $upgrade_queue; + # but without force, we only want to update what there are updates for -my @remove; unless ($force) { for my $sbo (@$build_queue) { if ($sbo ~~ @updates) { push @$upgrade_queue, $sbo; - push @remove, $sbo; } } } else { for my $sbo (@$build_queue) { if ($sbo ~~ @$inst_names) { push @$upgrade_queue, $sbo; - push @remove, $sbo; } } } @@ -305,7 +296,6 @@ for my $sbo (@$upgrade_queue) { } # Remove upgrades from build queue - for my $sbo (@$upgrade_queue) { if ($sbo ~~ @$build_queue) { my $count = 0; @@ -318,8 +308,8 @@ for my $sbo (@$upgrade_queue) { } } } - @$upgrade_queue = @temp_queue; +$build = 1 if exists $$upgrade_queue[0]; INSTALL_NEW: goto BEGIN_BUILD unless $install_new; @@ -352,10 +342,11 @@ for my $sbo (@$build_queue) { } } @$build_queue = @temp_queue; +$build = 1 if exists $$build_queue[0]; BEGIN_BUILD: @$build_queue = () unless $install_new; -exit 0 unless @$build_queue gt 0 or @$upgrade_queue gt 0; +exit 0 unless $build; print "\n"; say "Upgrade queue: " . join(' ', @$upgrade_queue) if exists $$upgrade_queue[0]; say "Install queue: " . join(' ', @$build_queue) if exists $$build_queue[0]; |