package SBO::Lib::Build;

# vim: ts=2:et

use 5.016;
use strict;
use warnings;

our $VERSION = '4.4.2';

use SBO::Lib::Util qw/ :config :const :times :colors prompt error_code script_error get_sbo_from_loc check_multilib on_blacklist open_fh open_read uniq save_options wrapsay in in_regexp read_ionice set_ionice $userland_32 /;
use SBO::Lib::Tree qw/ get_sbo_location /;
use SBO::Lib::Info qw/ get_sbo_version check_x32 get_requires get_reverse_reqs /;
use SBO::Lib::Download qw/ get_sbo_downloads get_filename_from_link check_distfiles stage unstage /;
use SBO::Lib::Pkgs qw/ get_installed_packages /;

use Exporter 'import';
use Fcntl qw(F_SETFD F_GETFD);
use File::Basename;
use File::Copy; # copy() and move()
use File::Path qw/ make_path remove_tree /;
use File::Temp qw/ tempdir tempfile /;
use Term::ANSIColor qw/ RESET /;
use Tie::File;
use Time::HiRes qw/ time /;
use Cwd;
use JSON::PP;

use sigtrap qw/ handler _build_terminated ABRT INT QUIT TERM /;
use sigtrap qw/ handler _time_stop TSTP /;
use sigtrap qw/ handler _time_restart CONT /;

our @EXPORT_OK = qw{
  do_convertpkg
  do_slackbuild
  do_upgradepkg
  get_build_queue
  get_full_queue
  get_full_reverse
  get_full_reverse_queue
  get_pkg_name
  get_src_dir
  get_tmp_extfn
  make_clean
  make_distclean
  merge_queues
  perform_sbo
  process_sbos
  rationalize_queue
  run_tee
  write_resume

  $tempdir
  $tmpd
  $env_tmp
  @last_level_reverse
  %concluded
  @reverse_concluded
  %warnings
  %notices
};

our %EXPORT_TAGS = (
  all => \@EXPORT_OK,
);

=pod

=encoding UTF-8

=head1 NAME

SBO::Lib::Build - Routines for building Slackware packages from SlackBuilds.org.

=head1 SYNOPSIS

  use SBO::Lib::Build qw/ perform_sbo /;

  my ($foo, $bar, $exit) = perform_sbo(LOCATION => $location);

=head1 VARIABLES

=head2 %concluded

This is a shared hash that contains already-calculated build queues.
It is used by C<get_build_queue()> to reduce wasted time and check for
circular dependencies. Note that C<%concluded> is cleared
by C<sbotool(1)> when using the C<Refresh> button.

=head2 $env_tmp

This reflects C<$TMP> from the environment, being C<undef> if it is not
set.

=head2 @reverse_concluded

This is a shared array that tracks scripts with verified
reverse dependency chains; it is used by C<get_full_reverse()> to check for
circular reverse dependencies. Note that C<@reverse_concluded> is cleared
by C<sbofind(1)>, C<sboremove(1)> and C<sbotool(1)> between results.

=head2 $tempdir

This is a temporary directory created for sbotools' use. It should be
removed when sbotools exits.

=head2 $tmpd

This is the same as C<$TMP> if it is set. Otherwise, it is C</tmp/SBo>.

=head2 @last_level_reverse

This is an array containing the last level of reverse dependencies generated
by C<sbofind(1)> with C<all-reverse> and C<top-reverse>. It is used only by
C<sbofind(1)>.

=head2 %notices

This is a shared hash that contains per-script notification strings to display
during C<user_prompt()>; see C<SBO::Lib::Readme(3)>.

=head2 @upcoming

This is a shared, non-exportable array that contains hashes with the source
files needed by each script in the queue. Each hash drops out of the array
when its corresponding script has been built.

=head2 %warnings

This is a shared hash that contains per-script warnings. Possible warnings
currently include C<%README%> and C<nonexistent>.

=cut

# get $TMP from the env, if defined - we use two variables here because there
# are times when we need to know if the environment variable is set, and other
# times where it doesn't matter.
our $env_tmp = $ENV{TMP};
our $tmpd = $env_tmp ? $env_tmp : '/tmp/SBo';
make_path($tmpd) unless -d $tmpd;

our $tempdir;
$tempdir = tempdir(CLEANUP => 1, DIR => $tmpd) if $< == 0;

# this hash contains already-calculated build queues
our %concluded;
# this array is used to check for circular dependencies in reverse queue
# calculations
our @reverse_concluded;

# this array keeps track of files needed by subsequent scripts
our @upcoming;

# this array retains last-level reverse dependencies found by get_full_reverse
our @last_level_reverse;

# a universal warnings hash; warnings currently include README and nonexistence
our %warnings;
our %notices;

# an array of distfile-related hashes
our @distfiles;

=head1 SUBROUTINES

=cut

=head2 do_convertpkg

  my ($name32, $exit) = do_convertpkg($name64);

C<do_convertpkg()> runs C<convertpkg> on the package in C<$name64>.

On success, it returns the name of the converted package and an exit status. On
failure, it returns an error message instead of the package name.

=cut

