path: root/sboinstall

#!/usr/bin/perl
#
# vim: ts=4:noet
#
# sboinstall
# script to install (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/ %config _ERR_OPENFH get_arch get_build_queue get_installed_cpans get_installed_packages get_sbo_location get_sbo_locations in merge_queues open_fh print_failures process_sbos prompt show_version slackbuilds_or_fetch slurp usage_error user_prompt /;
use Getopt::Long qw(:config bundling);
use File::Basename;
use JSON::PP;

my $self = basename($0);

sub show_usage {
	print <<"EOF";
Usage: $self [options] sbo
       $self --use-template file

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 files/directories after the build.
  -d|--distclean (TRUE|FALSE):
   set whether or not to clean distfiles afterward.
  -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.
  -p|--compat32:
    install an SBo as a -compat32 pkg on a multilib x86_64 system.
  -r|--nointeractive:
    non-interactive; skips README and all prompts.
  -R|--norequirements:
    view the README but do not parse requirements, commands, or options.
  --reinstall:
    Ask to reinstall any already-installed packages in the requirement list.
  --create-template (FILE):
    create a template with specified requirements, commands, and options.
  --use-template (FILE):
    use a template created by --create-template to install requirements with
    specified commands and options. This also enables the --nointeractive flag.

EOF
	return 1;
}

my $noclean = $config{NOCLEAN};
my $distclean = $config{DISTCLEAN};
my $jobs = $config{JOBS};
my ($help, $vers, $no_install, $non_int, $no_reqs, $compat32, $ctemp, $utemp, $reinstall);

GetOptions(
	'help|h'            => \$help,
	'version|v'         => \$vers,
	'noclean|c=s'       => \$noclean,
	'distclean|d=s'     => \$distclean,
	'noinstall|i'       => \$no_install,
	'jobs|j=s'          => \$jobs,
	'compat32|p'        => \$compat32,
	'nointeractive|r'   => \$non_int,
	'norequirements|R'  => \$no_reqs,
	'reinstall'         => \$reinstall,
	'create-template=s' => \$ctemp,
	'use-template=s'    => \$utemp,
);

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

if (!@ARGV and not length $utemp) { show_usage(); exit 1 }
if (defined $utemp and not length $utemp) { show_usage(); exit 1 }
if (defined $ctemp and not length $ctemp) { 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');
}

if ($compat32) {
	usage_error("compat32 only works on x86_64.") unless get_arch eq 'x86_64';
}

# if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree
slackbuilds_or_fetch();

my (%warnings, $build_queue, $template);

if (length $utemp) {
	my $json = JSON::PP->new->latin1;
	$non_int = 1;

	my $data = slurp($utemp);
	if (length $data) {
		eval { $template = $json->decode($data); };
	}
	do { warn "Could not read template from $utemp.\n"; exit _ERR_OPENFH } if not defined $template;

	$build_queue = $template->{build_queue};
} else {
	if ($no_reqs or $non_int) {
		$build_queue = \@ARGV;
	} else {
		for my $sbo (@ARGV) {
			my $queue = get_build_queue([$sbo], \%warnings);
			$build_queue = merge_queues($build_queue, $queue);
		}
	}
}

# get lists of installed packages and perl modules from CPAN
my $inst_pkgs = get_installed_packages('ALL');
my $pms = get_installed_cpans();
s/::/-/g for @$pms;
my %inst_names;
$inst_names{$_->{name}} = $_ for @$inst_pkgs;

# populate %locations and sanity check
my %locations = get_sbo_locations($build_queue);
for my $sbo (@$build_queue) {
	next if $inst_names{$sbo};

	if (not $locations{$sbo} and in(@ARGV, $sbo)) {
		usage_error("Unable to locate $sbo in the SlackBuilds.org tree.")
	}
	if ($compat32) {
		usage_error("-p|--compat32 is not supported with Perl SBos.")
			if $locations{$sbo} =~ qr|/perl/[^/]+$|;
	}
}

# check for already-installeds and prompt for the rest
my (@temp_queue, %commands, %options);
if (defined $template) {
	%commands = %{ $template->{commands} };
	%options = %{ $template->{options} };
}
my $added = ' added to install queue.';
FIRST: for my $sbo (@$build_queue) {
	my $name = $compat32 ? "$sbo-compat32" : $sbo;

	if ($inst_names{$name}) {
		my $inst_msg = sprintf "%s (%s) is already installed.", $name, $inst_names{$name}{pkg};
		if ($reinstall and not $non_int) {
			next FIRST unless prompt("$inst_msg Do you want to reinstall from SBo?", default => 'no');
		} elsif ($reinstall) {
			say "$inst_msg Reinstalling.";
		} else {
			say $inst_msg;
			next FIRST;
		}
	} else {
		if ($sbo =~ /^perl-/) {
			my $pm_name = $sbo;
			$pm_name =~ s/^perl-//;
			for my $pm (@$pms) {
				if ($pm =~ /^$pm_name$/i) {
					say "$sbo installed via the cpan.";
					next FIRST;
				}
			}
		}
	}

	# Make sure the slackbuild exists on 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;
	}

	$locations{$name} = get_sbo_location($sbo) if $compat32;
	unless ($non_int) {
		# if compat32 is TRUE, we need to see if the non-compat version exists.
		if ($compat32) {
			unless ($inst_names{$sbo}) {
				say "$name requires $sbo.";
				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} = $cmds;
				say "$sbo$added";
			}
		}
		my ($cmds, $opts, $exit) = user_prompt($name, $locations{$name});
		if ($exit) {
			warn "Unable to open README for $name.\n";
			exit $exit;
		}
		if ($cmds) {
			next FIRST if $cmds eq 'N';
		}
		push(@temp_queue, $name);
		$commands{$sbo} = $cmds;
		$options{$sbo} = $opts;
		say "$name$added";
	} else {
		push(@temp_queue, $sbo);
		say "\n$name$added";
	}
}
@$build_queue = @temp_queue;

exit 0 if @{ $build_queue } == 0;
say "\nInstall queue: " . join(' ', @$build_queue);
unless ($non_int) {
    exit 0 unless prompt("\nAre you sure you wish to continue?", default => 'yes');
}

if (defined $ctemp) {
	my ($temp_fh, $exit) = open_fh($ctemp, '>');
	do { warn $temp_fh; exit $exit } if $exit;

	my $json = JSON::PP->new->latin1->pretty->canonical;
	my $build_settings = {
		build_queue => $build_queue,
		commands    => \%commands,
		options     => \%options,
	};
	print {$temp_fh} $json->encode( $build_settings );
	close $temp_fh;
	print "\nTemplate $ctemp saved.\n";
}

my ($failures, $exit) = process_sbos(
	TODO      => $build_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;
}