path: root/sboupgrade

#!/usr/bin/env perl
#
# sboupgrade
# script to update an installed SlackBuild.
#
# author: Jacob Pipkin <j@dawnrazor.net>
# date: Boomtime, the 39th day of Discord in the YOLD 3178
# license: WTFPL <http://sam.zoy.org/wtfpl/COPYING>

use SBO::Lib;
use File::Basename;
use Getopt::Std;
use File::Copy;
use strict;
use warnings FATAL => 'all';

my %config = %SBO::Lib::config;
my $self = basename ($0);

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

Options:
  -h: this screen.
  -v: version information.
  -c: do not clean working files/directories after the build.
  -d: clean distfiles afterward.
  -f: force an update, even if the "upgrade" version is the same or lower.
  -i: do not run installpkg at the end of the build process.
  -j: specify "-j" setting to make, for multicore systems; overrides conf file.
  -N: install any new SBo's listed.
  -r: skip viewing of the SBo README.
  -R: view the README but do not attempt to parse requirements.

Example:
  $self -d libsexy
  $self -ca

EOF
}

my %options;
getopts ('hvacdfj:NriopR', \%options);

show_usage () && exit (0) if exists $options{h};
show_version () && exit (0) if exists $options{v};
my $noclean = exists $options{c} ? 'TRUE' : $config{NOCLEAN};
my $distclean = exists $options{d} ? 'TRUE' : $config{DISTCLEAN};
my $force = exists $options{f} ? 'TRUE' : 'FALSE';
my $install_new = exists $options{N} ? 'TRUE' : 'FALSE';
my $no_readme = exists $options{r} ? 'TRUE' : 'FALSE';
my $no_install = exists $options{i} ? 'TRUE' : 'FALSE';
my $only_new = exists $options{o} ? 'TRUE' : 'FALSE';
my $compat32 = exists $options{p} ? 'TRUE' : 'FALSE';
my $no_reqs = exists $options{R} ? 'TRUE' : 'FALSE';

if (exists $options{j}) {
	die "You have provided an invalid parameter for -j\n" unless
		($options{j} =~ /^\d+$/ || $options{j} eq 'FALSE');
}
my $jobs = exists $options{j} ? $options{j} : $config{JOBS};

show_usage () and exit (1) unless exists $ARGV[0];

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

# build a hash of locations for each item provided on command line, at the same
# time verifying each item is a valid slackbuild
my %locations;
for my $sbo_name (@ARGV) {
	$locations{$sbo_name} = get_sbo_location ($sbo_name);
	die "Unable to locate $sbo_name in the SlackBuilds.org tree.\n" unless
		(defined $locations{$sbo_name});
}

sub get_readme_path {
	script_error ('get_readme_path requires an argument.') unless exists $_[0];
	my $sbo = shift;
	return $locations{$sbo} .'/README';
}

# this subroutine may be getting a little out of hand.
sub grok_requirements {
	script_error ('grok_requirements requires two arguments')
		unless exists $_[1];
	return if $no_reqs eq 'TRUE';
	my ($sbo, $readme) = @_;
	my $readme_orig = $readme;
	# work around missing period at end of list of requirements (given 2 \ns),
	# or no period at end of whole thing.
	$readme =~ s/$/./;
	# nasty hack.
	$readme =~ s/[Oo]ptional/./g;
	$readme =~ s/\n\n/./g;
	$readme =~ s/\n//g;
	return unless my $string = 
		($readme =~ /([Tt]his|\Q$sbo\E|)\s*[Rr]equire(s|)(|:)\s+([^\.]+)/)[3];
	# remove anything in brackets or parens
	$string =~ s/(\s)*\[[^\]]+\](\s)*//g;
	$string =~ s/(\s)*\([^\)]+\)(\s)*//g;
	# convert and to comma
	$string =~ s/(\s+|,)and\s+/,/g;
	$string =~ s/,\s+/,/g;
	my @deps = split (/,/, $string);
	# if anything has a space, we didn't parse correctly, so remove it, also
	# remove anything that's blank or has an equal sign in
	my @remove;
	for my $key (keys @deps) {
		push (@remove, $key) if ($deps[$key] =~ /[\s=]/ || $deps[$key] =~ /^$/);
	}
	for my $rem (@remove) {
		splice (@deps, $rem, 1);
		$_-- for @remove;
	}
	return unless exists $deps[0];
	FIRST: for my $need (@deps) {
		# compare against installed slackbuilds
		my $tempname = $compat32 eq 'TRUE' ? "$need-compat32" : $need;
		my @inst = get_installed_sbos ();
		SECOND: for my $key (keys @inst) {
			next FIRST if $tempname eq $inst[$key]{name};
		}
		print "\n". $readme_orig;
		print "\nIt looks like this slackbuild requires $tempname; shall I";
		print " attempt to install it first? [y] ";
		if (<STDIN> =~ /^[Yy\n]/) {
			my $cmd = "/usr/sbin/sboupgrade";
			my @args = ('-oN');
			# populate args so that they carry over correctly
			push (@args, "-c") if exists $options{c};
			push (@args, "-d") if exists $options{d};
			push (@args, "-j $options{j}") if exists $options{j};
			push (@args, "-p") if $compat32 eq 'TRUE';
			push (@args, $need);
			system ($cmd, @args);
		}
	}
	return;
}