sub do_convertpkg {
  script_error('do_convertpkg requires an argument.') unless @_ == 1;
  my $pkg = shift;
  my $log_name = basename $pkg;
  $log_name =~ s/(-[^-]*){3}$//;
  my $c32tmpd = $env_tmp // '/tmp';

  my ($out, $ret) = run_tee("/bin/bash -c '/usr/sbin/convertpkg-compat32 -i $pkg -d $c32tmpd'", "$log_name-convertpkg");

  if ($ret != 0) {
    return "convertpkg-compt32 returned non-zero exit status.",
      _ERR_CONVERTPKG;
  }
  unlink $pkg;
  return get_pkg_name($out);
}

=head2 do_slackbuild

  my ($ver, $pkg, $src, $exit) = do_slackbuild(LOCATION => $location);

C<do_slackbuild()> makes checks and sets up the C<perform_sbo()> call,
running C<do_convertpkg()> if needed.

A list of four values is returned if successful: version number, package name,
an array with source directories and an exit code. In case of failure, the first
value is an error message; the second and third values are empty.

=cut

sub do_slackbuild {
  my %args = (
    OPTS      => 0,
    LOCATION  => '',
    COMPAT32  => 0,
    @_
  );
  $args{LOCATION} or script_error('do_slackbuild requires LOCATION.');
  my $location = $args{LOCATION};
  my $sbo = get_sbo_from_loc($location);
  my $multilib = check_multilib();
  my $version = get_sbo_version($location);
  my $x32;
  # ensure x32 stuff is set correctly, or that we're setup for it
  if ($args{COMPAT32}) {
    unless ($multilib) {
      return "compat32 packages can only be built on multilib systems.", (undef) x 2,
        _ERR_NOMULTILIB;
    }
    unless (-f '/usr/sbin/convertpkg-compat32') {
      return "compat32 requires /usr/sbin/convertpkg-compat32.",
        (undef) x 2, _ERR_NOCONVERTPKG;
    }
  } else {
    if ($arch =~ /64$/) {
      $x32 = check_x32 $args{LOCATION};
      if ($x32 && ! $multilib) {
        my $warn =
          "$sbo is 32-bit, which requires multilib on 64-bit architecture.";
        return $warn, (undef) x 2, _ERR_NOMULTILIB;
      }
    }
  }
  # setup and run the .SlackBuild itself
  my ($pkg, $src, $exit) = perform_sbo(
    OPTS => $args{OPTS},
    LOCATION => $location,
    C32 => $args{COMPAT32},
    X32 => $x32,
  );
  return $pkg, (undef) x 2, $exit if $exit;
  if ($args{COMPAT32}) {
    ($pkg, $exit) = do_convertpkg($pkg);
    return $pkg, (undef) x 2, $exit if $exit;
  }
  return $version, $pkg, $src;
}

=head2 do_upgradepkg

  do_upgradepkg($pkg);

C<do_upgradepkg()> runs C<upgradepkg --reinstall --install-new> on C<$pkg>.

There is no useful return value.

=cut

sub do_upgradepkg {
  script_error('do_upgradepkg requires an argument.') unless @_ == 1;
  my $install_start = time();
  system('/sbin/upgradepkg', '--reinstall', '--install-new', shift);
  my $install_finish = time();
  my $install_time = $install_finish - $install_start;
  $install_time = reconcile_time($install_time);
  $total_install_time += $install_time if $install_time;
  return 1;
}

=head2 get_build_queue

  my @queue = @{ get_build_queue($sbo, my @checked) };

C<get_build_queue()> gets the prerequisites for C<$sbo>, updating the shared
C<$warnings> hash reference with any C<%README%> encountered. It returns the
prerequisites and C<$sbo> in the correct build order.

C<@checked> and C<our %concluded> are used to check for circular dependencies; the
script exits with C<_ERR_CIRCULAR> if any are present.
=cut

sub get_build_queue {
  script_error('get_build_queue requires an argument.') unless @_ == 1;
  return [ _build_queue(@_) ];
}

=head2 get_full_queue

  my @revdep_queue = ($installed, @sbos);

C<get_full_queue()> takes a list of installed SlackBuilds and an array
of SlackBuilds to check. It returns a list of the checked SlackBuilds and
their dependencies in reverse build order such that no SlackBuild appears
after any of its dependencies.

=cut

sub get_full_queue {
  my ($installed, @sbos) = @_;

  my $revdep_queue = [];
  for my $sbo (@sbos) {
    my $queue = get_build_queue([$sbo]);
    $revdep_queue = merge_queues($revdep_queue, $queue);
  }
  @$revdep_queue = reverse @$revdep_queue;

  return map {; +{
      name => $_,
      pkg => $installed->{$_},
      defined $warnings{$_} ? (warning => $warnings{$_}) : ()
    } }
    grep { exists $installed->{$_} }
    @$revdep_queue;
}

=head2 get_full_reverse

  my @get_full_reverse = get_full_reverse($sbo, %installed, %fulldeps, my @checked, my @list)

C<get_full_reverse()> takes a SlackBuild, a hash of installed packages, a hash
of reverse dependency relationships (from C<get_reverse_reqs>) and two arrays.
These arrays should not be included when called from outside of the subroutine.
C<get_full_reverse()> returns an array with installed reverse dependencies.

The final level of reverse dependencies is kept in the shared array C<@last_level_reverse>;
these are displayed only by C<sbofind(1) --top-reverse>.

If any circular reverse dependencies are found, the script exits with C<_ERR_CIRCULAR>.

=cut

