diff options
Diffstat (limited to 'SBO-Lib/lib/SBO')
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 160 | 
1 files changed, 74 insertions, 86 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index c2c1f4c..0a693e3 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -69,7 +69,7 @@ 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'; @@ -80,7 +80,7 @@ sub open_fh ($$) {  }  sub open_read ($) { -	return open_fh shift, '<'; +	return open_fh (shift, '<');  }  # global config variables @@ -161,7 +161,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 @@ -220,17 +220,35 @@ sub get_inst_names ($) {  }  # 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. @@ -240,7 +258,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			=> '', @@ -249,26 +267,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) @@ -284,7 +302,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; @@ -301,7 +319,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, @@ -313,13 +331,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'); @@ -341,7 +353,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, @@ -361,7 +373,7 @@ 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; @@ -371,7 +383,7 @@ sub get_filename_from_link ($) {  	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; @@ -382,42 +394,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 @@ -441,40 +445,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;  		} @@ -496,25 +486,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;  	} @@ -523,7 +512,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	=> '', @@ -566,7 +555,7 @@ sub get_tmp_extfn ($) {  }  # prep and run .SlackBuild -sub perform_sbo (%) { +sub perform_sbo {  	my %args = (  		OPTS		=> 0,   		JOBS		=> 0, @@ -586,8 +575,6 @@ sub perform_sbo (%) {  	# set any changes we need to make to the .SlackBuild, setup the command  	$args{JOBS} = 0 if $args{JOBS} eq 'FALSE'; -	$changes{make} = "-j $args{JOBS}" if $args{JOBS}; -  	if ($args{ARCH} eq 'x86_64' and ($args{C32} || $args{X32})) {  		if ($args{C32}) { @@ -597,13 +584,14 @@ sub perform_sbo (%) {  		}  		$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}; +	$cmd .= " /bin/sh $location/$sbo.SlackBuild";  	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; @@ -628,7 +616,7 @@ sub do_convertpkg ($) {  }  # "public interface", sort of thing. -sub do_slackbuild (%) { +sub do_slackbuild {  	my %args = (  		OPTS		=> 0,   		JOBS		=> 0, @@ -640,18 +628,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";  			}  		} @@ -662,7 +650,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}, @@ -678,7 +666,7 @@ sub do_slackbuild (%) {  }  # remove work directories (source and packaging dirs under /tmp/SBo) -sub make_clean (%) { +sub make_clean {  	my %args = (  		SBO		=> '',  		SRC		=> '', @@ -697,7 +685,7 @@ sub make_clean (%) {  }  # remove distfiles -sub make_distclean (%) { +sub make_distclean {  	my %args = (  		SRC			=> '',  		VERSION		=> '', @@ -735,7 +723,7 @@ sub add_to_queue ($) {  	my $sbo = \${$args}{NAME};  	return unless $$sbo;  	unshift @$args{QUEUE}, $$sbo; -	my $location = get_sbo_location $$sbo; +	my $location = get_sbo_location ($$sbo);  	return unless $location;  	my $requires = get_from_info (LOCATION => $location, GET => 'REQUIRES');  	FIRST: for my $req (@$requires) { @@ -750,7 +738,7 @@ sub add_to_queue ($) {  }  # recursively add a sbo's requirements to the build queue. -sub get_build_queue ($$) { +sub get_build_queue {  	exists $_[1] or script_error 'get_build_queue requires two arguments.';  	my ($sbos, $warnings) = @_;  	my $temp_queue = [];  | 