# look for any (user|group)add commands in the README
sub grok_user_group {
	script_error ('grok_user_group requires an argument') unless exists $_[0];
	my $readme = shift;
	my @readme_array = split (/\n/, $readme);
	my @cmds;
	my $cmd_regex = qr/^\s*#\s+((user|group)add.*)/;
	for my $line (@readme_array) {
		push (@cmds, $1) if $line =~ $cmd_regex;
	}
	return unless exists $cmds[0];
	print "\n". $readme ."\n";;
	print "\nIt looks like this slackbuild requires the following command(s)";
	print " to be run first:\n";
	print "    # $_\n" for @cmds;
	print "Shall I run it/them now? [y] ";
	if (<STDIN> =~ /^[Yy\n]/) {
		for my $cmd (@cmds) {
			my @split = split (' ', $cmd);
			my $command = shift (@split);
			warn "$cmd exited non-zero" if (system ($command, @split) != 0);
		}
	}
	return 1;
}

# see if the README mentions any options
sub grok_options {
	script_error ('grok_options requires an argument') unless exists $_[0];
	my $readme = shift;
	return 7 unless $readme =~ /[A-Z]+=[^\s]/;
	my @readme_array = split (/\n/, $readme);
	print "\n". $readme;
	print "\nIt looks this slackbuilds has options; would you like to set any";
	print " when the slackbuild is run? [n] ";
	if (<STDIN> =~ /^[Yy]/) {
		my $ask = sub {
			print "\nPlease supply any options here, or enter to skip: ";
			chomp (my $opts = <STDIN>);
			return 7 if $opts =~ /^$/;
			return $opts; };
		my $kv_regex = qr/[A-Z]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/;
		my $opts = &$ask ();
		FIRST: while ($opts !~ $kv_regex) {
			warn "Invalid input received.\n";
			$opts = &$ask ();
			return 7 if $opts eq "7";
		}
		return $opts;
	}
	return;
}

# prompt for the readme, and grok the readme at this time also.
sub readme_prompt {
	script_error ('readme_prompt requires an argument.') unless exists $_[0];
	my $fh = open_read (get_readme_path (shift) );
	my $readme = do {local $/; <$fh>};
	close $fh;
	unless (grok_requirements ($sbo, $readme) ) {
		grok_user_group ($readme);
		my $opts = grok_options ($readme);
		print "\n". $readme if ($opts == 7 || ! $opts);
		my $name = $compat32 eq 'TRUE' ? "$sbo-compat32" : $sbo;
		print "\nProceed with $name? [y]: ";
		return unless <STDIN> =~ /^[Yy\n]/;
		return $opts if defined $opts;
		return 1;
	}
}