sub get_full_reverse {
  script_error("full_reverse requires arguments.") unless @_;
  my ($sbo, $installed, $fulldeps, @checked, @list) = @_;
  my @sublist;
  for my $cand (keys %$installed) {
    push @sublist, $cand if $fulldeps->{$sbo}->{$cand};
  }
  push @list, @sublist if @sublist;
  push @checked, $sbo;

  if (@sublist) {
    for my $revdep (@sublist) {
      next if in $revdep, @reverse_concluded;
      # The first condition is prone to false positives if a script
      # and its dependency share a listed dependency; get_build_queue
      # makes certain in these cases.
      if (in $revdep, @checked and in $revdep, get_build_queue([$sbo])) {
        error_code("Circular dependency for $revdep detected. Exiting.", _ERR_CIRCULAR);
      }
      push @checked, $revdep;
      my @newlist = get_full_reverse($revdep, $installed, $fulldeps, @checked, @list);
      push @reverse_concluded, $revdep;
      push @list, @newlist if @newlist;
    }
    push @reverse_concluded, $sbo;
    my $full_reverse = rationalize_queue([ uniq @list ]);
    return @$full_reverse;
  } else {
    push @reverse_concluded, $sbo;
  }
  push @last_level_reverse, $sbo;
  return;
}

=head2 get_full_reverse_queue

  my (@reverse_queue) = get_full_reverse_queue($from, $updates, $sbo ...)
  my (@reverse_queue) = get_full_reverse_queue($from, $self_include, $sbo ...)

C<get_full_reverse_queue()> takes the name of the script it is called from and any number
of SlackBuilds. The second variable is the list of available upgrades (if called from
B<sboupgrade(1)>), any true value if called from B<sboinstall(1) --reinstall> and a
false value otherwise. The subroutine returns a queue for a reverse dependency rebuild.

=cut

sub get_full_reverse_queue {
  my $from = shift;
  my $updates = shift if $from eq 'sboupgrade';
  my $self_include = shift if $from eq 'sboinstall';
  script_error("get_full_reverse_queue requires arguments.") unless @_;
  my @all_installed = @{ get_installed_packages('ALL') };
  my @namelist;
  for my $item (@all_installed) { push @namelist, $item->{name}; }

  my @installed = @{ get_installed_packages('SBO') };
  my $installed = +{ map {; $_->{name}, $_->{pkg} } @installed };
  my $fulldeps = get_reverse_reqs($installed);

  my $return_queue;
  REVERSE: for my $sbo (@_) {
    # if called from sboinstall --reverse-rebuild without --reinstall,
    # need to skip dependees of other requested scripts
    if ($from eq "sboinstall" and not $self_include) {
      my $check_queue = get_build_queue([$sbo]);
      @$check_queue = grep { !/^$sbo$/ } @$check_queue;
      for my $sbo2 (@_) { next REVERSE if in $sbo2, @$check_queue; }
    }
    my $interim_queue;
    my @full_reverse = get_full_reverse($sbo, $installed, $fulldeps);
    if (@full_reverse) {
      for my $revdep (@full_reverse) {
        my $queue = get_build_queue([$revdep]);
        # for sboinstall, install items not in the reverse queue only
        # if missing; for sboupgrade, upgrade items not in the reverse
        # queue if upgradable.
        for my $cand (@$queue) {
          if ($from eq "sboinstall" and $self_include) {
            if (in $cand, @full_reverse or not in $cand, @namelist or in $cand, @ARGV) {
              push @$interim_queue, $cand;
            }
          } elsif ($from eq "sboinstall" and not $self_include) {
            if (in $cand, @full_reverse or not in $cand, @namelist) {
              push @$interim_queue, $cand unless $cand eq $sbo;
            }
          } else {
            if (in $cand, @full_reverse or not in $cand, @namelist or in $cand, @$updates) {
              push @$interim_queue, $cand unless $cand eq $sbo;
            }
          }
        }
      }
      @$interim_queue = grep { !/^$sbo$/ } @$interim_queue unless $self_include;
    }
    $return_queue = merge_queues($return_queue, $interim_queue) if $interim_queue;
  }
  return $return_queue if $return_queue;
  return 0;
}

=head2 get_pkg_name

  my $name = get_pkg_name($str);

C<get_pkg_name()> searches C<$str> for the last text matching the package
name output from C<makepkg>. The package name is returned.

=cut

sub get_pkg_name {
  my $str = shift;
  my @str = reverse split "\n", $str;
  for (@str) {
    my ($out) = $_ =~ /^Slackware\s+package\s+([^\s]+)\s+created\.$/;
    return $out if defined $out;
  }
  return undef;
}

=head2 get_src_dir

  my @dirs = @{ get_src_dir(@orig_dirs) };

C<get_src_dir()> returns a list of those directories under C</tmp/SBo> or C<$TMP>
that are not in C<@orig_dirs>. That is, the source directories for the script.

=cut

sub get_src_dir {
  my @ls = @_;
  my @src_dirs;
  # scripts use either $TMP or /tmp/SBo
  if (opendir(my $tsbo_dh, $tmpd)) {
    FIRST: while (my $ls = readdir $tsbo_dh) {
      next FIRST if in_regexp($ls => qw/ . .. /, qr/^package-/, @ls);
      next FIRST unless -d "$tmpd/$ls";

      push @src_dirs, $ls;
    }
    close $tsbo_dh;
  }
  return \@src_dirs;
}

