#!/usr/bin/perl
#
# vim: ts=4:noet
#
# sbotest (test script)
# sbotools-based reverse dependency build tester
#
# author: K. Eugene Carlson <kvngncrlsn@gmail.com>
# license: MIT License

my $SBOTEST_VERSION = "1.2.1";

use 5.016;
use strict;
use warnings;

use SBO::Lib qw/ :config :const auto_reverse build_cmp check_x32 check_x64 check_multilib get_readme_contents get_inst_names get_installed_packages get_sbo_build_number get_sbo_version get_user_group user_group_do_not_exist $conf_file get_sbo_location get_all_available get_build_queue get_full_reverse get_reverse_reqs in is_local lint_sbo_config on_blacklist rationalize_queue series_check slurp solib_check uniq version_cmp error_code usage_error script_error @reverse_concluded $slackbuilds_txt $tmpd /;

use Cwd;
use File::Basename;
use File::Copy;
use File::Path qw/ make_path remove_tree /;
use File::Temp qw/ tempdir /;
use Getopt::Long qw/ :config no_ignore_case_always bundling /;

my $self = "sbotest";

# $sbotest_compatible is exported from SBO::Lib::Util.pm; if
# it is not present, the sbotools version is too old
usage_error("The installed sbotools version is incompatible.\n\nUpgrade to 4.1.1 or 20251109-1605eca at the earliest. Exiting.") unless defined $sbotest_compatible;

# for --dry-run
our (@to_remove, @to_reuse, %cannot_reuse, @in_overrides, @dry_run_list);

my $multilib_ready = check_multilib();

my ($help, $version, $pkgdir, $sbo_archive, $jobs, $single, $full_reverse, $logdir, $archive_rebuild, $strict_upgrades, $dry_run, $no_archive, $archive_force, $archive_reverse, $so_check, $test_everything);

my $options_ok = GetOptions(
	'help|h'              => \$help,
	'version|v'           => \$version,
	'pkg-dir|k=s'         => \$pkgdir,
	'sbo-archive|A=s'     => \$sbo_archive,
	'full-reverse|f'      => \$full_reverse,
	'single|s'            => \$single,
	'jobs|j=s'            => \$jobs,
	'log-dir|l=s'         => \$logdir,
	'archive-rebuild'     => \$archive_rebuild,
	'archive-reverse'     => \$archive_reverse,
	'strict-upgrades|S=s' => \$strict_upgrades,
	'dry-run|D'           => \$dry_run,
	'no-archive'          => \$no_archive,
	'archive-force'       => \$archive_force,
	'test-everything'     => \$test_everything,
	'so-check|X=s'        => \$so_check,
);

usage_error("Non-root users can only call sbotest with -h, -v, -D and listing options. Exiting.") unless $< == 0 or $dry_run or $help or $version;

$config{SBO_ARCHIVE} = defined $sbo_archive ? $sbo_archive : $config{SBO_ARCHIVE};
my $archive_dir = $config{SBO_ARCHIVE};

$config{JOBS} = defined $jobs ? $jobs : $config{JOBS};
$config{PKG_DIR} = defined $pkgdir ? $pkgdir : $config{PKG_DIR};
$config{LOG_DIR} = defined $logdir ? $logdir : $config{LOG_DIR};
$config{STRICT_UPGRADES} = defined $strict_upgrades ? $strict_upgrades : $config{STRICT_UPGRADES};
$config{SO_CHECK} = defined $so_check ? $so_check : $config{SO_CHECK};

if ($help) {
	show_usage();
	exit 0;
}
show_version() if $version;
unless ($options_ok) {
	show_usage();
	usage_error "\nOne or more invalid options detected.";
}

usage_error("full-reverse is incompatible with single. Exiting.") if $single and $full_reverse;
usage_error("full-reverse is incompatible with test-everything. Exiting.") if $single and $test_everything;
usage_error("archive-rebuild, no-archive and archive-force are incompatible. Exiting.") if ($archive_rebuild and ($no_archive or $archive_force)) or ($no_archive and $archive_force);
usage_error("archive-force is incompatible with test-everyhting. Exiting.") if $archive_force and $test_everything;

if ($test_everything) {
	$archive_reverse = $test_everything unless $no_archive;
}
$archive_rebuild = $archive_reverse if $archive_reverse;

lint_sbo_config($self, %config);

my ($available, $all_fulldeps, @to_test, @rebuild_target, @to_unlink);
my @available = get_all_available();
my %archive_discovered;

# nothing installed at the beginning of the test
# run will be uninstalled during it
my $inst_sbos = get_inst_names(get_installed_packages('ALL'));

