aboutsummaryrefslogtreecommitdiff
path: root/SBO-Lib/lib/SBO/Lib.pm
diff options
context:
space:
mode:
authorJacob Pipkin <j@dawnrazor.net>2012-11-16 22:22:02 -0600
committerJacob Pipkin <j@dawnrazor.net>2012-11-16 22:22:02 -0600
commit3d5dd514a8f536e7747783a0f52e1da19a20eb8d (patch)
tree8505aede4f7a82200b2b37872bf1ec17916032f0 /SBO-Lib/lib/SBO/Lib.pm
parent167298b834386219c491d70c87af7a2130b09e39 (diff)
parent51b62ac5d35bc6a8987dd34ab896a0308a49dec4 (diff)
downloadsbotools2-3d5dd514a8f536e7747783a0f52e1da19a20eb8d.tar.xz
testing branch git-merge'd
Diffstat (limited to 'SBO-Lib/lib/SBO/Lib.pm')
-rw-r--r--SBO-Lib/lib/SBO/Lib.pm160
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 = [];