=head2 get_tmp_extfn

  my ($ret, $exit) = get_tmp_extfn($fh);

C<get_tmp_extfn()> gets the C</dev/fd/X> filename for the file handle C<$fh> passed
in, setting flats to make it usable from other processes.

It returns the filename if successful, and C<undef> otherwise.

=cut

sub get_tmp_extfn {
  script_error('get_tmp_extfn requires an argument.') unless @_ == 1;
  my $fh = shift;
  unless (fcntl($fh, F_SETFD, 0)) { return undef; }
  return '/dev/fd/'. fileno $fh;
}

=head2 make_clean

  make_clean(SBO => $sbo, SRC => $src, VERSION => $ver);

C<make_clean()> removes source, package and compat32 directories left after running
a SlackBuild.

It has no useful return value.

=cut

sub make_clean {
  my %args = (
    SBO      => '',
    SRC      => '',
    VERSION  => '',
    @_
  );
  unless ($args{SBO} && $args{SRC} && $args{VERSION}) {
    script_error('make_clean requires three arguments.');
  }
  my $src = $args{SRC};
  wrapsay "Cleaning for $args{SBO}-$args{VERSION}...";
  for my $dir (@$src) {
    remove_tree("$tmpd/$dir") if -d "$tmpd/$dir";
  }

  unless ($args{SBO} =~ /^(.+)-compat32$/) {
    remove_tree("$tmpd/package-$args{SBO}") if
      -d "$tmpd/package-$args{SBO}";
  } else {
    my $pkg_name = $1;
    remove_tree("/tmp/package-$args{SBO}") if
      not defined $env_tmp and
      -d "/tmp/package-$args{SBO}";
    remove_tree("$tmpd/package-$pkg_name") if
      -d "$tmpd/package-$pkg_name";
  }
  return 1;
}

=head2 make_distclean

  make_distclean(SRC => $src, VERSION => $ver, LOCATION => $loc);

C<make_distclean()> removes any downloaded source tarballs and the completed package
archive. These files are not removed if they are needed by a script later in the
queue; this is mostly relevant for compat32 and some Rust-based scripts.

It has no useful return value.

=cut

sub make_distclean {
  my %args = (
    SRC       => '',
    VERSION   => '',
    LOCATION  => '',
    @_
  );
  unless ($args{SRC} && $args{VERSION} && $args{LOCATION}) {
    script_error('make_distclean requires four arguments.');
  }
  my $sbo = get_sbo_from_loc($args{LOCATION});
  wrapsay "Distcleaning for $sbo-$args{VERSION}...";
  # remove any distfiles for this particular SBo unless they
  # will be needed later in the queue
  my $downloads = shift @upcoming;
  for my $key (keys %$downloads) {
    my $md5 = $downloads->{$key};
    # get_filename_from_link does not use the manual download
    # directory
    my $filename = get_filename_from_link($key, $md5);
    my $is_upcoming;
    for my $dl2 (@upcoming) {
      for my $key2 (keys %$dl2) {
        my $md52 = $dl2->{$key2};
        my $filename2 = get_filename_from_link($key2, $md52);
        if ($filename eq $filename2) {
          $is_upcoming = 1;
          next;
        }
      }
    }
    if (-f $filename and not $is_upcoming) {
      unlink $filename;
      # be careful with the directory; does not apply to files
      # in the manual download directory
      if (dirname(dirname($filename)) eq $distfiles_dir) {
        remove_tree dirname($filename) if -d dirname($filename);
      } else {
        warn_color $color_lesser, "Distcleaning for $sbo-$args{VERSION} failed...";
      }
    }
  }
  return 1;
}

=head2 merge_queues

  my @merged = @{ merge_queues([@queue1], [@queue2]) };

C<merge_queues()> takes two array references and merges them such that C<@queue1>
is in front, followed by any non-redundant items in C<@queue2>. This is returned
as an array reference.

=cut

sub merge_queues {
  script_error('merge_queues requires two arguments.') unless @_ == 2;

  return [ uniq @{$_[0]}, @{$_[1]} ];
}

=head2 perform_sbo

  my ($pkg, $src, $exit) = perform_sbo(LOCATION => $location);

C<perform_sbo()> prepares and runs a SlackBuild. It returns the package name,
an array with source directories and an exit code if successful. If unsuccessful,
the first value is instead an error message.

Network access is blocked with C<unshare(1)> if the C<NONET> setting is C<TRUE>.

=cut

