sboupgrade

#!/usr/bin/perl
#
# vim: ts=4:noet
#
# sboupgrade
# script to upgrade (a) SlackBuild(s) by name
#
# authors: Jacob Pipkin <j@dawnrazor.net>
#          Luke Williams <xocel@iquidus.org>
#          Andreas Guldstrand <andreas.guldstrand@gmail.com>
# maintainer: K. Eugene Carlson <kvngncrlsn@gmail.com>
# license: MIT License

use 5.16.0;
use strict;
use warnings FATAL => 'all';
use SBO::Lib qw/ get_available_updates prompt usage_error slackbuilds_or_fetch uniq get_sbo_location get_inst_names get_installed_packages get_build_queue get_sbo_locations in merge_queues user_prompt process_sbos print_failures verify_gpg %config show_version lint_sbo_config wrapsay /;
use Getopt::Long qw(:config bundling);
use File::Basename;
use File::Copy;

my $self = basename($0);

sub show_usage {
    print <<"EOF";
Usage: $self (options) [package]

Options (defaults shown first where applicable):
  -h|--help:
    this screen.
  -v|--version:
    version information.
  --all
    this flag will upgrade everything reported by sbocheck(1).
  -b|--build-ignore (FALSE|TRUE):
    if TRUE, only offer to upgrade on version changes (not build number changes).
  -c|--noclean (FALSE|TRUE):
    if TRUE, do not clean working directories after building.
  -d|--distclean (TRUE|FALSE):
    if TRUE, delete downloaded source archives after building.
  -f|--force:
    force an upgrade, even if the version and build number are the same.
  -i|--noinstall:
    do not run upgradepkg at the end of the build process.
  -j|--jobs (FALSE|#):
    specify the number of parallel jobs (make).
  -p|--compat32:
    install a -compat32 package (multilib systems only).
  -r|--nointeractive:
    non-interactive; skips README and all prompts.
  -S|--strict-upgrades (FALSE|TRUE):
    if TRUE, SBo upgrades only when the version or build number is higher.
  -z|--force-reqs:
    rebuild dependencies as well.

EOF
	return 1;
}

my $noclean = $config{NOCLEAN};
my $distclean = $config{DISTCLEAN};
my $jobs = $config{JOBS};
my $build_ignore = $config{BUILD_IGNORE};
my $gpg = $config{GPG_VERIFY};
my $strict_upgrades = $config{STRICT_UPGRADES};
my ($help, $vers, $force, $no_install, $non_int, $force_reqs, $all);

GetOptions(
	'help|h'            => \$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,
	'build-ignore|b=s'	=> \$build_ignore,
	'all'               => \$all,
	'strict-upgrades|S=s' => \$strict_upgrades,
);

if ($help) { show_usage(); exit 0 }
if ($vers) { show_version(); exit 0 }

lint_sbo_config($self, %config);

# invalid parameters may have been passed from the command line
if ($noclean) {
	usage_error("You have provided an invalid value for -c|--noclean")
		unless ($noclean =~ /^(TRUE|FALSE)$/);
}

if ($distclean) {
	usage_error("You have provided an invalid value for -d|--distclean")
		unless ($distclean =~ /^(TRUE|FALSE)$/);
}

if ($build_ignore) {
	usage_error("You have provided an invalid value for -b|--build-ignore")
		unless ($build_ignore =~ /^(TRUE|FALSE)$/);
}

if ($strict_upgrades) {
	usage_error("You have provided an invalid value for -S|--strict-upgrades")
		unless ($strict_upgrades =~ /^(TRUE|FALSE)$/);
}

if ($jobs) {
	usage_error("You have provided an invalid value for -j|--jobs")
		unless ($jobs =~ /^\d+$/ || $jobs eq 'FALSE');
}

$noclean = $noclean eq 'TRUE' ? 1 : 0;
$distclean = $distclean eq 'TRUE' ? 1 : 0;
$build_ignore = $build_ignore eq 'TRUE' ? 1 : 0;
$gpg = $gpg eq 'TRUE' ? 1 : 0;
# from here, only Pkgs.pm uses STRICT_UPGRADES
$config{STRICT_UPGRADES} = $strict_upgrades if $strict_upgrades;

if ($gpg) { verify_gpg(); }

my $updates;
if ($all) {
	slackbuilds_or_fetch();
	print "Checking for updated SlackBuilds...\n";
	if ($build_ignore) {
		$updates = get_available_updates('VERS');
	} else {
		$updates = get_available_updates('BOTH');
	}
	push @ARGV, map { $_->{name} } @$updates;
	if (!@ARGV) { print "Nothing to update.\n"; exit 0 }
}

if (!@ARGV) { show_usage(); exit 1 }

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{SBO_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);
	if (not $locations{$sbo} and in(@ARGV, $sbo)) {
		usage_error("Unable to locate $sbo in the SlackBuilds.org tree.");
	}
	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) {
	if ($build_ignore) {
		$updates = get_available_updates('VERS') if not defined $updates;
	} else {
		$updates = get_available_updates('BOTH') if not defined $updates;
	}
	$updates{$$_{name}} = 1 for @$updates;
}

my $upgrade_queue = [];
my %warnings;

# 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$//;
		next if not $name;
		unless ($force_reqs or $force) {
			next unless $updates{$name};
		}
		my $queue = get_build_queue([$name], \%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};

	if (defined $warnings{$sbo} and $warnings{$sbo} eq 'nonexistent') {
		wrapsay "Unable to locate $sbo in the SlackBuilds.org tree.";
		if (not $non_int) {
			exit 0 unless prompt("Do you want to ignore it and continue?", default => 'yes');
		}
		next FIRST;
	}

	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];
wrapsay "\nUpgrade queue: ". join(' ', @$upgrade_queue);
unless ($non_int) {
    exit 0 unless prompt("\nAre you sure you wish to continue?", default => 'yes');
}

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;
}