Merge branch 'xocel into master'

1 files changed, 156 insertions, 95 deletions

diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index 92f22b5..ded1dac 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -5,16 +5,17 @@
 # Lib.pm
 # shared functions for the sbo_ scripts.
 #
-# author: Jacob Pipkin <j@dawnrazor.net>
-# date: Setting Orange, the 37th day of Discord in the YOLD 3178
+# authors:	Jacob Pipkin <j@dawnrazor.net>
+#			Luke Williams <xocel@iquidus.org>
 # license: WTFPL <http://sam.zoy.org/wtfpl/COPYING>
 
 use 5.16.0;
 use strict;
 use warnings FATAL => 'all';
 
-package SBO::Lib 1.1;
-my $version = '1.1';
+
+package SBO::Lib 1.2;
+my $version = '1.2';
 
 require Exporter;
 our @ISA = qw(Exporter);
@@ -27,6 +28,7 @@ our @EXPORT = qw(
 	fetch_tree
 	update_tree
 	get_installed_sbos
+	get_inst_names
 	get_available_updates
 	do_slackbuild
 	make_clean
@@ -36,6 +38,7 @@ our @EXPORT = qw(
 	get_from_info
 	get_tmp_extfn
 	get_arch
+	get_build_queue
 	$tempdir
 	$conf_dir
 	$conf_file
@@ -51,10 +54,15 @@ use File::Copy;
 use File::Path qw(make_path remove_tree);
 use File::Temp qw(tempdir tempfile);
 use File::Find;
+use File::Basename;
 use Fcntl qw(F_SETFD F_GETFD);
 
 our $tempdir = tempdir (CLEANUP => 1);
 
+# define this to facilitate unit testing - should only ever be modified from
+# t/test.t
+our $pkg_db = '/var/log/packages';
+
 # subroutine for throwing internal script errors
 sub script_error (;$) {
 	exists $_[0] ? die "A fatal script error has occurred:\n$_[0]\nExiting.\n"
@@ -62,10 +70,10 @@ sub script_error (;$) {
 }
 
 # sub for opening files, second arg is like '<','>', etc
-sub open_fh ($$) {
+sub open_fh {
 	exists $_[1] or script_error 'open_fh requires two arguments';
 	unless ($_[1] eq '>') {
-		-f $_[0] or script_error 'open_fh first argument not a file';
+		-f $_[0] or script_error "open_fh, $_[0] is not a file";
 	}
 	my ($file, $op) = @_;
 	open my $fh, $op, $file or die "Unable to open $file.\n";
@@ -73,7 +81,7 @@ sub open_fh ($$) {
 }
 
 sub open_read ($) {
-	return open_fh shift, '<';
+	return open_fh (shift, '<');
 }
 
 # global config variables
@@ -105,9 +113,9 @@ sub read_config () {
 
 read_config;
 
-# some stuff we'll need later.
-my $distfiles = "$config{SBO_HOME}/distfiles";
-my $slackbuilds_txt = "$config{SBO_HOME}/SLACKBUILDS.TXT";
+# some stuff we'll need later - define first two as our for unit testing
+our $distfiles = "$config{SBO_HOME}/distfiles";
+our $slackbuilds_txt = "$config{SBO_HOME}/SLACKBUILDS.TXT";
 my $name_regex = '\ASLACKBUILD\s+NAME:\s+';
 
 sub show_version () {
@@ -154,7 +162,7 @@ sub check_home () {
 sub rsync_sbo_tree () {
 	my $slk_version = get_slack_version;
 	my @arg = ('rsync', '-a', '--exclude=*.tar.gz', '--exclude=*.tar.gz.asc');
-	push @arg, "rsync://slackbuilds.org/slackbuilds/$slk_version/*";
+	push @arg, '--delete', "rsync://slackbuilds.org/slackbuilds/$slk_version/*";
 	my $out = system @arg, $config{SBO_HOME};
 	my $wanted = sub {
 		$File::Find::name ? chown 0, 0, $File::Find::name
@@ -195,25 +203,53 @@ sub get_installed_sbos () {
 	my @installed;
 	# $1 == name, $2 == version
 	my $regex = qr#/([^/]+)-([^-]+)-[^-]+-[^-]+$#;
-	for my $path (</var/log/packages/*_SBo>) {
+	for my $path (<$pkg_db/*_SBo>) {
 		my ($name, $version) = ($path =~ $regex)[0,1];
 		push @installed, {name => $name, version => $version};
 	}
 	return \@installed;
 }
 
+# for a ref to an array of hashes of installed packages, return an array ref
+# consisting of just their names
+sub get_inst_names ($) {
+	exists $_[0] or script_error 'get_inst_names requires an argument.';
+	my $inst = shift;
+	my @installed;
+	push @installed, $$_{name} for @$inst;
+	return \@installed;
+}
+
 # search the SLACKBUILDS.TXT for a given sbo's directory
-sub get_sbo_location ($) {
+sub get_sbo_location {
 	exists $_[0] or script_error 'get_sbo_location requires an argument.';
-	my $sbo = shift;
-	my $regex = qr#LOCATION:\s+\.(/[^/]+/\Q$sbo\E)$#;
+	my @sbos = @_;
+	if (ref $sbos[0] eq 'ARRAY') {
+		my $tmp = $sbos[0];
+		@sbos = @$tmp;
+	}
+	state $store = {};
+	# if scalar context and we already have the location, return it now.
+	unless (wantarray) {
+		return $$store{$sbos[0]} if exists $$store{$sbos[0]};
+	}
+	my %locations;
 	my $fh = open_read $slackbuilds_txt;
-	while (my $line = <$fh>) {
-		if (my $loc = ($line =~ $regex)[0]) {
-			return "$config{SBO_HOME}$loc";
+	FIRST: for my $sbo (@sbos) {
+		$locations{$sbo} = $$store{$sbo}, next FIRST if exists $$store{$sbo};
+		my $regex = qr#LOCATION:\s+\.(/[^/]+/\Q$sbo\E)$#;
+		while (my $line = <$fh>) {
+			if (my $loc = ($line =~ $regex)[0]) {
+				# save what we found for later requests
+				$$store{$sbo} = "$config{SBO_HOME}$loc";
+				return $$store{$sbo} unless wantarray;
+				$locations{$sbo} = $$store{$sbo};
+			}
 		}
+		seek $fh, 0, 0;
 	}
-	return;
+	close $fh;
+	return keys %locations > 0 ? %locations : undef;
 }
 
 # pull the sbo name from a $location: $config{SBO_HOME}/system/wine, etc.
@@ -223,7 +259,7 @@ sub get_sbo_from_loc ($) {
 }
 
 # pull piece(s) of data, GET, from the $sbo.info file under LOCATION.
-sub get_from_info (%) {
+sub get_from_info {
 	my %args = (
 		LOCATION	=> '',
 		GET			=> '',
@@ -232,26 +268,26 @@ sub get_from_info (%) {
 	unless ($args{LOCATION} && $args{GET}) {
 		script_error 'get_from_info requires LOCATION and GET.';
 	}
-	state $vars = {PRGNAM => ['']};
+	state $store = {PRGNAM => ['']};
 	my $sbo = get_sbo_from_loc $args{LOCATION};
-	return $$vars{$args{GET}} if $$vars{PRGNAM}[0] eq $sbo;
+	return $$store{$args{GET}} if $$store{PRGNAM}[0] eq $sbo;
 	# if we're here, we haven't read in the .info file yet.
 	my $fh = open_read "$args{LOCATION}/$sbo.info";
-	# suck it all in, clean it all up, stuff it all in $vars.
+	# suck it all in, clean it all up, stuff it all in $store.
 	my $contents = do {local $/; <$fh>};
 	$contents =~ s/("|\\\n)//g;
-	$vars = {$contents =~ /^(\w+)=(.*)$/mg};
+	$store = {$contents =~ /^(\w+)=(.*)$/mg};
 	# fill the hash with array refs - even for single values,
 	# since consistency here is a lot easier than sorting it out later
-	for my $key (keys %$vars) {
-		if ($$vars{$key} =~ /\s/) {
-			my @array = split ' ', $$vars{$key};
-			$$vars{$key} = \@array;
+	for my $key (keys %$store) {
+		if ($$store{$key} =~ /\s/) {
+			my @array = split ' ', $$store{$key};
+			$$store{$key} = \@array;
 		} else {
-			$$vars{$key} = [$$vars{$key}];
+			$$store{$key} = [$$store{$key}];
 		}
 	}
-	return exists $$vars{$args{GET}} ? $$vars{$args{GET}} : undef;
+	return exists $$store{$args{GET}} ? $$store{$args{GET}} : undef;
 }
 
 # find the version in the tree for a given sbo (provided a location)
@@ -267,7 +303,7 @@ sub get_available_updates () {
 	my @updates;
 	my $pkg_list = get_installed_sbos; 
 	FIRST: for my $key (keys @$pkg_list) {
-		my $location = get_sbo_location $$pkg_list[$key]{name};
+		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 $version = get_sbo_version $location;
@@ -284,7 +320,7 @@ sub get_available_updates () {
 
 # get downloads and md5sums from an sbo's .info file, first 
 # checking for x86_64-specific info if we are told to
-sub get_download_info (%) {
+sub get_download_info {
 	my %args = (
 		LOCATION 	=> 0,
 		X64 		=> 1,
@@ -296,13 +332,7 @@ sub get_download_info (%) {
 	$downs = get_from_info (LOCATION => $args{LOCATION}, GET => $get);
 	# did we get nothing back, or UNSUPPORTED/UNTESTED?
 	if ($args{X64}) {
-		my $nothing;
-		if (! $$downs[0]) {
-			$nothing++;
-		} elsif ($$downs[0] =~ qr/^UN(SUPPOR|TES)TED$/) {
-			$nothing++;
-		}
-		if ($nothing) {
+		if (! $$downs[0] || $$downs[0] =~ qr/^UN(SUPPOR|TES)TED$/) {
 			$args{X64} = 0;
 			$downs = get_from_info (LOCATION => $args{LOCATION},
 				GET => 'DOWNLOAD');
@@ -324,7 +354,7 @@ sub get_arch () {
 }
 
 # TODO: should probably combine this with get_download_info
-sub get_sbo_downloads (%) {
+sub get_sbo_downloads {
 	my %args = (
 		LOCATION	=> '',
 		32			=> 0,
@@ -344,17 +374,17 @@ sub get_sbo_downloads (%) {
 	return %dl_info;
 }
 
-# given a link, grab the filename from the end of it
+# given a link, grab the filename from it and prepend $distfiles
 sub get_filename_from_link ($) {
 	exists $_[0] or script_error 'get_filename_from_link requires an argument';
 	my $fn = shift;
 	my $regex = qr#/([^/]+)$#;
 	my $filename = $fn =~ $regex ? $distfiles .'/'. ($fn =~ $regex)[0] : undef;
-	$filename =~ s/%2B/+/g;
+	$filename =~ s/%2B/+/g if $filename;
 	return $filename;
 }
 
-# for a given file, computer its md5sum
+# for a given file, compute its md5sum
 sub compute_md5sum ($) {
 	-f $_[0] or script_error 'compute_md5sum requires a file argument.';
 	my $fh = open_read shift;
@@ -365,42 +395,34 @@ sub compute_md5sum ($) {
 	return $md5sum;
 }
 
-sub compare_md5s ($$) {
-	exists $_[1] or script_error 'compare_md5s requires two arguments.';
-	my ($first, $second) = @_;
-	return $first eq $second ? 1 : undef;
-}
-
 # for a given distfile, see whether or not it exists, and if so, if its md5sum
 # matches the sbo's .info file
-sub verify_distfile ($$) {
+sub verify_distfile {
 	exists $_[1] or script_error 'verify_distfile requires two arguments.';
-	my ($link, $info_md5sum) = @_;
+	my ($link, $info_md5) = @_;
 	my $filename = get_filename_from_link $link;
-	return unless -d $distfiles;
 	return unless -f $filename;
 	my $md5sum = compute_md5sum $filename;
-	return compare_md5s $info_md5sum, $md5sum;
+	return $info_md5 eq $md5sum ? 1 : 0;
 }
 
 # 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 ($$) {
+sub get_distfile {
 	exists $_[1] or script_error 'get_distfile requires an argument';
-	my ($link, $exp_md5) = @_;
+	my ($link, $info_md5) = @_;
 	my $filename = get_filename_from_link $link;
 	mkdir $distfiles unless -d $distfiles;
 	chdir $distfiles;
 	system ("wget --no-check-certificate $link") == 0 or
 		die "Unable to wget $link\n";
-	my $md5sum = compute_md5sum $filename;
 	# can't do anything if the link in the .info doesn't lead to a good d/l
-	compare_md5s $md5sum, $exp_md5 or die "md5sum failure for $filename.\n";
+	verify_distfile (@_) ? return 1 : die "md5sum failure for $filename.\n";
 	return 1;
 }
 
 # for a given distfile, figure out what the full path to its symlink will be
-sub get_symlink_from_filename ($$) {
+sub get_symlink_from_filename {
 	exists $_[1] or script_error
 		'get_symlink_from_filename requires two arguments';
 	-f $_[0] or script_error
@@ -424,40 +446,26 @@ sub check_multilib () {
 }
 
 # make a backup of the existent SlackBuild, and rewrite the original as needed
-sub rewrite_slackbuild (%) {
+sub rewrite_slackbuild {
 	my %args = (
 		SLACKBUILD	=> '',
-		TEMPFN		=> '',
 		CHANGES		=> {}, 
 		@_
 	);
-	unless ($args{SLACKBUILD} && $args{TEMPFN}) {
-		script_error 'rewrite_slackbuild requires SLACKBUILD and TEMPFN.';
-	}
+	$args{SLACKBUILD} or script_error 'rewrite_slackbuild requires SLACKBUILD.';
 	my $slackbuild = $args{SLACKBUILD};
 	my $changes = $args{CHANGES};
 	copy ($slackbuild, "$slackbuild.orig") or
 		die "Unable to backup $slackbuild to $slackbuild.orig\n";
-	my $tar_regex = qr/(un|)tar .*$/;
-	my $makepkg_regex = qr/makepkg/;
 	my $libdir_regex = qr/^\s*LIBDIRSUFFIX="64"\s*$/;
-	my $make_regex = qr/^\s*make(| \Q||\E exit 1)$/;
 	my $arch_regex = qr/\$VERSION-\$ARCH-\$BUILD/;
 	# tie the slackbuild, because this is the easiest way to handle this.
 	tie my @sb_file, 'Tie::File', $slackbuild;
 	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 $args{TEMPFN}";
-		}
 		# then check for and apply any other %$changes
 		if (exists $$changes{libdirsuffix}) {
 			$line =~ s/64/$$changes{libdirsuffix}/ if $line =~ $libdir_regex;
 		}
-		if (exists $$changes{make}) {
-			$line =~ s/make/make $$changes{make}/ if $line =~ $make_regex;
-		}
 		if (exists $$changes{arch_out}) {
 			$line =~ s/\$ARCH/$$changes{arch_out}/ if $line =~ $arch_regex;
 		}
@@ -479,25 +487,24 @@ sub revert_slackbuild ($) {
 
 # for each $download, see if we have it, and if the copy we have is good,
 # otherwise download a new copy
-sub check_distfiles (%) {
+sub check_distfiles {
 	exists $_[0] or script_error 'check_distfiles requires an argument.';
 	my %dists = @_;
-	for my $link (keys %dists) {
-		my $md5sum = $dists{$link};
-		get_distfile $link, $md5sum unless verify_distfile $link, $md5sum;
+	while (my ($link, $md5) = each %dists) {
+		get_distfile ($link, $md5) unless verify_distfile ($link, $md5);
 	}
 	return 1;
 }
 
 # given a location and a list of download links, assemble a list of symlinks,
 # and create them.
-sub create_symlinks ($%) {
+sub create_symlinks {
 	exists $_[1] or script_error 'create_symlinks requires two arguments.';
 	my ($location, %downloads) = @_;
 	my @symlinks;
 	for my $link (keys %downloads) {
 		my $filename = get_filename_from_link $link;
-		my $symlink = get_symlink_from_filename $filename, $location;
+		my $symlink = get_symlink_from_filename ($filename, $location);
 		push @symlinks, $symlink;
 		symlink $filename, $symlink;
 	}
@@ -506,7 +513,7 @@ sub create_symlinks ($%) {
 
 # pull the untarred source directory or created package name from the temp
 # file (the one we tee'd to)
-sub grok_temp_file (%) {
+sub grok_temp_file {
 	my %args = (
 		FH		=> '',
 		REGEX	=> '',
@@ -549,7 +556,7 @@ sub get_tmp_extfn ($) {
 }
 
 # prep and run .SlackBuild
-sub perform_sbo (%) {
+sub perform_sbo {
 	my %args = (
 		OPTS		=> 0, 
 		JOBS		=> 0,
@@ -562,29 +569,39 @@ sub perform_sbo (%) {
 	unless ($args{LOCATION} && $args{ARCH}) {
 		script_error 'perform_sbo requires LOCATION and ARCH.';
 	}
+
 	my $location = $args{LOCATION};
 	my $sbo = get_sbo_from_loc $location;
 	my ($cmd, %changes);
 	# set any changes we need to make to the .SlackBuild, setup the command
-	$changes{make} = "-j $args{JOBS}" if $args{JOBS};
+	
+	$cmd = '( ';
+	$args{JOBS} = 0 if $args{JOBS} eq 'FALSE';
+
 	if ($args{ARCH} eq 'x86_64' and ($args{C32} || $args{X32})) {
 		if ($args{C32}) {
 			$changes{libdirsuffix} = '';
 		} elsif ($args{X32}) {
 			$changes{arch_out} = 'i486';
 		}
-		$cmd = '. /etc/profile.d/32dev.sh &&';
+		$cmd .= '. /etc/profile.d/32dev.sh &&';
 	}
-	$cmd .= "/bin/sh $location/$sbo.SlackBuild";
-	$cmd = "$args{OPTS} $cmd" if $args{OPTS};
+	$cmd .= " $args{OPTS}" if $args{OPTS};
+	$cmd .= " MAKEOPTS=\"-j$args{JOBS}\"" if $args{JOBS};
+	# get a tempfile to store the exit status of the slackbuild
+	my $exit_temp = tempfile (DIR => $tempdir);
+	my $exit_fn = get_tmp_extfn $exit_temp;
+	$cmd .= " /bin/sh $location/$sbo.SlackBuild; echo \$? > $exit_fn )";
 	my $tempfh = tempfile (DIR => $tempdir);
 	my $fn = get_tmp_extfn $tempfh;
+	$cmd .= " | tee -a $fn";
 	rewrite_slackbuild (
 		SLACKBUILD => "$location/$sbo.SlackBuild",
-		TEMPFN => $fn,
 		CHANGES => \%changes,
 	);
-	chdir $location, my $out = system $cmd;
+	chdir $location, system $cmd;
+	seek $exit_temp, 0, 0;
+	my $out = do {local $/; <$exit_temp>};
 	revert_slackbuild "$location/$sbo.SlackBuild";
 	die "$sbo.SlackBuild returned non-zero exit status\n" unless $out == 0;
 	my $pkg = get_pkg_name $tempfh;
@@ -606,7 +623,7 @@ sub do_convertpkg ($) {
 }
 
 # "public interface", sort of thing.
-sub do_slackbuild (%) {
+sub do_slackbuild {
 	my %args = (
 		OPTS		=> 0, 
 		JOBS		=> 0,
@@ -618,18 +635,18 @@ sub do_slackbuild (%) {
 	my $location = $args{LOCATION};
 	my $sbo = get_sbo_from_loc $location;
 	my $arch = get_arch; 
-	my $multi = check_multilib;
+	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}) {
-		die "compat32 requires multilib.\n" unless $multi;
+		die "compat32 requires multilib.\n" unless $multilib;
 		die "compat32 requires /usr/sbin/convertpkg-compat32.\n"
 				unless -f '/usr/sbin/convertpkg-compat32';
 	} else {
 		if ($arch eq 'x86_64') {
 			$x32 = check_x32 $args{LOCATION};
-			if ($x32 && ! $multi) {
+			if ($x32 && ! $multilib) {
 				die "$sbo is 32-bit which requires multilib on x86_64.\n";
 			}
 		}
@@ -640,7 +657,7 @@ sub do_slackbuild (%) {
 		32 => $args{COMPAT32}
 	);
 	check_distfiles %downloads;
-	my @symlinks = create_symlinks $args{LOCATION}, %downloads;
+	my @symlinks = create_symlinks ($args{LOCATION}, %downloads);
 	# setup and run the .SlackBuild itself
 	my ($pkg, $src) = perform_sbo (
 		OPTS => $args{OPTS},
@@ -656,7 +673,7 @@ sub do_slackbuild (%) {
 }
 
 # remove work directories (source and packaging dirs under /tmp/SBo)
-sub make_clean (%) {
+sub make_clean {
 	my %args = (
 		SBO		=> '',
 		SRC		=> '',
@@ -675,7 +692,7 @@ sub make_clean (%) {
 }
 
 # remove distfiles
-sub make_distclean (%) {
+sub make_distclean {
 	my %args = (
 		SRC			=> '',
 		VERSION		=> '',
@@ -704,3 +721,47 @@ sub do_upgradepkg ($) {
 	return 1;
 }
 
+
+# avoid being called to early to check prototype when add_to_queue calls itself
+sub add_to_queue ($);
+# used by get_build_queue. 
+sub add_to_queue ($) {
+	my $args = shift;
+	my $sbo = \${$args}{NAME};
+	return unless $$sbo;
+	push @$args{QUEUE}, $$sbo;
+	my $location = get_sbo_location ($$sbo);
+	return unless $location;
+	my $requires = get_from_info (LOCATION => $location, GET => 'REQUIRES');
+	FIRST: for my $req (@$requires) {
+		next FIRST if $req eq $$sbo;
+		if ($req eq "%README%") {
+			${$args}{WARNINGS}{$$sbo}="%README%";
+		} else {
+			$$sbo = $req;
+			add_to_queue($args);
+		}
+	}	
+}
+
+# recursively add a sbo's requirements to the build queue.
+sub get_build_queue {
+	exists $_[1] or script_error 'get_build_queue requires two arguments.';
+	my ($sbos, $warnings) = @_;
+	my $temp_queue = [];
+	for my $sbo (@$sbos) {
+		my %args = (
+			QUEUE 	  => $temp_queue,
+			NAME 	  => $sbo,
+			WARNINGS  => $warnings
+		);
+		add_to_queue(\%args);
+	}
+	# Remove duplicate entries (leaving first occurrence)
+	my (%seen, @build_queue);
+	FIRST: for my $sb (@$temp_queue) {
+		 next FIRST if $seen{$sb}++;
+		 push @build_queue, $sb;
+	}
+	return \@build_queue;
+}