sub perform_sbo {
  my %args = (
    OPTS      => 0,
    LOCATION  => '',
    C32       => 0,
    X32       => 0,
    @_
  );
  unless ($args{LOCATION}) {
    script_error('perform_sbo requires LOCATION.');
  }

  my $location = $args{LOCATION};
  my $sbo = get_sbo_from_loc($location);

  # we need to get a listing of /tmp/SBo, or $TMP, if we can, before we run
  # the SlackBuild so that we can compare to a listing taken afterward.
  my @src_ls;
  if (opendir(my $tsbo_dh, $tmpd)) {
    @src_ls = grep { ! in_regexp( $_ => qw/ . .. /) } readdir $tsbo_dh;
  }

  my $cmd;

  $cmd = '';

  if ($config{ETC_PROFILE} eq 'TRUE') {
    if (opendir(my $prof_dh, "/etc/profile.d")) {
      my @profile_d = grep { ! in_regexp( $_ => qw/ . .. /) } readdir $prof_dh;
      if (@profile_d) {
        for my $profile_script (@profile_d) {
          $cmd .= " . /etc/profile.d/$profile_script &&" if -x "/etc/profile.d/$profile_script" and $profile_script =~ m/\.sh$/;
        }
      }
    }
  }
  my $use_setarch;
  if ($arch eq "x86_64" and ($args{C32} || $args{X32})) {
    $use_setarch = 1;
    if ($args{X32}) {
      my ($fh, $exit) = open_read("$location/$sbo.SlackBuild");
      error_code("Unable to open $location/$sbo.SlackBuild. Exiting.", _ERR_OPENFH) if $exit;
      for my $line (<$fh>) {
        next if $line =~ m/^(|\s)#/;
        next unless $line =~ m/LIBDIRSUFFIX=/;
        if ($line =~ m/\S64/) {
          undef $use_setarch;
          last;
        }
      }
      close $fh;
    }
    $cmd .= ' . /etc/profile.d/32dev.sh &&';
  }
  if ($args{OPTS}) {
    save_options($sbo, $args{OPTS});
    $cmd .= " $args{OPTS}";
  }
  $cmd .= " MAKEFLAGS=\"\$MAKEFLAGS -j$config{JOBS}\"" if $config{JOBS} ne "FALSE";

  # set TMP/OUTPUT if set in the environment
  $cmd .= " TMP=$env_tmp" if $env_tmp;
  $cmd .= " OUTPUT=$ENV{OUTPUT}" if defined $ENV{OUTPUT};
  $cmd .= " unshare -n" if $config{NONET} eq "TRUE";
  # special cases: 32-bit compatible build or 32-bit userland and 64-bit kernel
  $cmd .= " setarch i686" if defined $userland_32 or defined $use_setarch;
  my $staging = "$stage_dir/" . basename $location;
  $cmd .= " /bin/bash $staging/$sbo.SlackBuild";

  # run the slackbuild, grab its exit status
  my $cwd = getcwd();
  chdir $staging;
  my $build_time = time();
  my $log_name = $sbo;
  $log_name .= "-compat32" if $args{C32};
  my ($out, $ret) = run_tee($cmd, $log_name);
  my $completed_time = time();
  my $time_taken = $completed_time - $build_time;
  $time_taken = reconcile_time($time_taken);
  $total_build_time += $time_taken if $time_taken;
  chdir $cwd;

  # return error now if the slackbuild didn't exit 0
  return "$sbo.SlackBuild returned non-zero.", undef, _ERR_BUILD if $ret != 0;
  my $pkg = get_pkg_name($out);
  return "$sbo.SlackBuild did not create a package.", undef, _ERR_BUILD unless defined $pkg;
  my $src = get_src_dir(@src_ls);
  return $pkg, $src;
}

=head2 process_sbos

  my (@failures, $exit) = process_sbos(TODO => [@queue]);

C<process_sbos()> processes a C<@queue> of SlackBuilds and returns an array reference
with failed builds and the exit status. If there is an argument C<GET_ONLY>, the array
reference contains failed downloads instead of builds.

In case of a mass rebuild, C<process_sbos()> updates the resume file C<resume.temp>
when a build fails. If the C<NICENESS> or C<IDLE_BUILD> settings are not C<FALSE>,
they are also handled here with C<renice(1)> and C<ionice(1)>, respectively.

=cut

