aboutsummaryrefslogtreecommitdiff
path: root/SBO-Lib/lib
diff options
context:
space:
mode:
Diffstat (limited to 'SBO-Lib/lib')
-rw-r--r--SBO-Lib/lib/SBO/Lib/Util.pm496
1 files changed, 496 insertions, 0 deletions
diff --git a/SBO-Lib/lib/SBO/Lib/Util.pm b/SBO-Lib/lib/SBO/Lib/Util.pm
new file mode 100644
index 0000000..ee5137f
--- /dev/null
+++ b/SBO-Lib/lib/SBO/Lib/Util.pm
@@ -0,0 +1,496 @@
+package SBO::Lib::Util;
+
+use 5.016;
+use strict;
+use warnings;
+
+our $VERSION = '2.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
+ idx
+ in
+ indent
+ open_fh
+ open_read
+ print_failures
+ script_error
+ show_version
+ uniq
+ usage_error
+ version_cmp
+ },
+ @EXPORT_CONSTS,
+ @EXPORT_CONFIG,
+);
+
+our %EXPORT_TAGS = (
+ all => \@EXPORT_OK,
+ const => \@EXPORT_CONSTS,
+ config => \@EXPORT_CONFIG,
+);
+
+=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>.
+
+=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',
+);
+
+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 what's at SBo
+# which is now not needed since this version drops support < 14.0
+# but it's already future-proofed, so leave it.
+sub get_slack_version {
+ return $config{SLACKWARE_VERSION} unless $config{SLACKWARE_VERSION} eq 'FALSE';
+ my %supported = (
+ '14.0' => '14.0',
+ '14.1' => '14.1',
+ '14.2' => '14.2',
+ );
+ 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")
+ unless $supported{$version};
+ return $supported{$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 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 %conf_values;
+ if (-f $conf_file) {
+ _race::cond('$conf_file might not exist after -f');
+ my ($fh, $exit) = open_read($conf_file);
+ if ($exit) {
+ warn $fh;
+ $config{SBO_HOME} = '/usr/sbo';
+ return;
+ }
+ my $text = do {local $/; <$fh>};
+ %conf_values = $text =~ /^(\w+)=(.*)$/mg;
+ close $fh;
+ }
+ for my $key (keys %config) {
+ $config{$key} = $conf_values{$key} if exists $conf_values{$key};
+ }
+ $config{JOBS} = 'FALSE' unless $config{JOBS} =~ /^\d+$/;
+ $config{SBO_HOME} = '/usr/sbo' if $config{SBO_HOME} eq 'FALSE';
+}
+
+=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";
+ say 'licensed under the WTFPL';
+ say '<http://sam.zoy.org/wtfpl/COPYING>';
+}
+
+=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 if it happens to be appended to
+the version string being compared.
+
+=cut
+
+# wrapper around versioncmp for checking if versions have kernel version
+# appended to them
+sub version_cmp {
+ my ($v1, $v2) = @_;
+ my $kv = get_kernel_version();
+
+ if ($v1 =~ /(.+)_\Q$kv\E$/) { $v1 = $1 }
+ if ($v2 =~ /(.+)_\Q$kv\E$/) { $v2 = $1 }
+
+ versioncmp($v1, $v2);
+}
+
+# _race::cond will allow both documenting and testing race conditions
+# by overriding its implementation for tests
+sub _race::cond { return }
+
+=head1 AUTHORS
+
+SBO::Lib was originally written by Jacob Pipkin <j@dawnrazor.net> with
+contributions from Luke Williams <xocel@iquidus.org> and Andreas
+Guldstrand <andreas.guldstrand@gmail.com>.
+
+=head1 LICENSE
+
+The sbotools are licensed under the WTFPL <http://sam.zoy.org/wtfpl/COPYING>.
+
+Copyright (C) 2012-2016, Jacob Pipkin, Luke Williams, Andreas Guldstrand.
+
+=cut
+
+1;
generated by cgit v1.2.3 (git 2.26.2) at 2025-04-23 11:31:08 +0000