sub show_usage {
	print <<"EOF";
Pull:      $self pull [-B|-r]

  --git-branch|-B [BRANCH|FALSE]:
    use this git branch; with FALSE, use the default.
  --repo|-r [URL|FALSE]:
    pull from this repository URL; with FALSE, use the default.

Configure: $self config [sboconfig options]
           $self hints [sbohints options]

Search:    $self find [sbofind options]

Usage:     $self [options] sbo ...
           $self [-h|-v]

Options:
  --help|-h:
    this screen.
  --version|-v:
    sbotest version information.
  --dry-run|-D:
    report on potential operations.
  --full-reverse|-f:
    test the full reverse dependency tree.
  --jobs|-j [FALSE|#]:
    set the number of jobs to use, or ignore the JOBS setting.
  --log-dir|-L [FALSE|/path]:
    save log files under this path, appending a timestamp.
  --pkg-dir|-k [FALSE|/path]:
    save built packages under this path, appending a timestamp.
  --strict-upgrades|-S [FALSE|TRUE]:
    with --archive-rebuild, delete only out-of-date packages.
  --sbo-archive|-A [FALSE|/path]:
    reinstall saved packages from this path.
  --so-check|-X [FALSE|TRUE]:
    conduct missing shared object checks upon test failure if TRUE.
  --single|-s:
    do not test reverse dependencies.
  --archive-rebuild:
    replace all outdated packages in the archive.
  --archive-reverse:
    replace outdated packages and their reverse dependencies.
  --no-archive:
    do not save or reuse any packages.
  --archive-force:
    additionally save test targets to the archive.

By default, sbotest builds any requested scripts and the first
level of reverse dependencies, calling /usr/bin/sbopkglint for
testing after after all builds are completed. Built packages
are archived automatically except for test requests and their
reverse dependencies.
EOF
	return 1;
}

sub show_version {
	say "$self version $SBOTEST_VERSION";
	say "licensed under the MIT License";
	exit 0;
}

# remove any _SBo package installed during the test run and
# not needed for the next build; optionally takes $queue as
# an argument; no return value
sub clean_packages {
	my $queue = shift;
	# "SBO" is intentional here; do not want to put std
	# packages in an uninstall loop
	my $current_sbos = get_inst_names(get_installed_packages('SBO'));
	for my $sbo (@$current_sbos) {
		next if in $sbo, @$inst_sbos;
		if (defined $queue) { next if in $sbo, @$queue; }
		script_error("removepkg failed.") unless system('/sbin/removepkg', '--terse', $sbo) == 0;
	}
}

# find version- and build-mismatched archived packages, provided
# they are not blacklisted or already installed
sub find_outdated {
	script_error("find_outdated requires an argument.") unless @_ == 1;
	my $sbo_archive = shift;
	my (@outdated_prelim, @up_to_date, @outdated);
	my $temp_cwd = getcwd();
	if (-d $sbo_archive) {
		chdir $sbo_archive;
	} else {
		return();
	}
	opendir(my $dh, $sbo_archive);
	while (my $ls = readdir $dh) {
		next if $ls eq "." or $ls eq "..";
		next unless -f $ls;
		my ($pkg_name, $pkg_version, $pkg_build) = get_package_info($ls);
		next unless defined $pkg_name;
		next if in $pkg_name, @$inst_sbos;
		next if on_blacklist($pkg_name);
		unless (not_same_as_repo($pkg_name, $pkg_version, $pkg_build)) {
			push @up_to_date, $pkg_name;
			next;
		}
		push @outdated_prelim, $pkg_name;
		if ($config{STRICT_UPGRADES} eq 'FALSE' or not_same_as_repo($pkg_name, $pkg_version, $pkg_build) lt 0) {
			if ($dry_run) {
				push @to_remove, $ls;
			}
			else {
				say "To unlink $ls.";
				push @to_unlink, $ls;
			}
		}
	}
	close $dh;
	for my $cand (@outdated_prelim) {
		push @outdated, $cand unless in $cand, @up_to_date;
	}
	return() unless @outdated;
	return @outdated;
}

# given a package string, returns the name, version and
# build number; if the string does not appear to be an _SBo
# package, return undef; do not parse more than once for a
# single package string.
sub get_package_info {
	my $pkg_name = shift;
	my $file_name = $pkg_name;
	script_error("get_package_info requires an argument.") unless defined $pkg_name;
	my ($pkg_version, $pkg_build);
	unless (exists $archive_discovered{$pkg_name}) {
		# make sure the string could name a valid SBo package;
		# see /sbin/makepkg /^# Identify package extension
		return undef unless $pkg_name =~ m/_SBo(|compat32)\.(t[gxlb]z|tar\.([gxl]z|bz2|lzma))$/;
		my @pkg_string = split '-', $pkg_name;
		$pkg_version = $pkg_string[-3];
		$pkg_build = $pkg_string[-1];
		$pkg_build =~ s/[\D].*$//;
		$pkg_name =~ s/(-[^-]*){3}$//;
		$archive_discovered{$file_name}->{version} = $pkg_version;
		$archive_discovered{$file_name}->{build} = $pkg_build;
		$archive_discovered{$file_name}->{name} = $pkg_name;
	} else {
		$pkg_version = $archive_discovered{$file_name}->{version};
		$pkg_build = $archive_discovered{$file_name}->{build};
		$pkg_name = $archive_discovered{$file_name}->{name};
	}
	return ($pkg_name, $pkg_version, $pkg_build);
}

# install any pre-built packages from the test archive that
# meet the following criteria:
#
# - included in the build queue
# - not already in the test archive
# - not a test target
# - not already installed
# - build and version match the local repository
sub install_archived {
	my ($queue, $sbo_archive, $pkg_dir, @to_test) = @_;
	my $temp_cwd = getcwd();
	my $currently_installed = $dry_run ? $inst_sbos : get_inst_names(get_installed_packages('ALL'));
	if (-d $sbo_archive) {
		chdir $sbo_archive;
	} else {
		return();
	}
	opendir(my $dh, $sbo_archive);
	# because the contents of this directory (and installed
	# packages) can change outside of a dry run context, the
	# %cannot_reuse hash is only for dry runs; the time spent
	# here is not really noticeable if test targets are actually
	# being queued up and built one after another
	while (my $ls = readdir $dh) {
		next if exists $cannot_reuse{$ls};
		my ($pkg_name, $pkg_version, $pkg_build) = get_package_info($ls);
		unless (defined $pkg_name) {
			$cannot_reuse{$ls} = 1 if $dry_run;
			next;
		}
		next unless in $pkg_name, @$queue;
		unless (-f $ls) {
			$cannot_reuse{$ls} = 1 if $dry_run;
			next;
		}
		if (-f "$pkg_dir/$ls") {
			$cannot_reuse{$ls} = 1 if $dry_run;
			next;
		}
		unless (same_as_repo($pkg_name, $pkg_version, $pkg_build)) {
			$cannot_reuse{$ls} = 1 if $dry_run;
			next;
		}
		if (in $pkg_name, @$currently_installed) {
			$cannot_reuse{$ls} = 1 if $dry_run;
			next;
		}
		if (in $pkg_name, @to_test) {
			$cannot_reuse{$ls} = 1 if $dry_run;
			next;
		}
		if ($dry_run) {
			push @to_reuse, $ls;
		} else {
			script_error("upgradepkg failed.") unless system('/sbin/upgradepkg', '--reinstall', '--install-new', '--terse', $ls) == 0;
		}
	}
	close $dh;
	chdir $temp_cwd;
}

# given the system architecture and a location, return
# 1 if the script is supported and 0 otherwise
sub is_supported {
	my $location = shift;
	return 0 unless defined $arch and defined $location;
	if ($arch =~ /64/ and not $multilib_ready) {
		return 0 if check_x32 $location;
	} elsif ($arch !~ /64/) {
		return 0 if check_x64 $location;
	}
	return 1;
}

# takes a test queue, a weight for avoiding removals, an index to use
# to break ties and a cutoff value; reorganize the queue to attempt
# to minimize package installations and removals; return the
# rearranged queue and the number of expected pkgtools events
sub optimize_queue {
	script_error("optimize_queue requires four arguments.") unless @_ == 4;
	my ($queue, $weight, $index, $cutoff) = @_;
	my (%enqueued, %sbo_queues, %optimized, @reqs_queue, %have_requirements, @optimized_queue);
	my $cumulative = 0;
	while (my $sbo = shift @$queue) {
		my $sbo_queue = get_build_queue([$sbo]);
		pop @$sbo_queue;
		unless (@$sbo_queue) {
			push @optimized_queue, $sbo;
			$optimized{$sbo} = 1;
			next;
		}
		$sbo_queues{$sbo} = \@$sbo_queue;
		$enqueued{$sbo}->{$_} = 1 for @$sbo_queue;
		push @reqs_queue, $sbo;
	}
	$have_requirements{$_} = 1 for @reqs_queue;
	return ([ @optimized_queue ], undef) unless @reqs_queue;

	OPTIMIZE: while (my $sbo = shift @reqs_queue) {
		next if exists $optimized{$sbo};
		for my $req (@{$sbo_queues{$sbo}}) {
			if (exists $have_requirements{$req}) {
				unless (exists $optimized{$req}) {
					push @reqs_queue, $sbo;
					next OPTIMIZE;
				}
			}
		}
		$optimized{$sbo} = 1;
		push @optimized_queue, $sbo;
		$cumulative += @{$sbo_queues{$sbo}} unless $cumulative;
		my (@min_scores, @min_indices, %scores, %unweighted_scores);
		my $min_score = 100000000;
		my $reqs_index = -1;
		CANDS: for my $cand (@reqs_queue) {
			$reqs_index++;
			next if exists $optimized{$cand};
			for my $req (@{$sbo_queues{$cand}}) {
				if (exists $have_requirements{$req}) {
					next CANDS unless exists $optimized{$req};
				}
			}
			my $score = 0;
			my $unweighted_score = 0;
			for my $req (@{$sbo_queues{$cand}}) {
				unless (exists $enqueued{$sbo}->{$req}) {
					$score++;
					$unweighted_score++;
				}
				next CANDS if $score > $min_score;
			}
			for my $req (@{$sbo_queues{$sbo}}) {
				unless (exists $enqueued{$cand}->{$req}) {
					$score += $weight;
					$unweighted_score++;
				}
				next CANDS if $score > $min_score;
			}
			unless ($score) {
				splice @reqs_queue, $reqs_index, 1;
				unshift @reqs_queue, $cand;
				next OPTIMIZE;
			}
			$unweighted_scores{$cand} = $unweighted_score;
			if ($score < $min_score) {
				splice @min_scores;
				splice @min_indices;
				$min_score = $score;
			}
			if ($min_score == $score) {
				push @min_scores, $cand;
				push @min_indices, $reqs_index;
			}
		}
		if (@min_scores) {
			my $use_index = $index < @min_scores ? $index : -1;
			splice @reqs_queue, $min_indices[$use_index], 1;
			unshift @reqs_queue, $min_scores[$use_index];
			$cumulative += $unweighted_scores{$min_scores[$use_index]};
			return ([ @optimized_queue ], $cumulative) if $cutoff < $cumulative;
		} else {
			$cumulative += @{$sbo_queues{$sbo}};
		}
	}
	return ([ @optimized_queue ], $cumulative);
}

# returns 0 if the archived package matches the repo script,
# -1 if the archived package is out-of-date, and 1 if the
# archived package is of a later version
sub not_same_as_repo {
	script_error("not_same_as_repo requires three arguments.") unless @_ == 3;
	my ($pkg_name, $pkg_version, $pkg_build) = @_;
	my $pkg_location = get_sbo_location($pkg_name);
	return 0 unless $pkg_location;
	my $sbo_version = get_sbo_version($pkg_location);
	my $sbo_build = get_sbo_build_number($pkg_location);
	my $res1 = version_cmp($pkg_version, $sbo_version);
	my $res2 = build_cmp($pkg_build, $sbo_build, $pkg_version, $sbo_version);
	return $res1 if $res1;
	return $res2 if $res2;
	return 0;
}

# returns 1 if the archived package matches the repo script;
# not strictly necessary, but improves readability
sub same_as_repo {
	script_error("same_as_repo requires three arguments.") unless @_ == 3;
	return not_same_as_repo(@_) == 0;
}

usage_error("sbotools needs to be installed.") unless -x "/usr/sbin/sboconfig";
usage_error("sbo-maintainer-tools needs to be installed.") unless -x "/usr/bin/sbopkglint";
show_usage() unless @ARGV or $archive_rebuild or $test_everything;

# reminder if no SLACKBUILDS.TXT
usage_error("Use \"sbotest pull\" to fetch the repository. Exiting.") unless -s $slackbuilds_txt;

my $cwd = getcwd();
chomp(my $begin_time = `/usr/bin/date +%Y-%m-%d-%H:%M`);
chomp(my $start_date = `/usr/bin/date`);

my (@missing, @bad_lint, @bad_pkg_lint, @fail_to_build, @successful, @unsupported, @built, @copied, @tested, @already_installed, @queue_failed, @solibs, @bad_perl, @bad_python, @bad_ruby);
my (@err_usage, @err_script, @err_md5sum, @err_download, @err_noinfo, @err_circular, @err_usr_grp, @err_multilib, @basic_error);
my $pkg_dir = $config{PKG_DIR} eq 'FALSE' ? "$config{SBO_HOME}/tests/$begin_time-tests" : "$config{PKG_DIR}/$begin_time-tests";
my $log_dir = $config{LOG_DIR} eq 'FALSE' ? "$config{SBO_HOME}/logs/$begin_time-logs" : "$config{LOG_DIR}/$begin_time-logs";
my $logfile = "$config{SBO_HOME}/results/$begin_time.log";

my $name_trail_index = 0;
NEXT_NAME: while (1) {
	if (-d $pkg_dir or -d $log_dir or -f $logfile) {
		$pkg_dir = $pkg_dir . "_" . $name_trail_index;
		$log_dir = $log_dir . "_" . $name_trail_index;
		$logfile = $logfile . "_" . $name_trail_index;
		$name_trail_index++;
		next NEXT_NAME;
	}
	last;
}

if ($config{LOCAL_OVERRIDES} ne "FALSE") {
	usage_error("$config{LOCAL_OVERRIDES} is specified as the overrides directory, but does not exist. Exiting.") unless -d $config{LOCAL_OVERRIDES};
}
usage_error("the package and archive directories are the same; archive and archive-force are unneeded. Exiting.") if $archive_force and $pkg_dir eq $archive_dir;

if ($archive_rebuild) {
	usage_error("$archive_dir does not exist; exiting.") unless -d $archive_dir;
	$pkg_dir = $archive_dir;
}
unless ($dry_run) {
	make_path($pkg_dir);
	error_code("Creating $pkg_dir failed. Exiting.", _ERR_OPENFH) unless -d $pkg_dir;
	make_path("$config{SBO_HOME}/results") unless -d "$config{SBO_HOME}/results";
	error_code("Creating $config{SBO_HOME}/results failed. Exiting.", _ERR_OPENFH) unless -d "$config{SBO_HOME}/results";
	# this is done after the --archive-rebuild check above because
	# a nonexistent directory is necessarily empty
	make_path($archive_dir) unless -d $archive_dir or $no_archive;
}

unless ($single) {
	$available = +{ map {; $_, $_ } @available };
	$all_fulldeps = get_reverse_reqs($available);
}

FIRST: for my $sbo (@ARGV) {
	last if $archive_rebuild;
	if (in $sbo, @$inst_sbos and ! $single) {
		push @already_installed, $sbo;
		next FIRST;
	}
	my $dir = get_sbo_location($sbo);
	unless (defined $dir and -d $dir) {
		push @missing, $sbo;
		next FIRST;
	}
	chdir $dir;
	unless(is_supported($dir)) {
		push @unsupported, $sbo;
		next FIRST;
	}
	next FIRST if on_blacklist($sbo);
	push @to_test, $sbo;
	splice @reverse_concluded;
	unless ($single) {
		my @available_reverse;
		if ($full_reverse) {
			@available_reverse = get_full_reverse($sbo, $available, $all_fulldeps);
		} else {
			for my $sbo2 (keys %$available) {
				push @available_reverse, $sbo2 if $all_fulldeps->{$sbo}->{$sbo2};
			}
		}
		for my $target (uniq(@available_reverse)) { push @to_test, $target; }
	}
}

my (@archived_names, @up_to_date);
if (-d $archive_dir and not $no_archive) {
	chdir $archive_dir;
	opendir(my $dh, $archive_dir);
	REBUILD_CHECK: while (my $ls = readdir $dh) {
		next REBUILD_CHECK if $ls eq "." or $ls eq "..";
		my ($pkg_name, $pkg_version, $pkg_build) = get_package_info($ls);
		next REBUILD_CHECK unless defined $pkg_name;
		next REBUILD_CHECK unless defined get_sbo_location($pkg_name);
		push @archived_names, $pkg_name if $pkg_name;
		push @up_to_date, $pkg_name if same_as_repo($pkg_name, $pkg_version, $pkg_build);
	}
	close $dh;
	chdir $cwd;
	@archived_names = uniq(@archived_names) if @archived_names;
}

if ($archive_rebuild and -d $archive_dir) {
	print "Getting an initial test queue...\n";
	@to_test = find_outdated($archive_dir);
	if ($test_everything) {
		for my $sbo (@available) {
			my $dir = get_sbo_location($sbo);
			next unless defined $dir and -d $dir;
			next if on_blacklist($sbo);
			unless (is_supported($dir)) {
				push @unsupported, $sbo;
				next;
			}
			next if in $sbo, @up_to_date;
			if (in $sbo, @$inst_sbos) {
				push @already_installed, $sbo;
				next;
			}
			push @to_test, $sbo;
		}
	}
	# the faster method for finding reverse rebuild candidates depends
	# on whether there are more test targets or more archived packages
	if (@to_test < @archived_names) {
		for my $base (@to_test) {
			my @to_rebuild;
			if ($archive_reverse) {
				@to_rebuild = get_full_reverse($base, $available, $all_fulldeps);
			} else {
				@to_rebuild = get_full_reverse($base, $available, $all_fulldeps) if auto_reverse($base);
			}
			for my $rev (@to_rebuild) {
				push @rebuild_target, $rev;
				next if in $rev, @to_test;
				push @to_test, $rev if in $rev, @archived_names;
			}
		}
	} else {
		for my $base (@archived_names) {
			next if in $base, @to_test;
			my $queue = get_build_queue([$base]);
			for my $item (@$queue) {
				if (in $item, @to_test) {
					push @to_test, $base;
					last;
				}
			}
		}
	}
	print "  Done.\n";
} elsif ($test_everything) {
	print "Getting an initial test queue...\n";
	for my $sbo (@available) {
		my $dir = get_sbo_location($sbo);
		next unless defined $dir and -d $dir;
		next if on_blacklist($sbo);
		unless (is_supported($dir)) {
			push @unsupported, $sbo;
			next;
		}
		if (in $sbo, @$inst_sbos) {
			push @already_installed, $sbo;
			next;
		}
		push @to_test, $sbo;
	}
	print "  Done.\n";
}

unless (@to_test) {
	if ($archive_rebuild) { say "All archived packages installed or up-to-date."; exit; }
	say "No testing to do.";
	say ("\nRequested:\n  ", join("\n  ", @ARGV)) unless $archive_rebuild;
	say ("\nUnsupported:\n  ", join("\n  ", @unsupported)) if @unsupported;
	say ("\nAlready Installed\n  ", join("\n  ", @already_installed)) if @already_installed;
	say ("\nMissing:\n  ", join("\n  ", @missing)) if @missing;
	say ("\nUse \"sbotest --single\" to test scripts that are already installed.") if @already_installed;
	exit;
}
@to_test = uniq(@to_test);
my @grand_queue;
unless ($test_everything) {
	for (@to_test) {
		push @grand_queue, $_;
		my $queue = get_build_queue([$_]);
		for my $sbo (@$queue) {
			next if in $sbo, @up_to_date;
			next if in $sbo, @grand_queue;
			next if on_blacklist($sbo);
			next if in $sbo, @$inst_sbos;
			my $dir = get_sbo_location($sbo);
			next unless defined $dir and -d $dir;
			next unless is_supported($dir);
			push @grand_queue, $sbo;
		}
	}
	@grand_queue = uniq(@grand_queue);
} else {
	@grand_queue = @to_test;
}

if (@grand_queue > 1) {
	print "Reducing the number of package installations and removals...\n";
	@grand_queue = sort @grand_queue;
	my $weight = 1;
	my $cumulative = 0;
	my $cumulative_old = 10000000000;
	my @grand_queue_prev = @grand_queue;
	while ($cumulative < $cumulative_old) {
		print "  Trying a removal avoidance weight of $weight...\n";
		my $grand_queue_new;
		($grand_queue_new, $cumulative) = optimize_queue([@grand_queue_prev], $weight, 0, $cumulative_old);
		my @grand_queue_new = @{ $grand_queue_new };
		unless (defined $cumulative) {
			print "No dependencies needed; using alphabetical order.\n";
			last;
		}
		elsif ($cumulative < $cumulative_old) {
			$cumulative_old = $cumulative;
			$cumulative = 0;
			@grand_queue_prev = @grand_queue_new;
			$weight++;
		} else {
			$weight--;
			print "  Further testing for weights around $weight...\n";
			my $weight_3 = $weight + 0.5;
			my $weight_2 = $weight + 0.25;
			my $weight_1 = $weight - 0.25;
			my $weight_0 = $weight - 0.5;
			my $cutoff = $cumulative_old;
			my ($grand_queue_back, $cumulative_back) = optimize_queue([@grand_queue_prev], $weight, -1, $cutoff);
			$cutoff = $cumulative_old < $cumulative_back ? $cumulative_old : $cumulative_back;
			my ($grand_queue_0_front, $cumulative_0_front) = optimize_queue([@grand_queue_prev], $weight_0, 0, $cutoff);
			$cutoff = $cumulative_old < $cumulative_0_front ? $cumulative_old : $cumulative_0_front;
			my ($grand_queue_0_back, $cumulative_0_back) = optimize_queue([@grand_queue_prev], $weight_0, -1, $cutoff);
			$cutoff = $cumulative_old < $cumulative_0_back ? $cumulative_old : $cumulative_0_back;
			my ($grand_queue_1_front, $cumulative_1_front) = optimize_queue([@grand_queue_prev], $weight_1, 0, $cutoff);
			$cutoff = $cumulative_old < $cumulative_1_front ? $cumulative_old : $cumulative_1_front;
			my ($grand_queue_1_back, $cumulative_1_back) = optimize_queue([@grand_queue_prev], $weight_1, -1, $cutoff);
			$cutoff = $cumulative_old < $cumulative_1_back ? $cumulative_old : $cumulative_1_back;
			my ($grand_queue_2_front, $cumulative_2_front) = optimize_queue([@grand_queue_prev], $weight_2, 0, $cutoff);
			$cutoff = $cumulative_old < $cumulative_2_front ? $cumulative_old : $cumulative_2_front;
			my ($grand_queue_2_back, $cumulative_2_back) = optimize_queue([@grand_queue_prev], $weight_2, -1, $cutoff);
			$cutoff = $cumulative_old < $cumulative_2_back ? $cumulative_old : $cumulative_2_back;
			my ($grand_queue_3_front, $cumulative_3_front) = optimize_queue([@grand_queue_prev], $weight_3, 0, $cutoff);
			$cutoff = $cumulative_old < $cumulative_3_front ? $cumulative_old : $cumulative_3_front;
			my ($grand_queue_3_back, $cumulative_3_back) = optimize_queue([@grand_queue_prev], $weight_3, -1, $cutoff);
			$cutoff = $cumulative_old < $cumulative_3_back ? $cumulative_old : $cumulative_3_back;

			if ($cutoff == $cumulative_old) {
				@grand_queue = @grand_queue_prev;
			} elsif ($cutoff == $cumulative_back) {
				@grand_queue = @{ $grand_queue_back };
			} elsif ($cutoff == $cumulative_0_front) {
				$weight = $weight_0;
				@grand_queue = @{ $grand_queue_0_front };
			} elsif ($cutoff == $cumulative_0_back) {
				$weight = $weight_0;
				@grand_queue = @{ $grand_queue_0_back };
			} elsif ($cutoff == $cumulative_1_front) {
				$weight = $weight_1;
				@grand_queue = @{ $grand_queue_1_front };
			} elsif ($cutoff == $cumulative_1_back) {
				$weight = $weight_1;
				@grand_queue = @{ $grand_queue_1_back };
			} elsif ($cutoff == $cumulative_2_front) {
				$weight = $weight_2;
				@grand_queue = @{ $grand_queue_2_front };
			} elsif ($cutoff == $cumulative_2_back) {
				$weight = $weight_2;
				@grand_queue = @{ $grand_queue_2_back };
			} elsif ($cutoff == $cumulative_3_front) {
				$weight = $weight_3;
				@grand_queue = @{ $grand_queue_3_front };
			} elsif ($cutoff == $cumulative_3_back) {
				$weight = $weight_3;
				@grand_queue = @{ $grand_queue_3_back };
			}
			print "  Done. Package removal avoidance factor of $weight.\n";
			last;
		}
	}
}
@rebuild_target = uniq(@rebuild_target) if @rebuild_target;

SECOND: for my $sbo (@grand_queue) {
	my $dir = get_sbo_location($sbo);
	# skip if unsupported
	unless (is_supported($dir)) {
		push @unsupported, $sbo;
		next SECOND;
	}
	# skip if blacklisted
	next SECOND if on_blacklist($sbo);
	# skip if something in the queue has failed
	next SECOND if in $sbo, @queue_failed;
	my $queue = get_build_queue([$sbo]);
	chdir $dir;
	clean_packages($queue) unless $dry_run;
	install_archived($queue, $archive_dir, $pkg_dir, @to_test) unless $no_archive or $pkg_dir eq $archive_dir;
	if ($dry_run) {
		for my $cand (@$queue) {
			push @in_overrides, $cand if is_local($cand) and not in $cand, @to_reuse;
		}
	}
	# nothing past this point is needed in
	# --dry-run
	push @dry_run_list, $sbo if in $sbo, @to_test;
	next SECOND if $dry_run;
	push @bad_lint, $sbo unless system('sbolint') == 0;
	# reinstall anything already built on this
	# test run...
	chdir $pkg_dir;
	my @to_reinstall;
	opendir(my $dh, $pkg_dir);
	PKG_CHECK: while (my $ls = readdir $dh) {
		next PKG_CHECK if $ls eq "." or $ls eq "..";
		my ($pkg_name, $pkg_version, $pkg_build) = get_package_info($ls);
		next PKG_CHECK unless defined $pkg_name;
		my $is_same = same_as_repo($pkg_name, $pkg_version, $pkg_build);
		# but not if the target itself has already
		# been built and does not need an automatic
		# rebuild; in that case, skip
		next SECOND if $pkg_name eq $sbo and $is_same and not in $pkg_name, @rebuild_target;
		next SECOND if $pkg_name eq $sbo and $is_same and in $pkg_name, @built;
		push @to_reinstall, $ls if in $pkg_name, @$queue and $is_same;
	}
	close $dh;
	if (@to_reinstall) {
		my $currently_installed = get_inst_names(get_installed_packages('ALL'));
		REINSTALL: for my $script (@to_reinstall) {
			# validity of package file name already done
			my ($script_name, $script_version, $script_build) = get_package_info($script);
			next REINSTALL if in $script_name, @$currently_installed or (in $script_name, @rebuild_target and not in $script_name, @built);
			script_error("upgradepkg failed.") unless system('/sbin/upgradepkg', '--reinstall', '--install-new', '--terse', $script) == 0;
		}
	}
	# run any required useradd and groupadd
	# commands
	UGCHECK: for my $item (@$queue) {
		my $location = get_sbo_location($item);
		next UGCHECK unless defined $location;
		my $non_compat_item = $item;
		$non_compat_item =~ s/-compat32//;
		my $cmds;
		if (-s "/var/log/sbotools/$non_compat_item") {
			chomp(my $saved_opts = slurp "/var/log/sbotools/$non_compat_item");
			$cmds = get_user_group($item, $location, $saved_opts);
		} else {
			$cmds = get_user_group($item, $location);
		}
		if ($$cmds[0]) {
			my $nonexistent = user_group_do_not_exist(@$cmds);
			if (@$nonexistent) {
				say "Adding user and/or group for $item...";
				for (@$nonexistent) {
					print "  $_\n";
					system($_);
				}
			}
		}
	}
	# give the package an isolated $TMP directory to prevent previous
	# failed builds from interfering; remove at the end
	my $sbo_tmp = tempdir(DIR => $tmpd);
	script_error("Failed to make a temporary directory for $sbo.") unless -d $sbo_tmp;
	my $save_tmp = $ENV{TMP} if exists $ENV{TMP};
	$ENV{TMP} = $sbo_tmp;
	make_path $log_dir unless -d $log_dir;
	my $sboinstall_res = "$log_dir/.sboinstall_res";
	unlink $sboinstall_res if -f $sboinstall_res;
	my $cmd = "sboinstall -oirR -L $log_dir -k $pkg_dir $sbo";
	$cmd = $single ? $cmd . " --reinstall" : $cmd;
	$cmd .= " ; echo \$? > $sboinstall_res";
	system($cmd);
	chomp(my $res = slurp $sboinstall_res);
	remove_tree $sbo_tmp if -d $sbo_tmp;
	$ENV{TMP} = defined $save_tmp ? $save_tmp : "";
	unless ($res == 0) {
		unless (in $sbo, @queue_failed) {
			push @fail_to_build, $sbo;
			if ($res == _ERR_USAGE) {
				push @err_usage, $sbo;
			} elsif ($res == _ERR_SCRIPT) {
				push @err_script, $sbo;
			} elsif ($res == _ERR_MD5SUM) {
				push @err_md5sum, $sbo;
			} elsif ($res == _ERR_CIRCULAR) {
				push @err_circular, $sbo;
			} elsif ($res == _ERR_USR_GRP) {
				push @err_usr_grp, $sbo;
			} elsif ($res == _ERR_NOMULTILIB or $res == _ERR_CONVERTPKG or $res == _ERR_NOCONVERTPKG) {
				push @err_multilib, $sbo;
			} else {
				push @basic_error, $sbo;
			}
		}
		# reverse dependencies in the queue should be
		# skipped in case of failure
		for my $cand (@grand_queue) {
			next if $cand eq $sbo;
			my $cand_queue = get_build_queue([$cand]);
			next unless $cand_queue;
			push @queue_failed, $cand if in $sbo, @$cand_queue;
		}
		my @preserve;
		for my $requested (@to_test) {
			next if $requested eq $sbo;
			next if in $requested, @queue_failed;
			my $req_queue = get_build_queue([$requested]);
			next unless $req_queue;
			push @preserve, @$req_queue;
		}
		for my $requested (@to_test) {
			next if $requested eq $sbo;
			next unless in $requested, @queue_failed;
			my $req_queue = get_build_queue([$requested]);
			next unless $req_queue;
			for (@$req_queue) {
				next if $_ eq $sbo;
				push @queue_failed, $_ unless in $_, @preserve;
			}
		}
		@queue_failed = uniq @queue_failed if @queue_failed;
		if ($config{SO_CHECK} eq "TRUE" and in @basic_error, $sbo) {
			my @post_test_installed = @{ get_installed_packages("SBO") };
			if (@post_test_installed) {
				my $post_test_pkg = +{ map {; $_->{name}, $_->{pkg} } @post_test_installed };
				my $pkg_count = @post_test_installed;
				say "Checking $pkg_count installed for solibs and compatibility...";
				for my $installed (keys %$post_test_pkg) {
					unless (solib_check($post_test_pkg->{$installed})) {
						say "  Shared object dependencies missing for $installed.";
						push @solibs, "$sbo:" unless in "$sbo:", @solibs;
						push @solibs, "  $installed";
					}
					unless ((series_check($post_test_pkg->{$installed}, "perl"))[0]) {
						say "  $installed is incompatible with system perl.";
						push @bad_perl, "$sbo:" unless in "$sbo:", @bad_perl;
						push @bad_perl, "  $installed";
					}
					unless ((series_check($post_test_pkg->{$installed}, "python"))[1]) {
						say "  $installed is incompatible with system python.";
						push @bad_python, "$sbo:" unless in "$sbo:", @bad_python;
						push @bad_python, "  $installed";
					}
					unless ((series_check($post_test_pkg->{$installed}, "ruby"))[2]) {
						say "  $installed is incompatible with system ruby.";
						push @bad_ruby, "$sbo:" unless in "$sbo:", @bad_ruby;
						push @bad_ruby, "  $installed";
					}
				}
				say "Done.";
			}
		}
	} else {
		push @built, $_ for @$queue;
	}
	chdir $pkg_dir;
	opendir($dh, $pkg_dir);
	while (my $ls = readdir $dh) {
		next if $ls eq '.' or $ls eq '..';
		my ($pkg_name, $pkg_version, $pkg_build) = get_package_info($ls);
		next unless defined $pkg_name;
		next unless same_as_repo($pkg_name, $pkg_version, $pkg_build);
		# sbopkglint for targets and reverse dependencies
		# is done now
		if (in $pkg_name, @to_test and not in $pkg_name, @tested and in $pkg_name, @built) {
			my $log_name = "$log_dir/sbopkglint_$pkg_name";
			unlink "$log_dir/.res" if -f "$log_dir/.res";
			my $cmd = "( /usr/bin/sbopkglint $ls 2>&1; echo \$? > $log_dir/.res) | tee $log_name";
			system('bash', '-c', $cmd);
			my $sbopkglint_res = slurp "$log_dir/.res";
			if (defined $sbopkglint_res and $sbopkglint_res == 0) {
				push @successful, $pkg_name;
			} else {
				push @bad_pkg_lint, $pkg_name;
			}
			push @tested, $pkg_name;
		}
		# archive built packages; dependencies only by
		# default, or all with --archive-force; skip if
		# archive_dir and pkg_dir are the same
		next if $no_archive or $pkg_dir eq $archive_dir;
		if ($archive_force or not in $pkg_name, @to_test) {
			unless (in $ls, @copied) {
				say "Archiving $ls.";
				push @copied, $ls;
				copy $ls, "$archive_dir/$ls";
			}
		}
	}
	close $dh;
}

if ($dry_run) {
	@to_reuse = uniq(sort(@to_reuse)) if @to_reuse;
	@to_remove = uniq(sort(@to_remove)) if @to_remove;
	@in_overrides = uniq(sort(@in_overrides)) if @in_overrides;
	@unsupported = uniq(sort(@unsupported))if @unsupported;
	@already_installed = sort(@already_installed) if @already_installed;

	say "";
	my $message = $archive_rebuild ? "Archive Rebuild Dry Run:" : "Dry Run:";
	$message = $test_everything ? "Full Repo Test Dry Run:" : $message;
	say "$message";
	say ("\nRequested: ", join(" ", @ARGV)) if @ARGV;
	say ("\nMissing: ", join(" ", @missing)) if @missing;
	say ("\nUnsupported: ", join(" ", @unsupported)) if @unsupported;
	say ("\nAlready Installed: ", join(" ", @already_installed)) if @already_installed;
	say ("\nOverrides: ", join(" ", @in_overrides)) if @in_overrides;
	if (@to_reuse) {
		my $reuse_number = @to_reuse;
		say "\nTo reuse $reuse_number from $archive_dir.";
	}
	say ("\nTest queue:\n  ", join("\n  ", @dry_run_list)) if @dry_run_list;
	say ("\nTo remove from archive:\n  ", join("\n  ", @to_remove)) if @to_remove;
	say ("\nUse \"sbotest --single\" to test scripts that are already installed.") if @already_installed;
	exit;
}

# for the last run only
clean_packages();

my (@unlinked, @not_unlinked);
if (not $no_archive and -d $archive_dir and @to_unlink) {
	@to_unlink = uniq @to_unlink;
	if (chdir $archive_dir) {
		print "\nRemoving outdated packages from the archive...\n";
		for (@to_unlink) {
			my ($unlink_name, $unlink_version, $unlink_build) = get_package_info($_);
			if (in $unlink_name, @fail_to_build or in $unlink_name, @queue_failed) {
				push @not_unlinked, $_ if -f $_;
				next;
			}
			if (unlink $_) {
				push @unlinked, $_;
			} else {
				push @not_unlinked, $_ if -f $_;
			}
		}
	}
}

unlink "$log_dir/.res" if -f "$log_dir/.res";
unlink "$log_dir/.sboinstall_res" if -f "$log_dir/.sboinstall_res";
chdir $cwd;

@successful = uniq(sort(@successful)) if @successful;
@bad_pkg_lint = uniq(sort(@bad_pkg_lint)) if @bad_pkg_lint;
if (@queue_failed) {
	@queue_failed = grep { in $_, @to_test } @queue_failed;
	@queue_failed = uniq(sort(@queue_failed));
}
@unlinked = uniq(sort(@unlinked)) if @unlinked;
@not_unlinked = uniq(sort(@not_unlinked)) if @not_unlinked;
my @requested = uniq(sort(@ARGV)) if @ARGV;

chomp(my $end_date = `/usr/bin/date`);

say ("\nRequested:\n  ", join("\n  ", @requested)) if @requested;
say ("\nSuccessful:\n  ", join("\n  ", sort @successful)) if @successful;
say ("\nMissing:\n  ", join("\n  ", sort @missing)) if @missing;
say ("\nBasic Build Failure:\n  ", join("\n  ", sort @basic_error)) if @basic_error;
say ("\nDependency Failed:\n  ", join("\n  ", sort @queue_failed)) if @queue_failed;
say ("\nsbotest Script Error:\n  ", join("\n  ", sort @err_usage)) if @err_usage;
say ("\nsbotools Script Error:\n  ", join("\n  ", sort @err_script)) if @err_script;
say ("\nBad md5sum:\n  ", join("\n  ", sort @err_md5sum)) if @err_md5sum;
say ("\nFailed Download:\n  ", join("\n  ", sort @err_download)) if @err_download;
say ("\nNo Download Info:\n  ", join("\n  ", sort @err_noinfo)) if @err_noinfo;
say ("\nCircular Dependencies:\n  ", join("\n  ", sort @err_circular)) if @err_circular;
say ("\nMissing User/Group:\n  ", join("\n  ", sort @err_usr_grp)) if @err_usr_grp;
say ("\nMultilib Failure:\n  ", join("\n  ", sort @err_multilib)) if @err_multilib;
say ("\nBad sbolint:\n  ", join("\n  ", sort @bad_lint)) if @bad_lint;
say ("\nBad sbopkglint:\n  ", join("\n  ", sort @bad_pkg_lint)) if @bad_pkg_lint;
say ("\nUnsupported:\n  ", join("\n  ", sort @unsupported)) if @unsupported;
say ("\nAlready Installed:\n ", join("\n ", sort @already_installed)) if @already_installed;
say ("\nMissing Solibs:\n  ", join("\n  ", @solibs)) if @solibs;
say ("\nIncompatible perl:\n  ", join("\n  ", @bad_perl)) if @bad_perl;
say ("\nIncompatible python:\n  ", join("\n  ", @bad_python)) if @bad_python;
say ("\nIncompatible ruby:\n  ", join("\n  ", @bad_ruby)) if @bad_ruby;
say ("\nRemoved from Archive:\n  ", join("\n  ", sort @unlinked)) if @unlinked;
if (@not_unlinked) {
	say ("\nOutdated in Archive:\n  ", join("\n  ", sort @not_unlinked));
	say "\nOutdated scripts are not removed if the new version fails to build.\n";
}
say ("\nUse \"sbotest --single\" to test scripts that are already installed.") if @already_installed;

unlink $logfile if -f $logfile;
open(my $fh, '>', $logfile);
error_code("\nNo log could be written; exiting.", _ERR_OPENFH) unless defined $fh;

my $label = $archive_rebuild ? "Archive update" : "Test";
say {$fh} "$label began: $start_date";
say {$fh} "$label ended: $end_date";
say {$fh} ("\nRequested:\n  ", join("\n  ", sort @requested)) if @requested;
say {$fh} ("\nSuccessful:\n  ", join("\n  ", sort @successful)) if @successful;
say {$fh} ("\nMissing:\n  ", join("\n  ", sort @missing)) if @missing;
say {$fh} ("\nBasic Build Failure:\n  ", join("\n  ", sort @basic_error)) if @basic_error;
say {$fh} ("\nDependency Failed:\n  ", join("\n  ", sort @queue_failed)) if @queue_failed;
say {$fh} ("\nsbotest Script Error:\n  ", join("\n  ", sort @err_usage)) if @err_usage;
say {$fh} ("\nsbotools Script Error:\n  ", join("\n  ", sort @err_script)) if @err_script;
say {$fh} ("\nBad md5sum:\n  ", join("\n  ", sort @err_md5sum)) if @err_md5sum;
say {$fh} ("\nFailed Download:\n  ", join("\n  ", sort @err_download)) if @err_download;
say {$fh} ("\nNo Download Info:\n  ", join("\n  ", sort @err_noinfo)) if @err_noinfo;
say {$fh} ("\nCircular Dependencies:\n  ", join("\n  ", sort @err_circular)) if @err_circular;
say {$fh} ("\nMissing User/Group:\n  ", join("\n  ", sort @err_usr_grp)) if @err_usr_grp;
say {$fh} ("\nMultilib Failure:\n  ", join("\n  ", sort @err_multilib)) if @err_multilib;
say {$fh} ("\nBad sbolint:\n  ", join("\n  ", sort @bad_lint)) if @bad_lint;
say {$fh} ("\nBad sbopkglint:\n  ", join("\n  ", sort @bad_pkg_lint)) if @bad_pkg_lint;
say {$fh} ("\nUnsupported:\n  ", join("\n  ", sort @unsupported)) if @unsupported;
say {$fh} ("\nAlready Installed:\n ", join("\n ", sort @already_installed)) if @already_installed;
say {$fh} ("\nMissing Solibs:\n  ", join("\n  ", @solibs)) if @solibs;
say {$fh} ("\nIncompatible perl:\n  ", join("\n  ", @bad_perl)) if @bad_perl;
say {$fh} ("\nIncompatible python:\n  ", join("\n  ", @bad_python)) if @bad_python;
say {$fh} ("\nIncompatible ruby:\n  ", join("\n  ", @bad_ruby)) if @bad_ruby;
say {$fh} ("\nRemoved from Archive:\n  ", join("\n  ", sort @unlinked)) if @unlinked;
if (@not_unlinked) {
	say {$fh} ("\nOutdated in Archive:\n  ", join("\n  ", sort @not_unlinked));
	say {$fh} "\nOutdated scripts are not removed if the new version fails to build.\n";
}
say {$fh} ("\nUse \"sbotest --single\" to test scripts that are already installed.") if @already_installed;

close $fh;
say "\nLog written to $logfile.";

END { say ""; }
