#!/usr/bin/perl # # vim: set ts=4:noet # # sboupgrade # script to upgrade (a) SlackBuild(s) by name # # authors: Jacob Pipkin # Luke Williams # Andreas Guldstrand # license: WTFPL use 5.16.0; use strict; use warnings FATAL => 'all'; use SBO::Lib qw/ get_available_updates usage_error slackbuilds_or_fetch uniq get_sbo_location get_inst_names get_installed_packages get_build_queue get_sbo_locations merge_queues user_prompt process_sbos print_failures %config show_version /; use Getopt::Long qw(:config bundling); use File::Basename; use File::Copy; my $self = basename($0); sub show_usage { print < \$help, 'version|v' => \$vers, 'noclean|c=s' => \$noclean, 'distclean|d=s' => \$distclean, 'force|f' => \$force, 'noinstall|i' => \$no_install, 'jobs|j=s' => \$jobs, 'nointeractive|r' => \$non_int, 'force-reqs|z' => \$force_reqs, 'all' => \$all, ); show_usage() and exit 0 if $help; show_version() and exit 0 if $vers; my $updates; if ($all) { slackbuilds_or_fetch(); print "Checking for updated SlackBuilds...\n"; $updates = get_available_updates(); push @ARGV, map { $_->{name} } @$updates; } show_usage() and exit 1 unless exists $ARGV[0]; $noclean = $noclean eq 'TRUE' ? 1 : 0; $distclean = $distclean eq 'TRUE' ? 1 : 0; if ($jobs) { usage_error("You have provided an invalid value for -j|--jobs") unless ($jobs =~ /^\d+$/ || $jobs eq 'FALSE'); } usage_error("-r|--nointeractive and -z|--force-reqs can not be used together.") if $non_int && $force_reqs; # if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree slackbuilds_or_fetch(); my @sbos = uniq @ARGV; # Filter out standard packages my $std_installs = get_inst_names(get_installed_packages('STD')); my %std_names; $std_names{$_} = 1 for @$std_installs; @sbos = grep { not $std_names{$_} } @sbos; # pull locations for everything specified on command line. my %locations; for my $sbo (@sbos) { my $name = $sbo; $name =~ s/-compat32//; $locations{$sbo} = get_sbo_location($name); usage_error("Unable to locate $sbo in the SlackBuilds.org tree.") unless $locations{$sbo}; if ($sbo =~ /-compat32$/) { usage_error("compat32 Perl SBos are not supported.") if $locations{$sbo} =~ qr|/perl/[^/]+$|; } } # 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; my %updates; if (not $non_int or not $force) { $updates //= get_available_updates(); $updates{$$_{name}} = 1 for @$updates; } my $upgrade_queue = []; # 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 if ($non_int) { if ($force) { for my $sbo (@sbos) { push @$upgrade_queue, $sbo if $inst_names{$sbo}; } } else { for my $sbo (@sbos) { push @$upgrade_queue, $sbo if $updates{$sbo}; } } } else { for my $sbo (@sbos) { my $name = $sbo; $name =~ s/-compat32$//; my $queue = get_build_queue([$name], my $warnings); if (not $force_reqs) { @$queue = grep { !$inst_names{$_} or $updates{$_} } @$queue; } push @$queue, $name if $force; my $cqueue; # get locations for all the things 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; for my $key (keys %locs) { my $val = $locs{$key}; $key =~ s/$/-compat32/; $clocs{$key} = $val; } %locs = %clocs; } @locations{keys %locs} = values %locs; $upgrade_queue = merge_queues($upgrade_queue, $queue); } } # Get user input regarding upgrades my (@temp_queue, %commands, %options); FIRST: for my $sbo (@$upgrade_queue) { next FIRST if $std_names{$sbo}; unless ($non_int) { my ($cmds, $opts, $exit) = user_prompt($sbo, $locations{$sbo}); if ($exit) { warn "Unable to open README for $sbo.\n"; exit $exit; } if ($cmds) { next FIRST if $cmds eq 'N'; } push(@temp_queue, $sbo); $commands{$sbo} = $cmds; $options{$sbo} = $opts; say "$sbo added to upgrade queue."; } else { push(@temp_queue, $sbo); say "\n$sbo added to upgrade queue."; } } @$upgrade_queue = @temp_queue; exit 0 unless exists $$upgrade_queue[0]; say "\nUpgrade queue: ". join(' ', @$upgrade_queue); unless ($non_int) { print "\nAre you sure you wish to continue? [y]: "; exit 0 unless =~ /^[Yy\n]/; } my ($failures, $exit) = process_sbos( TODO => $upgrade_queue, CMDS => \%commands, OPTS => \%options, JOBS => $jobs, LOCATIONS => \%locations, NOINSTALL => $no_install, NOCLEAN => $noclean, DISTCLEAN => $distclean, NON_INT => $non_int, ); print_failures($failures); if ($exit) { exit $exit; } else { exit 0; }