aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--SBO-Lib/lib/SBO/Lib.pm109
1 files changed, 88 insertions, 21 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index 5569d43..be8d978 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -7,8 +7,8 @@
# date: Setting Orange, the 37th day of Discord in the YOLD 3178
# license: WTFPL <http://sam.zoy.org/wtfpl/COPYING>
-package SBO::Lib 0.1;
-my $version = "0.1";
+package SBO::Lib 0.5;
+my $version = "0.5";
require Exporter;
@@ -35,7 +35,6 @@ require Exporter;
use warnings FATAL => 'all';
use strict;
use File::Basename;
-#use English '-no_match_vars';
use Tie::File;
use IO::File;
use Sort::Versions;
@@ -58,17 +57,20 @@ my @valid_conf_keys = (
);
our %config;
+# if the conf file exists, pull all the $key=$value pairs into a hash
if (-f $conf_file) {
open my $reader, '<', $conf_file;
my $text = do {local $/; <$reader>};
%config = $text =~ /^(\w+)=(.*)$/mg;
close ($reader);
}
+# undef any invalid $key=$value pairs
for my $key (keys %config) {
unless ($key ~~ @valid_conf_keys) {
undef $config{$key};
}
}
+# ensure we have sane configs, and defaults for anything not in the conf file
for my $key (@valid_conf_keys) {
if ($key eq 'SBO_HOME') {
$config{$key} = '/usr/sbo' unless exists $config{$key};
@@ -89,7 +91,6 @@ my $slackbuilds_txt = "$config{SBO_HOME}/SLACKBUILDS.TXT";
my $name_regex = '\ASLACKBUILD\s+NAME:\s+';
# this should be done a bit differently.
-#
sub script_error {
unless (exists $_[0]) {
print "A fatal script error has occured. Exiting.\n";
@@ -113,7 +114,14 @@ sub get_slack_version {
chomp (my $line = <$slackver>);
close ($slackver);
my $slk_version = split_line ($line, ' ', 1);
- $slk_version = '13.37' if $slk_version eq '13.37.0';
+ # for now, we may as well die if $slk_version ne '13.37', since it and
+ # current, which will also be '13.37' in this case, are the only
+ # supported versions
+ if ($slk_version eq '13.37.0') {
+ $slk_version = '13.37';
+ } else {
+ print "Unsupported Slackware version: $slk_version\n" and exit (1);
+ }
return $slk_version;
} else {
print "I am unable to locate your /etc/slackware-version file.\n";
@@ -126,6 +134,8 @@ sub check_slackbuilds_txt {
return;
}
+# check for the existence of $config{SBO_HOME}, and whether or not it already
+# has stuff in
sub check_home {
my $sbo_home = $config{SBO_HOME};
if (-d $sbo_home) {
@@ -164,6 +174,9 @@ sub update_tree {
rsync_sbo_tree ();
}
+# if the SLACKBUILDS.TXT is not in $config{SBO_HOME}, we should assume the tree
+# has not been populated there, since we rely on that file anyway; prompt the
+# user to automagickally pull the tree.
sub slackbuilds_or_fetch {
if (! check_slackbuilds_txt () ) {
print "It looks like you haven't run \"sbosnap fetch\" yet.\n";
@@ -179,6 +192,9 @@ sub slackbuilds_or_fetch {
}
}
+# pull an array of hashes, each hash containing the name and version of an sbo
+# currently installed. starting to think it might be better to only pull an
+# array of names, and have another sub to pull the versions.
sub get_installed_sbos {
my @installed;
opendir my $diread, '/var/log/packages';
@@ -195,6 +211,7 @@ sub get_installed_sbos {
return @installed;
}
+# take a line and get rid of newlines, spaces, double quotes, and backslashes
sub clean_line {
script_error ('clean line requires an argument') unless exists $_[0];
chomp (my $line = shift);
@@ -202,6 +219,8 @@ sub clean_line {
return $line;
}
+# given a line, pattern, and index, split the line on the pattern, and return
+# a clean_line'd version of the index
sub split_line {
script_error ('split_line requires three arguments') unless exists $_[2];
my ($line, $pattern, $index) = @_;
@@ -214,11 +233,13 @@ sub split_line {
return clean_line ($split[$index]);
}
+# pull a clean_line'd value from a $key=$value pair
sub split_equal_one {
script_error ('split_equal_one requires an argument') unless exists $_[0];
return split_line ($_[0], '=', 1);
}
+# search the tree for a given sbo's directory
sub get_sbo_location {
script_error ('get_sbo_location requires an argument.Exiting.')
unless exists $_[0];
@@ -235,22 +256,24 @@ sub get_sbo_location {
return $location;
}
+# for each installed sbo, find out whether or not the version in the tree is
+# newer, and compile an array of hashes containing those which are
sub get_available_updates {
my @updates;
my @pkg_list = get_installed_sbos ();
- FIRST: for my $c (keys @pkg_list) {
- my $location = get_sbo_location ($pkg_list[$c]{name});
+ FIRST: for my $key (keys @pkg_list) {
+ my $location = get_sbo_location ($pkg_list[$key]{name});
+ # if we can't find a location, assume invalid and skip
next FIRST unless defined $location;
-
my $regex = qr/^VERSION=/;
- open my $info, '<', "$location/$pkg_list[$c]{name}.info";
+ open my $info, '<', "$location/$pkg_list[$key]{name}.info";
SECOND: while (my $line = <$info>) {
if ($line =~ $regex) {
my $sbo_version = split_equal_one ($line);
- if (versioncmp ($sbo_version, $pkg_list[$c]{version}) == 1) {
+ if (versioncmp ($sbo_version, $pkg_list[$key]{version}) == 1) {
my %hash = (
- name => $pkg_list[$c]{name},
- installed => $pkg_list[$c]{version},
+ name => $pkg_list[$key]{name},
+ installed => $pkg_list[$key]{version},
update => $sbo_version,
);
push (@updates, \%hash);
@@ -263,6 +286,8 @@ sub get_available_updates {
return @updates;
}
+# pull links or md5sums (type - 'download','md5sum') from a given sbo's .info
+# file, first checking for x86_64-specific info we are told to
sub find_download_info {
script_error('find_download_info requires four arguments.')
unless exists $_[3];
@@ -279,14 +304,20 @@ sub find_download_info {
} else {
$regex = qr/$regex=/;
}
+ # the x86_64 info may be empty
my $empty_regex = qr/=""$/;
+ # we need to know whether or not there are more than one lines for a given
+ # key
my $back_regex = qr/\\$/;
+ # assume there's not
my $more = 'FALSE';
open my $info, '<', "$location/$sbo.info";
FIRST: while (my $line = <$info>) {
unless ($more eq 'TRUE') {
if ($line =~ $regex) {
last FIRST if $line =~ $empty_regex;
+ # some sbos have UNSUPPORTED for the x86_64 info, meaning we
+ # proceed to pull the non-x86_64-specific info
unless (index ($line, 'UNSUPPORTED') != -1) {
push (@return, split_equal_one ($line) );
$more = 'TRUE' if $line =~ $back_regex;
@@ -310,6 +341,8 @@ sub get_arch {
return $arch;
}
+# assemble an array of hashes containing links and md5sums for a given sbo,
+# with the option of only checking for 32-bit links, for -compat32 packaging
sub get_sbo_downloads {
script_error ('get_sbo_downloads requires three arguments.')
unless exists $_[2];
@@ -328,8 +361,8 @@ sub get_sbo_downloads {
@md5s = find_download_info ($sbo, $location, 'md5sum', 0);
}
my @downloads;
- for my $c (keys @links) {
- my %hash = (link => $links[$c], md5sum => $md5s[$c]);
+ for my $key (keys @links) {
+ my %hash = (link => $links[$key], md5sum => $md5s[$key]);
push (@downloads, \%hash);
}
return @downloads;
@@ -355,6 +388,8 @@ sub compute_md5sum {
return $md5sum;
}
+# for a given distfile, see whether or not it exists, and if so, if its md5sum
+# matches the sbo's .info file
sub check_distfile {
script_error ('check_distfile requires two arguments.') unless exists $_[1];
my ($link, $info_md5sum) = @_;
@@ -366,6 +401,8 @@ sub check_distfile {
return 1;
}
+# for a given distfile, attempt to retrieve it and, if successful, check its
+# md5sum against that in the sbo's .info file
sub get_distfile {
script_error ('get_distfile requires an argument') unless exists $_[1];
my ($link, $expected_md5sum) = @_;
@@ -382,6 +419,7 @@ sub get_distfile {
return 1;
}
+# find the version in the tree for a given sbo
sub get_sbo_version {
script_error ('get_sbo_version requires two arguments.')
unless exists $_[1];
@@ -399,16 +437,19 @@ sub get_sbo_version {
return $version;
}
+# for a given distfile, what will be the full path of the symlink?
sub get_symlink_from_filename {
script_error ('get_symlink_from_filename requires two arguments')
unless exists $_[1];
script_error ('get_symlink_from_filename first argument is not a file')
unless -f $_[0];
- my @split = split ('/', reverse ($_[0]), 2);
+ my ($filename, $location) = @_;
+ my @split = split ('/', reverse ($filename), 2);
my $fn = reverse ($split[0]);
- return "$_[1]/$fn";
+ return "$location/$fn";
}
+# determine whether or not a given sbo is 32-bit only
sub check_x32 {
script_error ('check_x32 requires two arguments.') unless exists $_[1];
my ($sbo, $location) = @_;
@@ -422,11 +463,18 @@ sub check_x32 {
return;
}
+# 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;
}
+# necessary to rewrite the .SlackBuild on the fly, at the very least, in order
+# to add our tee commands in, so that we can grok the output; optionally, to
+# alter the LIBDIRSUFFIX, for 32-bit things, to edit the "make" command for -j,
+# or to change the output architecture. first thing we do is backup the
+# existent .SlackBuild file.
sub rewrite_slackbuild {
script_error ('rewrite_slackbuild requires two arguments.')
unless exists $_[1];
@@ -439,6 +487,8 @@ sub rewrite_slackbuild {
my $arch_out_regex = qr/\$VERSION-\$ARCH-\$BUILD/;
tie my @sb_file, 'Tie::File', $slackbuild;
FIRST: for my $line (@sb_file) {
+ # get the output of the tar and makepkg commands. hope like hell that v
+ # is specified among tar's arguments
if ($line =~ $tar_regex || $line =~ $makepkg_regex) {
$line = "$line | tee -a $tempfn";
}
@@ -466,6 +516,7 @@ sub rewrite_slackbuild {
return 1;
}
+# move a backed-up .SlackBuild file back into place
sub revert_slackbuild {
script_error ('revert_slackbuild requires an argument') unless exists $_[0];
my $slackbuild = shift;
@@ -478,14 +529,18 @@ sub revert_slackbuild {
return 1;
}
+# given a location and a list of download links, assemble a list of symlinks,
+# and create them.
+#
+# actually, we're also handling the links themselves here. odd.
sub create_symlinks {
script_error ('create_symlinks requires two arguments.')
unless exists $_[1];
my ($location, @downloads) = @_;
my @symlinks;
- for my $c (keys @downloads) {
- my $link = $downloads[$c]{link};
- my $md5sum = $downloads[$c]{md5sum};
+ for my $key (keys @downloads) {
+ my $link = $downloads[$key]{link};
+ my $md5sum = $downloads[$key]{md5sum};
my $filename = get_filename_from_link ($link);
unless (check_distfile ($link, $md5sum) ) {
die unless get_distfile ($link, $md5sum);
@@ -497,6 +552,7 @@ sub create_symlinks {
return @symlinks;
}
+# make a .SlackBuild executable.
sub prep_sbo_file {
script_error ('prep_sbo_file requires two arguments') unless exists $_[1];
my ($sbo, $location) = @_;
@@ -505,6 +561,8 @@ sub prep_sbo_file {
return 1;
}
+# pull the untarred source directory or created package name from the temp
+# file (the one we tee'd to)
sub grok_temp_file {
script_error ('grok_temp_file requires two arguments') unless exists $_[1];
my ($tempfn, $find) = @_;
@@ -526,6 +584,7 @@ sub grok_temp_file {
return $out;
}
+# wrappers around grok_temp_file
sub get_src_dir {
script_error ('get_src_dir requires an argument') unless exists $_[0];
my $filename = shift;
@@ -538,6 +597,7 @@ sub get_pkg_name {
return grok_temp_file ($filename, 'pkg');
}
+# do things necessary to run the .SlackBuild, and then do so.
sub perform_sbo {
script_error ('perform_sbo requires five arguments') unless exists $_[4];
my ($jobs, $sbo, $location, $arch, $c32, $x32) = @_;
@@ -569,6 +629,7 @@ sub perform_sbo {
return $pkg, $src;
}
+# safely create a temp file
sub make_temp_file {
make_path ('/tmp/sbotools') unless -d '/tmp/sbotools';
my $temp_dir = -d '/tmp/sbotools' ? '/tmp/sbotools' : $ENV{TMPDIR} ||
@@ -578,6 +639,8 @@ sub make_temp_file {
return ($fh, $filename);
}
+# for compat32 slackbuilds
+# sb_compat32 and sb_normal should probably be refactored a bit.
sub sb_compat32 {
script_error ('sb_compat32 requires six arguments.') unless exists $_[5];
my ($jobs, $sbo, $location, $arch, $version, @downloads) = @_;
@@ -627,6 +690,7 @@ to be setup for multilib.\n";
return $pkg, $src;
}
+# "public interface", sort of thing - calls sb_compat32 or sb_normal.
sub do_slackbuild {
script_error ('do_slackbuild requires two arguments.') unless exists $_[1];
my ($jobs, $sbo, $location, $compat32) = @_;
@@ -645,6 +709,7 @@ sub do_slackbuild {
return $version, $pkg, $src;
}
+# remove work directories (source and packaging dirs under /tmp/SBo)
sub make_clean {
script_error ('make_clean requires two arguments.') unless exists $_[1];
my ($sbo, $src, $version) = @_;
@@ -655,6 +720,7 @@ sub make_clean {
return 1;
}
+# remove distfiles
sub make_distclean {
script_error ('make_distclean requires three arguments.')
unless exists $_[2];
@@ -662,13 +728,14 @@ sub make_distclean {
make_clean ($sbo, $src, $version);
print "Distcleaning for $sbo-$version...\n";
my @downloads = get_sbo_downloads ($sbo, $location, 0);
- for my $c (keys @downloads) {
- my $filename = get_filename_from_link ($downloads[$c]{link});
+ for my $key (keys @downloads) {
+ my $filename = get_filename_from_link ($downloads[$key]{link});
unlink ($filename) if -f $filename;
}
return 1;
}
+# run upgradepkg for a created package
sub do_upgradepkg {
script_error ('do_upgradepkg requires an argument.') unless exists $_[0];
my $pkg = shift;
generated by cgit v1.2.3 (git 2.26.2) at 2025-05-01 18:07:11 +0000