Set To Do branch

1 files changed, 0 insertions, 566 deletions

diff --git a/SBO-Lib/lib/SBO/Lib/Util.pm b/SBO-Lib/lib/SBO/Lib/Util.pm
deleted file mode 100644
index 1598cf1..0000000
--- a/SBO-Lib/lib/SBO/Lib/Util.pm
+++ /dev/null
@@ -1,566 +0,0 @@
-package SBO::Lib::Util;
-
-use 5.016;
-use strict;
-use warnings;
-
-our $VERSION = '2.8.0';
-
-use Exporter 'import';
-use Sort::Versions;
-
-my $consts;
-use constant $consts = {
-  _ERR_USAGE         => 1,   # usage errors
-  _ERR_SCRIPT        => 2,   # errors with the scripts themselves
-  _ERR_BUILD         => 3,   # errors during the slackbuild process
-  _ERR_MD5SUM        => 4,   # md5sum verification
-  _ERR_DOWNLOAD      => 5,   # errors with downloading things
-  _ERR_OPENFH        => 6,   # opening file handles
-  _ERR_NOINFO        => 7,   # missing information
-  _ERR_F_SETFD       => 8,   # unsetting exec-on-close bit
-  _ERR_NOMULTILIB    => 9,   # lacking multilib where required
-  _ERR_CONVERTPKG    => 10,  # errors while running convertpkg-compat32
-  _ERR_NOCONVERTPKG  => 11,  # lacking convertpkg-compat32 where required
-};
-
-my @EXPORT_CONSTS = keys %$consts;
-my @EXPORT_CONFIG = qw{
-  read_config
-
-  $conf_dir
-  $conf_file
-  %config
-};
-
-our @EXPORT_OK = (
-  qw{
-    check_multilib
-    get_arch
-    get_kernel_version
-    get_sbo_from_loc
-    get_slack_version
-    get_slack_version_key
-    get_slack_version_url
-    idx
-    in
-    indent
-    open_fh
-    open_read
-    print_failures
-    prompt
-    script_error
-    show_version
-    slurp
-    uniq
-    usage_error
-    version_cmp
-  },
-  @EXPORT_CONSTS,
-  @EXPORT_CONFIG,
-);
-
-our %EXPORT_TAGS = (
-  all => \@EXPORT_OK,
-  const => \@EXPORT_CONSTS,
-  config => \@EXPORT_CONFIG,
-);
-
-=pod
-
-=encoding UTF-8
-
-=head1 NAME
-
-SBO::Lib::Util - Utility functions for SBO::Lib and the sbotools
-
-=head1 SYNOPSIS
-
-  use SBO::Lib::Util qw/uniq/;
-
-  # ('duplicate');
-  my @uniq = uniq('duplicate', 'duplicate');
-
-=head1 VARIABLES
-
-=head2 $conf_dir
-
-By default, C<$conf_dir> will be C</etc/sbotools>.
-
-=head2 $conf_file
-
-By default, C<$conf_file> will be C</etc/sbotools/sbotools.conf>.
-
-=head2 %config
-
-By default, all values are set to C<"FALSE">, but when C<read_config()> is run,
-the values will change according to the configuration, and C<SBO_HOME> will by
-default get changed to C</usr/sbo>.
-
-The supported keys are: C<NOCLEAN>, C<DISTCLEAN>, C<JOBS>, C<PKG_DIR>,
-C<SBO_HOME>, C<LOCAL_OVERRIDES>, C<SLACKWARE_VERSION>, C<REPO>, C<GPG_KEY>.
-
-=cut
-
-# global config variables
-our $conf_dir = '/etc/sbotools';
-our $conf_file = "$conf_dir/sbotools.conf";
-our %config = (
-  NOCLEAN => 'FALSE',
-  DISTCLEAN => 'FALSE',
-  JOBS => 'FALSE',
-  PKG_DIR => 'FALSE',
-  SBO_HOME => 'FALSE',
-  LOCAL_OVERRIDES => 'FALSE',
-  SLACKWARE_VERSION => 'FALSE',
-  REPO => 'FALSE',
-  GPG_KEY => 'D3076BC3E783EE747F09B8B70368EF579C7BA3B6',
-);
-
-read_config();
-
-=head1 SUBROUTINES
-
-=cut
-
-=head2 check_multilib
-
-  my $ml = check_multilib();
-
-C<check_multilib()> checks if the file C</etc/profile.d/32dev.sh> exists,
-because without it, there's no way to build 32bit things on an x64 arch.
-
-Returns a true value if it exists, and a false value otherwise.
-
-=cut
-
-# can't do 32-bit on x86_64 without this file, so we'll use it as the test to
-# to determine whether or not an x86_64 system is setup for multilib
-sub check_multilib {
-  return 1 if -f '/etc/profile.d/32dev.sh';
-  return();
-}
-
-=head2 get_arch
-
-  my $arch = get_arch();
-
-C<get_arch()> returns the current machine architechture as reported by C<uname
--m>.
-
-=cut
-
-sub get_arch {
-  chomp(my $arch = `uname -m`);
-  return $arch;
-}
-
-=head2 get_kernel_version
-
-  my $kv = get_kernel_version();
-
-C<get_kernel_version()> will check what the version of the currently running
-kernel is and return it in a format suitable for appending to a slackware
-package version.
-
-=cut
-
-sub get_kernel_version {
-  state $kv;
-  return $kv if defined $kv;
-
-  chomp($kv = `uname -r`);
-  $kv =~ s/-/_/g;
-  return $kv;
-}
-
-=head2 get_sbo_from_loc
-
-  my $sbo = get_sbo_from_loc($location);
-
-C<get_sbo_from_loc()> gets the package name from the C<$location> passed in
-and returns it.
-
-=cut
-
-# pull the sbo name from a $location: $repo_path/system/wine, etc.
-sub get_sbo_from_loc {
-  script_error('get_sbo_from_loc requires an argument.') unless @_ == 1;
-  return (shift =~ qr#/([^/]+)$#)[0];
-}
-
-=head2 get_slack_version
-
-  my $version = get_slack_version();
-
-C<get_slack_version()> checks which version of the SBo repository to use and if
-successful, returns it.
-
-If there is an error in getting the slackware version, or if it's not a
-supported version, an error message will be shown on STDERR, and the program
-will exit.
-
-=cut
-
-# %supported maps what's in /etc/slackware-version to an rsync or https URL
-my %supported = (
-  '14.0' => 'rsync://slackbuilds.org/slackbuilds/14.0/',
-  '14.1' => 'rsync://slackbuilds.org/slackbuilds/14.1/',
-  '14.2' => 'rsync://slackbuilds.org/slackbuilds/14.2/',
-  '15.0' => 'rsync://slackbuilds.org/slackbuilds/15.0/',
-  '15.0+' => 'https://github.com/Ponce/slackbuilds.git',
-  current => 'https://github.com/Ponce/slackbuilds.git',
-);
-
-sub get_slack_version {
-  return $config{SLACKWARE_VERSION} unless $config{SLACKWARE_VERSION} eq 'FALSE';
-  my ($fh, $exit) = open_read('/etc/slackware-version');
-  if ($exit) {
-    warn $fh;
-    exit $exit;
-  }
-  chomp(my $line = <$fh>);
-  close $fh;
-  my $version = ($line =~ /\s+(\d+[^\s]+)$/)[0];
-  usage_error("Unsupported Slackware version: $version\n" .
-    "Suggest you set the sbotools REPO setting to $supported{current}\n")
-    unless $supported{$version};
-  return $version;
-}
-
-=head2 get_slack_version_url
-
-  my $url = get_slack_version_url();
-
-C<get_slack_version_url()> returns the default URL for the given slackware
-version.
-
-If there is an error in getting the URL, or if it's not a supported version,
-an error message will be shown on STDERR, and the program will exit.
-
-=cut
-
-sub get_slack_version_url {
-  return $supported{get_slack_version()};
-}
-
-=head2 idx
-
-  my $idx = idx($needle, @haystack);
-
-C<idx()> looks for C<$needle> in C<@haystack>, and returns the index of where
-it was found, or C<undef> if it wasn't found.
-
-=cut
-
-sub idx {
-  for my $idx (1 .. $#_) {
-    $_[0] eq $_[$idx] and return $idx - 1;
-  }
-  return undef;
-}
-
-=head2 in
-
-  my $found = in($needle, @haystack);
-
-C<in()> looks for C<$needle> in C<@haystack>, and returns a true value if it
-was found, and a false value otherwise.
-
-=cut
-
-# Checks if the first argument equals any of the subsequent ones
-sub in {
-  my ($first, @rest) = @_;
-  foreach my $arg (@rest) {
-    return 1 if ref $arg eq 'Regexp' and $first =~ $arg;
-    return 1 if $first eq $arg;
-  }
-  return 0;
-}
-
-=head2 indent
-
-  my $str = indent($indent, $text);
-
-C<indent()> indents every non-empty line in C<$text> C<$indent> spaces and
-returns the resulting string.
-
-=cut
-
-sub indent {
-  my ($indent, $text) = @_;
-  return $text unless $indent;
-
-  my @lines = split /\n/, $text;
-  foreach my $line (@lines) {
-    next unless length($line);
-    $line = (" " x $indent) . $line;
-  }
-  return join "\n", @lines;
-}
-
-=head2 open_fh
-
-  my ($ret, $exit) = open_fh($fn, $op);
-
-C<open_fh()> will open C<$fn> for reading and/or writing depending on what
-C<$op> is.
-
-It returns a list of two values. The second value is the exit status, and if it
-is true, the first value will be an error message. Otherwise it will be the
-opened filehandle.
-
-=cut
-
-# sub for opening files, second arg is like '<','>', etc
-sub open_fh {
-  script_error('open_fh requires two arguments') unless @_ == 2;
-  unless ($_[1] eq '>') {
-      -f $_[0] or script_error("open_fh, $_[0] is not a file");
-  }
-  my ($file, $op) = @_;
-  my $fh;
-  _race::cond('$file could be deleted between -f test and open');
-  unless (open $fh, $op, $file) {
-    my $warn = "Unable to open $file.\n";
-    my $exit = _ERR_OPENFH;
-    return ($warn, $exit);
-  }
-  return $fh;
-}
-
-=head2 open_read
-
-  my ($ret, $exit) = open_read($fn);
-
-C<open_read()> will open C<$fn> for reading.
-
-It returns a list of two values. The second value is the exit status, and if it
-is true, the first value will be an error message. Otherwise it will be the
-opened filehandle.
-
-=cut
-
-sub open_read {
-  return open_fh(shift, '<');
-}
-
-=head2 print_failures
-
-  print_failures($failures);
-
-C<print_failures()> prints all the failures in the C<$failures> array reference
-to STDERR if any.
-
-There is no useful return value.
-
-=cut
-
-# subroutine to print out failures
-sub print_failures {
-  my $failures = shift;
-  if (@$failures > 0) {
-    warn "Failures:\n";
-    for my $failure (@$failures) {
-      warn "  $_: $$failure{$_}" for keys %$failure;
-    }
-  }
-}
-
-=head2 prompt
-
-  exit unless prompt "Should we continue?", default => "yes";
-
-C<prompt()> prompts the user for an answer, optionally specifying a default of
-C<yes> or C<no>. If the default has been specified it returns a true value in
-case 'yes' was selected, and a false value if 'no' was selected. Otherwise it
-returns whatever the user answered.
-
-=cut
-
-sub prompt {
-  my ($q, %opts) = @_;
-  my $def = $opts{default};
-  $q = sprintf '%s [%s] ', $q, $def eq 'yes' ? 'y' : 'n' if defined $def;
-
-  print $q;
-
-  my $res = readline STDIN;
-
-  if (defined $def) {
-    return 1 if $res =~ /^y/i;
-    return 0 if $res =~ /^n/i;
-    return $def eq 'yes' if $res =~ /^\n/;
-
-    # if none of the above matched, we ask again
-    goto &prompt;
-  }
-  return $res;
-}
-
-=head2 read_config
-
-  read_config();
-
-C<read_config()> reads in the configuration settings from
-C</etc/sbotools/sbotools.conf> and updates the C<%config> hash with them.
-
-There is no useful return value.
-
-=cut
-
-# subroutine to suck in config in order to facilitate unit testing
-sub read_config {
-  my $text = slurp($conf_file);
-  if (defined $text) {
-    my %conf_values = $text =~ /^(\w+)=(.*)$/mg;
-    for my $key (keys %config) {
-      $config{$key} = $conf_values{$key} if exists $conf_values{$key};
-    }
-    $config{JOBS} = 'FALSE' unless $config{JOBS} =~ /^\d+$/;
-  } else {
-    warn "Unable to open $conf_file.\n" if -f $conf_file;
-  }
-
-  $config{SBO_HOME} = '/usr/sbo' if $config{SBO_HOME} eq 'FALSE';
-  unless ($config{SBO_HOME} =~ qr#^(/|$)#) {
-    usage_error( "The configuration parameter SBO_HOME must be an absolute path.");
-  }
-}
-
-=head2 script_error
-
-  script_error();
-  script_error($msg);
-
-script_error() will warn and exit, saying on STDERR
-
-  A fatal script error has occurred. Exiting.
-
-If there was a $msg supplied, it will instead say
-
-  A fatal script error has occurred:
-  $msg.
-  Exiting.
-
-There is no useful return value.
-
-=cut
-
-# subroutine for throwing internal script errors
-sub script_error {
-  if (@_) {
-    warn "A fatal script error has occurred:\n$_[0]\nExiting.\n";
-  } else {
-    warn "A fatal script error has occurred. Exiting.\n";
-  }
-  exit _ERR_SCRIPT;
-}
-
-=head2 show_version
-
-  show_version();
-
-C<show_version()> will print out the sbotools version and licensing information
-to STDOUT.
-
-There is no useful return value.
-
-=cut
-
-sub show_version {
-  say "sbotools version $SBO::Lib::VERSION";
-}
-
-=head2 slurp
-
-  my $data = slurp($fn);
-
-C<slurp()> takes a filename in C<$fn>, opens it, and reads in the entire file,
-the contents of which is then returned. On error, it returns C<undef>.
-
-=cut
-
-sub slurp {
-  my $fn = shift;
-  return undef unless -f $fn;
-  my ($fh, $exit) = open_read($fn);
-  return undef if $exit;
-  local $/;
-  return scalar readline($fh);
-}
-
-=head2 uniq
-
-  my @uniq = uniq(@duplicates);
-
-C<uniq()> removes the duplicates from C<@duplicates> but otherwise returns the
-list in the same order.
-
-=cut
-
-sub uniq {
-  my %seen;
-  return grep { !$seen{$_}++ } @_;
-}
-
-=head2 usage_error
-
-  usage_error($msg);
-
-usage_error will warn and exit, saying on STDERR
-
-  $msg
-
-There is no useful return value.
-
-=cut
-
-# subroutine for usage errors
-sub usage_error {
-  warn shift ."\n";
-  exit _ERR_USAGE;
-}
-
-=head2 version_cmp
-
-  my $cmp = version_cmp($ver1, $ver2);
-
-C<version_cmp()> will compare C<$ver1> with C<$ver2> to try to determine which
-is bigger than the other, and returns 1 if C<$ver1> is bigger, -1 if C<$ver2>
-is bigger, and 0 if they are just as big. Before making the comparison, it will
-strip off the version of your running kernel as well as any locale information
-if it happens to be appended to the version string being compared.
-
-=cut
-
-# wrapper around versioncmp for checking if versions have kernel version
-# or locale info appended to them
-sub version_cmp {
-  my ($v1, $v2) = @_;
-  my $kv = get_kernel_version();
-
-  # strip off kernel version
-  if ($v1 =~ /(.+)_\Q$kv\E$/) { $v1 = $1 }
-  if ($v2 =~ /(.+)_\Q$kv\E$/) { $v2 = $1 }
-
-  # if $v2 doesn't end in the same thing, strip off locale info from $v1
-  if ($v1 =~ /(.*)_([a-z]{2})_([A-Z]{2})$/) {
-      my $v = $1;
-      if ($v2 !~ /_$2_$3$/) { $v1 = $v; }
-  }
-  # and vice versa...
-  if ($v2 =~ /(.*)_([a-z]{2})_([A-Z]{2})$/) {
-      my $v = $1;
-      if ($v1 !~ /_$2_$3$/) { $v2 = $v; }
-  }
-
-  versioncmp($v1, $v2);
-}
-
-# _race::cond will allow both documenting and testing race conditions
-# by overriding its implementation for tests
-sub _race::cond { return }
-
-1;