sub process_sbos {
  my %args = (
    TODO       => '',
    CMDS       => '',
    OPTS       => '',
    LOCATIONS  => '',
    NOINSTALL  => 0,
    NON_INT    => 0,
    MASS       => 0,
    GET_ONLY   => 0,
    @_
  );
  my $todo = $args{TODO};
  my $cmds = $args{CMDS};
  my $opts = $args{OPTS};
  my $locs = $args{LOCATIONS};
  my $mass = $args{MASS};
  my $get_only = $args{GET_ONLY};
  my $success_label = $get_only ? "Verified sources:" : "Built:";
  @$todo >= 1 or script_error('process_sbos requires TODO.');
  my $mtemp_in = "$config{SBO_HOME}/mass_rebuild.temp";
  my $mtemp_resume = "$config{SBO_HOME}/resume.temp";
  my (@failures, @failure_names, @skipped, @successes, $err);
  FIRST: for my $sbo (@$todo) {
    my $compat32 = $sbo =~ /-compat32$/ ? 1 : 0;
    push @upcoming, get_sbo_downloads(
      LOCATION => $$locs{$sbo}, COMPAT32 => $compat32
    );
    my ($temp_distfiles, $exit) = check_distfiles(
      LOCATION => $$locs{$sbo}, COMPAT32 => $compat32
    );
    if ($exit or not $temp_distfiles) {
      push @distfiles, "NO_DISTFILES";
    } else {
      push @distfiles, $temp_distfiles;
    }
    # if $exit is defined, prompt to proceed or return with last $exit
    if ($exit) {
      $err = $exit;
      my $fail = $temp_distfiles;
      push @failures, {$sbo => $fail};
      push @failure_names, $sbo;
      # return now if we're not interactive
      if ($args{NON_INT}) {
        if (@successes and $config{CLASSIC} ne "TRUE") { wrapsay_color $color_notice, "\n$success_label"; wrapsay join(" ", @successes); }
        display_times() unless $config{CLASSIC} eq "TRUE";
        return \@failures, $exit;
      }
      wrapsay_color $color_warn, "Unable to download/verify source file(s) for $sbo:";
      say "  $fail";
      if (prompt($color_lesser, 'Do you want to proceed?' , default => 'no')) {
        next FIRST;
      } else {
        if (@successes and $config{CLASSIC} ne "TRUE") { wrapsay_color $color_notice, "\n$success_label"; wrapsay join(" ", @successes); }
        display_times() unless $config{CLASSIC} eq "TRUE";
        return \@failures, $exit;
      }
    } elsif ($get_only) {
      push @successes, $sbo;
    }
  }
  if ($get_only) {
    if (@successes and $config{CLASSIC} ne "TRUE") { wrapsay_color $color_notice, "\nVerified sources:"; wrapsay join(" ", @successes); }
    display_times() unless $config{CLASSIC} eq "TRUE";
    return \@failures, $err;
  }
  my $count = 0;
  chomp(my $existing_nice = `/bin/nice`);
  `/usr/bin/renice $config{NICENESS} $$` if $config{NICENESS} ne "FALSE";
  my @existing_ionice = read_ionice();
  `/usr/bin/ionice -c 3 -p $$` if $config{IDLE_BUILD} ne "FALSE";
  FIRST: for my $sbo (@$todo) {
    $count++;
    if (@failure_names) {
      for (@{$concluded{$sbo}}) {
        if (in $_, @failure_names) {
          push @skipped, $sbo;
          wrapsay_color $color_lesser, "Skipping $sbo because $_ failed.";
          shift @distfiles;
          next FIRST;
        }
      }
    }
    my $options = $$opts{$sbo} // 0;
    my $cmds = $$cmds{$sbo} // [];
    for my $cmd (@$cmds) {
      system($cmd) == 0 or warn_color $color_warn, "\"$cmd\" exited non-zero.";
    }
    # switch compat32 on if upgrading/installing a -compat32
    # else make sure compat32 is off
    my $compat32 = $sbo =~ /-compat32$/ ? 1 : 0;
    my $staging = stage($$locs{$sbo}, $distfiles[0]);
    my ($version, $pkg, $src, $exit) = do_slackbuild(
      OPTS      => $options,
      LOCATION  => $staging,
      COMPAT32  => $compat32,
    );
    unstage;
    shift @distfiles;
    if ($exit) {
      my $fail = $version;
      push @failures, {$sbo => $fail};
      push @failure_names, $sbo;
      write_resume($todo, $opts, $cmds, $mtemp_resume, @successes, @failure_names) if $mass;
      if ($config{INSTANT_STOP} eq "TRUE" and $count < @$todo and not $args{NON_INT}) {
        wrapsay_color $color_warn, "A failure occurred while building $sbo:";
        say "  $fail";
        if (prompt $color_lesser, "$sbo failed to build. Continue with the rest of the queue?", default => "no") {
          next FIRST;
        } else {
          if (@successes and $config{CLASSIC} ne "TRUE") { wrapsay_color $color_notice, "\nBuilt:"; wrapsay join(" ", @successes); }
          if (@skipped) { wrapsay_color $color_lesser, "\nSkipped:"; wrapsay join(" ", @skipped); }
          display_times() unless $config{CLASSIC} eq "TRUE";
          chomp(my $test_nice = `/bin/nice`);
          `/usr/bin/renice $existing_nice $$` if $config{NICENESS} ne "FALSE" and $test_nice == $config{NICENESS};
          my @test_ionice = read_ionice();
          set_ionice(@existing_ionice) if $config{IDLE_BUILD} ne "FALSE" and $test_ionice[0] == 3;
          return \@failures, $exit;
        }
      } elsif ($count == @$todo or ($config{INSTANT_STOP} eq "TRUE" and $args{NON_INT})) {
          if (@successes and $config{CLASSIC} ne "TRUE") { wrapsay_color $color_notice, "\nBuilt:"; wrapsay join(" ", @successes); }
          if (@skipped) { wrapsay_color $color_lesser, "\nSkipped:"; wrapsay join(" ", @skipped); }
          display_times() unless $config{CLASSIC} eq "TRUE";
          chomp(my $test_nice = `/bin/nice`);
          `/usr/bin/renice $existing_nice $$` if $config{NICENESS} ne "FALSE" and $test_nice == $config{NICENESS};
          my @test_ionice = read_ionice();
          set_ionice(@existing_ionice) if $config{IDLE_BUILD} ne "FALSE" and $test_ionice[0] == 3;
          return \@failures, $exit;
      }
      next FIRST;
    } else {
      push @successes, $sbo;
    }
    do_upgradepkg($pkg) unless $args{NOINSTALL};

    unless ($config{NOCLEAN} eq "TRUE") {
      make_clean(SBO => $sbo, SRC => $src, VERSION => $version);
    }
    if ($config{DISTCLEAN} eq "TRUE") {
      make_distclean(
        SBO       => $sbo,
        SRC       => $src,
        VERSION   => $version,
        LOCATION  => $$locs{$sbo},
      );
    }
    # move package to $config{PKG_DIR} if defined
    unless ($config{PKG_DIR} eq 'FALSE') {
      my $dir = $config{PKG_DIR};
      unless (-d $dir) {
        mkdir($dir) or warn_color $color_warn, "Unable to create $dir.";
      }
      if (-d $dir) {
        move($pkg, $dir), wrapsay "$pkg stored in $dir.";
      } else {
        warn_color $color_lesser, "$pkg left in $tmpd.";
      }
    } elsif ($config{DISTCLEAN} eq "TRUE") {
      unlink $pkg;
    }
  }
  write_resume($todo, $opts, $cmds, $mtemp_resume, @successes, @failure_names) if $mass;
  unlink $mtemp_resume if $mass and -f $mtemp_resume and not @failures;
  if (@successes and $config{CLASSIC} ne "TRUE") { wrapsay_color $color_notice, "\nBuilt:"; wrapsay join(" ", @successes); }
  if (@skipped) { wrapsay_color $color_lesser, "\nSkipped:"; wrapsay join(" ", @skipped); }
  display_times() unless $config{CLASSIC} eq "TRUE";
  chomp(my $test_nice = `/bin/nice`);
  `/usr/bin/renice $existing_nice $$` if $config{NICENESS} ne "FALSE" and $test_nice == $config{NICENESS};
  my @test_ionice = read_ionice();
  set_ionice(@existing_ionice) if $config{IDLE_BUILD} ne "FALSE" and $test_ionice[0] == 3;
  return \@failures, $err;
}

