path: root/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>
# license: WTFPL <http://sam.zoy.org/wtfpl/COPYING>

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 %config show_version /;
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.
  -c|--noclean (FALSE|TRUE):
    set whether or not to clean working directories after building.
  -d|--distclean (TRUE|FALSE):
    set whether or not to clean distfiles afterward.
  -f|--force:
    force an update, even if the "upgrade" version is the same or lower.
  -i|--noinstall:
    do not run installpkg at the end of the build process.
  -j|--jobs (FALSE|#):
    specify "-j" setting to make, for multicore systems; overrides conf file.
  -r|--nointeractive:
    non-interactive; skips README and all prompts.
  -z|--force-reqs:
    when used with -f, will force rebuilding an SBo's requirements as well.
  --all
    this flag will upgrade everything reported by sbocheck(1).

EOF
	return 1;
}

my $noclean = $config{NOCLEAN};
my $distclean = $config{DISTCLEAN};
my $jobs = $config{JOBS};
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,
	'all'               => \$all,
);

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

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

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

$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);
	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) {
	$updates = get_available_updates() 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$//;
		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') {
		say "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 => 'no');
		}
		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];
say "\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;
}