# do the things with the provided sbos - whether upgrades or new installs.
sub process_sbos {
	script_error ('process_sbos requires an argument.') unless exists $_[0];
	my @todo = @_;
	my @failures;
	FIRST: for my $sbo (@todo) {
		my $opts = readme_prompt ($sbo) unless $no_readme eq 'TRUE';
		$opts = 'FALSE' if $opts =~ /\d+/;
		# switch compat32 on if upgrading a -compat32
		$compat32 = 'TRUE' if $sbo =~ /-compat32$/;
		my ($version, $pkg, $src);
		my @sb_args = ($opts, $jobs, $sbo, $locations{$sbo}, $compat32;
		eval { ($version, $pkg, $src) = do_slackbuild (@sb_args); };
		if ($@) {
			push (@failures, $sbo);
		} else {
			unless ($distclean eq 'TRUE') {
				make_clean ($sbo, $src, $version) if $noclean eq 'FALSE';
			} else {
				make_distclean ($sbo, $src, $version, $locations{$sbo});
			}
			do_upgradepkg ($pkg) unless $no_install eq 'TRUE';
			# move package to $config{PKG_DIR} if defined
			unless ($config{PKG_DIR} eq 'FALSE') {
				unless (-d $config{PKG_DIR}) {
					mkdir ($config{PKG_DIR}) or 
						warn "Unable to create $config{PKG_DIR}\n";
				}
				if (-d $config{PKG_DIR}) {
					move ($pkg, $config{PKG_DIR});
					print "$pkg stored in $config{PKG_DIR}\n";
				} else {
					warn "$pkg left in /tmp\n";
				}
			} elsif ($distclean eq 'TRUE') {
				unlink ($pkg);
			}
		}
	}
	return @failures;
}

my @installed = get_installed_sbos ();
my @failed;

sub print_failures {
	if (exists $failed[0]) {
		print "Failures:\n";
		print "  $_\n" for @failed;
		exit 1;
	}
}

# deal with any updates prior to any new installs.
# no reason to bother if only_new is specified, ie running from sboinstall.
unless ($only_new eq 'TRUE') {
	# doesn't matter what's updatable and what's not if force is specified
	my @updates unless $force eq 'TRUE';
	unless ($force eq 'TRUE') {
		my @updates_array = get_available_updates ();
		push (@updates, $updates_array[$_]{name}) for keys @updates_array;
	}
	my @todo_upgrade;
	# but without force, we only want to update what there are updates for
	unless ($force eq 'TRUE') {
		for my $sbo (@ARGV) {
			push (@todo_upgrade, $sbo) if $sbo ~~ @updates;
		}
	} else {
		FIRST: for my $sbo (@ARGV) {
			SECOND: for my $key (keys @installed) {
				if ($sbo eq $installed[$key]{name}) {
					push (@todo_upgrade, $sbo);
					last SECOND;
				}
			}
		}
	}
	@failed = process_sbos (@todo_upgrade) if exists $todo_upgrade[0];
	print_failures () unless $install_new eq 'TRUE';
}

if ($install_new eq 'TRUE') {
	my @todo_install;
	my $has = 'FALSE';
	FIRST: for my $sbo (@ARGV) {
		my $name = $compat32 eq 'TRUE' ? "$sbo-compat32" : $sbo;
		SECOND: for my $key (keys @installed) {
			if ($name eq $installed[$key]{name}) {
				$has = 'TRUE';
				last SECOND;
			}
		}
		# if compat32 is TRUE, we need to see if the non-compat version exists.
		if ($compat32 eq 'TRUE') {
			my $has64 = 'FALSE';
			THIRD: for my $key (keys @installed) {
				if ($sbo eq $installed[$key]{name}) {
					$has64 = 'TRUE';
					last THIRD;
				}
			}
			unless ($has64 eq 'TRUE') {
				print "\nYou are attempting to install $sbo-compat32, however,";
				print " $sbo is not yet installed. Shall I install it first?";
				print " [y] ";
				if (<STDIN> =~ /^[Yy\n]/) {
					my $cmd = "/usr/sbin/sboupgrade";
					my @args = ('-oN', $sbo);
					exit 1 if (system ($cmd, @args) != 0);
				} else {
					print "Please install $sbo\n" and exit 0;
				}
			}
		}
		unless ($has eq 'TRUE') {
			push (@todo_install, $sbo);
		} else {
			print "$name already installed.\n";
		}
		$has = 'FALSE';
	}
	@failed = process_sbos (@todo_install) if exists $todo_install[0];
	print_failures ();
}

exit 0;