=head2 rationalize_queue

  my $queue = rationalize_queue($queue)

C<rationalize_queue()> takes a build queue and rearranges it such that
no script appears before any of its dependencies. The order is predictable
given the scripts included and favors keeping dependency chains together,
especially beyond the first level; this makes output and build orders more
intuitive.

Currently, this is only useful when the queue has been constructed with
reference to reverse dependencies, or, in the case of C<sbotest(1)>, a full
repository test or archive rebuild is needed.

C<sbotest(1)> has a separate subroutine that reduces the number of expected
package installations and removals during test runs. Intuitiveness is not
to be expected in C<sbotest(1)> queues.

The rearranged queue is returned.

=cut

sub rationalize_queue {
  script_error('rationalize_queue requires an argument.') unless @_ == 1;
  my $preliminary_queue = shift;
  my @preliminary_queue = sort @{ $preliminary_queue };
  my (@queue, %queued, %pushed, %any_reqs, %reqs, @result_queue);

  for my $sbo (@preliminary_queue) {
    my $requirements = get_requires($sbo);
    unless (defined $requirements) {
      push @result_queue, $sbo;
      next;
    }
    my @reqs = @{ $requirements };
    my $sbo_queue = get_build_queue([$sbo]);
    pop @$sbo_queue;
    unless (@$sbo_queue) {
      push @result_queue, $sbo;
      next;
    }
    $reqs{$sbo}->{$_} = 1 for (@$sbo_queue);
    $any_reqs{$sbo} = \@$sbo_queue;
    push @queue, $sbo;
  }
  $queued{$_} = 1 for (@queue);
  return [ @result_queue ] unless @queue;

  for my $no_reqs (@result_queue) {
    my @new_queue;
    while (my $sbo = shift @queue) {
      if (exists $reqs{$sbo}->{$no_reqs}) {
        unshift @new_queue, $sbo;
      } else {
        push @new_queue, $sbo;
      }
    }
    @queue = @new_queue;
  }

  FIRST: while (my $sbo = shift @queue) {
    if (exists $any_reqs{$sbo}) {
      for my $check (@{$any_reqs{$sbo}}) {
        if (not exists $pushed{$check} and exists $queued{$check}) {
          push @queue, $sbo;
          next FIRST;
        }
      }
    }
    push @result_queue, $sbo;
    $pushed{$sbo} = 1;
    if (@queue) {
      my @new_queue;
      while (my $cand = shift @queue) {
        if (exists $reqs{$cand}->{$sbo}) {
          unshift @new_queue, $cand;
        } else {
          push @new_queue, $cand;
        }
      }
      @queue = @new_queue;
    }
  }

  return [ @result_queue ];
}

=head2 run_tee

  my ($output, $exit) = run_tee($cmd, $log_name);

C<run_tee()> runs C<$cmd> under C<tee(1)> to display STDOUT and return it as
a string. The second return value is the exit status. If C<LOG_DIR> is set,
STDOUT and STDERR are saved to a timestamped log file named $log_name. Otherwise,
STDOUT only is saved to the temporary directory.

If the bash interpreter cannot be run, the first return value is C<undef> and
the exit status holds a non-zero value.

=cut

sub run_tee {
  return undef unless $< == 0;
  my $cmd = shift;
  $cmd =~ s/(^\s|\s$)//;
  my $log_name = shift;

  my $out_fh = tempfile(DIR => $tempdir);
  my $out_fn = get_tmp_extfn($out_fh);
  return undef, _ERR_F_SETFD unless defined $out_fn;

  my $exit_fh = tempfile(DIR => $tempdir);
  my $exit_fn = get_tmp_extfn($exit_fh);
  return undef, _ERR_F_SETFD unless defined $exit_fn;

  if ($config{LOG_DIR} eq 'FALSE') {
    $cmd = sprintf '( %s ; echo $? > %s ) | tee %s', $cmd, $exit_fn, $out_fn;
  } else {
    $cmd = sprintf '( %s 2>&1 ; echo $? > %s ) | tee %s', $cmd, $exit_fn, $out_fn;
  }

  my $ret = system('/bin/bash', '-c', $cmd);

  return undef, $ret if $ret;

  seek $exit_fh, 0, 0;
  chomp($ret = readline $exit_fh);

  seek $out_fh, 0, 0;
  my $out = do { local $/; readline $out_fh; };

  unless ($config{LOG_DIR} eq 'FALSE') {
    make_path $config{LOG_DIR} unless -d $config{LOG_DIR};
    chomp(my $save_date = `/usr/bin/date +%Y-%m-%d-%H:%M`);
    $log_name .= "_$save_date";
    $log_name = "$config{LOG_DIR}/$log_name";
    copy $out_fn, $log_name;
    if (-f $log_name) {
      wrapsay "Saved a log to $log_name.";
    } else {
      wrapsay "Not saving a log file.";
    }
  }

  print RESET;
  return $out, $ret;
}

=head2

  write_resume($todo, $opts, $cmds, $mtemp_resume, @builds);

C<write_resume()> takes C<$todo>, C<$opts>, C<$cmds> and C<$mtemp_resume> from
C<perform_sbos()> and a list of builds to ignore. This should generally include failed
and succeeded builds. It writes all non-ignored builds into a new resume file using
C<JSON::PP(3)>. There is no useful return value.

=cut

sub write_resume {
  my ($todo, $opts, $cmds, $mtemp_resume, @not_to_use) = @_;
  my $undone_queue;
  for (@$todo) {
    push @$undone_queue, $_ unless in $_, @not_to_use;
  }
  unlink $mtemp_resume if -f $mtemp_resume;
  my ($fh, $exit) = open_fh($mtemp_resume, '>');
  error_code("Failed to open $mtemp_resume; exiting.", $exit) if $exit;
  my $json = JSON::PP->new->latin1->pretty->canonical;
  my $build_settings = {
    build_queue => $undone_queue,
    commands    => $cmds,
    options     => $opts,
  };
  print {$fh} $json->encode( $build_settings );
  close $fh;
  return;
}

=head1 EXIT CODES

Build.pm subroutines can return the following exit codes:

  _ERR_SCRIPT        2   script or module bug
  _ERR_BUILD         3   errors when executing a SlackBuild
  _ERR_OPENFH        6   failure to open file handles
  _ERR_NOMULTILIB    9   lacking multilib capabilities when needed
  _ERR_CONVERTPKG    10  convertpkg-compat32 failure
  _ERR_NOCONVERTPKG  11  lacking convertpkg-compat32 when needed
  _ERR_INST_SIGNAL   12  the script was interrupted while building
  _ERR_CIRCULAR      13  attempted to calculate a circular dependency
  _ERR_STDIN         16  reading keyboard input failed

=head1 SEE ALSO

SBO::Lib(3), SBO::Lib::Download(3), SBO::Lib::Info(3), SBO::Lib::Pkgs(3), SBO::Lib::Readme(3), SBO::Lib::Repo(3), SBO::Lib::Solibs(3), SBO::Lib::Tree(3), SBO::Lib::Util(3), ionice(1), JSON::PP(3), renice(1), unshare(1)

=head1 AUTHORS

SBO::Lib was originally written by Jacob Pipkin <jacob.pipkin@icloud.com> with
contributions from Luke Williams <xocel@iquidus.org> and Andreas
Guldstrand <andreas.guldstrand@gmail.com>.

=head1 MAINTAINER

SBO::Lib is maintained by K. Eugene Carlson <kvngncrlsn@gmail.com>.

=head1 LICENSE

The sbotools are licensed under the MIT License.

Copyright (C) 2012-2017, Jacob Pipkin, Luke Williams, Andreas Guldstrand.

Copyright (C) 2024-2026, K. Eugene Carlson.

Copyright (C) 2026, K. Eugene Carlson, Jacob Pipkin.

=cut

sub _build_terminated {
  if ($< == 0) {
    remove_tree("$tempdir") if -d "$tempdir";
    unstage;
    exit _ERR_INST_SIGNAL;
  }
}

sub _time_stop {
  $stop_time = time();
  kill STOP => $$;
}

sub _time_restart {
  $resume_time = time();
  my $interval = $resume_time - $stop_time if $stop_time;
  $paused_time += $interval if $interval;
  $resume_time = 0;
  $stop_time = 0;
}

sub _build_queue {
  my ($sbos, @checked) = @_;
  my @queue;
  for my $cand (@$sbos) { push @queue, $cand unless on_blacklist($cand); }
  my @result;

  while (my $sbo = shift @queue) {
    next if $sbo eq "%README%";
    if (exists $concluded{$sbo} or exists $warnings{$sbo}) {
      push @result, @{$concluded{$sbo}} unless exists $warnings{$sbo} and $warnings{$sbo} eq "nonexistent";
      push @result, $sbo;
      next;
    }
    if (in $sbo, @checked) {
      error_code("Circular dependencies for $sbo detected. Exiting.", _ERR_CIRCULAR);
    }
    push @checked, $sbo;
    my $reqs = get_requires($sbo);
    if (defined $reqs) {
      my @sbo_result = _build_queue($reqs, @checked);
      push @result, @sbo_result;
      $concluded{$sbo} = \@sbo_result;
      foreach my $req (@$reqs) {
        $warnings{$sbo}="%README%" if $req eq "%README%";
      }
    } else {
      $warnings{$sbo} = "nonexistent";
    }
    push @result, $sbo;
  }

  return uniq @result;
}

1;
