Merge branch 'master' of github.com:pink-mist/sbotools

1 files changed, 111 insertions, 111 deletions

diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index 358ea15..57a6c48 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -5,8 +5,9 @@
 # Lib.pm
 # shared functions for the sbo_ scripts.
 #
-# authors:	Jacob Pipkin <j@dawnrazor.net>
-#			Luke Williams <xocel@iquidus.org>
+# authors:  Jacob Pipkin <j@dawnrazor.net>
+#           Luke Williams <xocel@iquidus.org>
+#           Andreas Guldstrand <andreas.guldstrand@gmail.com>
 # license: WTFPL <http://sam.zoy.org/wtfpl/COPYING>
 
 use 5.16.0;
@@ -364,25 +365,24 @@ sub get_from_info {
 	}
 	state $store = {PRGNAM => ['']};
 	my $sbo = get_sbo_from_loc($args{LOCATION});
-	return $$store{$args{GET}} if $$store{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, $exit) = open_read("$args{LOCATION}/$sbo.info");
 	return() if $exit;
 	# suck it all in, clean it all up, stuff it all in $store.
 	my $contents = do {local $/; <$fh>};
 	$contents =~ s/("|\\\n)//g;
-	$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 %$store) {
-		if ($$store{$key} =~ /\s/) {
-			my @array = split ' ', $$store{$key};
-			$$store{$key} = \@array;
-		} else {
-			$$store{$key} = [$$store{$key}];
-		}
+	my $last_key = '';
+	$store = {};
+	foreach my $line (split /\n/, $contents) {
+		my ($key, $val) = $last_key;
+		if ($line =~ /^([^=\s]+)=(.*)$/) { $key = $1; $val = $2; }
+		elsif ($line =~ /^\s+([^\s].+)$/) {            $val = $1; }
+		else { script_error("error when parsing $sbo.info file. Line: $line") }
+		push @{ $store->{$key} }, ($val ? split(' ', $val) : $val);
+		$last_key = $key;
 	}
-	return exists $$store{$args{GET}} ? $$store{$args{GET}} : undef;
+	return $store->{$args{GET}};
 }
 
 # find the version in the tree for a given sbo (provided a location)
@@ -504,13 +504,13 @@ sub verify_distfile {
 # 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 {
-	exists $_[1] or script_error('get_distfile requires an argument');
+	exists $_[1] or script_error('get_distfile requires two arguments');
 	my ($link, $info_md5) = @_;
 	my $filename = get_filename_from_link($link);
 	mkdir $distfiles unless -d $distfiles;
 	chdir $distfiles;
 	unlink $filename if -f $filename;
-	if (system("wget --no-check-certificate \"$link\"") != 0) {
+	if (system('wget', '--no-check-certificate', $link) != 0) {
 		return "Unable to wget $link.\n", _ERR_DOWNLOAD;
 	}
 	# can't do anything if the link in the .info doesn't lead to a good d/l
@@ -937,33 +937,33 @@ sub get_requires {
 }
 
 sub _uniq {
-    my %seen;
-    return grep { !$seen{$_}++ } @_;
+	my %seen;
+	return grep { !$seen{$_}++ } @_;
 }
 
 sub _build_queue {
-    my ($sbos, $warnings) = @_;
-    my @queue = @$sbos;
-    my @result;
-
-    while (my $sbo = shift @queue) {
-        next if $sbo eq "%README%";
-        my $reqs = get_requires($sbo);
-        if (defined $reqs) {
-            push @result, _build_queue($reqs, $warnings);
-            foreach my $req (@$reqs) {
-                $warnings->{$sbo}="%README%" if $req eq "%README%";
-            }
-        }
-        push @result, $sbo;
-    }
-
-    return _uniq @result;
+	my ($sbos, $warnings) = @_;
+	my @queue = @$sbos;
+	my @result;
+
+	while (my $sbo = shift @queue) {
+		next if $sbo eq "%README%";
+		my $reqs = get_requires($sbo);
+		if (defined $reqs) {
+			push @result, _build_queue($reqs, $warnings);
+			foreach my $req (@$reqs) {
+				$warnings->{$sbo}="%README%" if $req eq "%README%";
+			}
+		}
+		push @result, $sbo;
+	}
+
+	return _uniq @result;
 }
 
 sub get_build_queue {
-    exists $_[1] or script_error('get_build_queue requires two arguments.');
-    return [ _build_queue(@_) ];
+	exists $_[1] or script_error('get_build_queue requires two arguments.');
+	return [ _build_queue(@_) ];
 }
 
 sub merge_queues {
@@ -971,7 +971,7 @@ sub merge_queues {
 	# Results in queue_b being merged into queue_a (without duplicates)
 	exists $_[1] or script_error('merge_queues requires two arguments.');
 
-    return [ _uniq @{$_[0]}, @{$_[1]} ];
+	return [ _uniq @{$_[0]}, @{$_[1]} ];
 }
 
 sub get_readme_contents {
@@ -1012,55 +1012,55 @@ sub get_installed_cpans {
 
 # look for any (user|group)add commands in the README
 sub get_user_group {
-    exists $_[0] or script_error('get_user_group requires an argument');
-    my $readme = shift;
-    my @cmds = $readme =~ /^\s*#*\s*(useradd.*|groupadd.*)/mg;
-    return \@cmds;
+	exists $_[0] or script_error('get_user_group requires an argument');
+	my $readme = shift;
+	my @cmds = $readme =~ /^\s*#*\s*(useradd.*|groupadd.*)/mg;
+	return \@cmds;
 }
 
 # offer to run any user/group add commands
 sub ask_user_group {
-    exists $_[1] or script_error('ask_user_group requires two arguments');
-    my ($cmds, $readme) = @_;
-    say "\n". $readme;
-    print "\nIt looks like this slackbuild requires the following";
-    say ' command(s) to be run first:';
-    say "    # $_" for @$cmds;
-    print 'Shall I run them prior to building? [y] ';
+	exists $_[1] or script_error('ask_user_group requires two arguments');
+	my ($cmds, $readme) = @_;
+	say "\n". $readme;
+	print "\nIt looks like this slackbuild requires the following";
+	say ' command(s) to be run first:';
+	say "    # $_" for @$cmds;
+	print 'Shall I run them prior to building? [y] ';
 	return <STDIN> =~ /^[Yy\n]/ ? $cmds : undef;
 }
 
 # see if the README mentions any options
 sub get_opts {
-    exists $_[0] or script_error('get_opts requires an argument');
-    my $readme = shift;
-    return $readme =~ /[A-Z0-9]+=[^\s]/ ? 1 : undef;
+	exists $_[0] or script_error('get_opts requires an argument');
+	my $readme = shift;
+	return $readme =~ /[A-Z0-9]+=[^\s]/ ? 1 : undef;
 }
 
 # provide an opportunity to set options
 sub ask_opts {
-    exists $_[0] or script_error('ask_opts requires an argument');
-    my ($sbo, $readme) = @_;
-    say "\n". $readme;
-    print "\nIt looks like $sbo has options; would you like to set any";
-    print ' when the slackbuild is run? [n] ';
-    if (<STDIN> =~ /^[Yy]/) {
-        my $ask = sub {
-            print "\nPlease supply any options here, or enter to skip: ";
-            chomp(my $opts = <STDIN>);
-            return() if $opts =~ /^\n/;
-            return $opts;
-        };
-        my $kv_regex = qr/[A-Z0-9]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/;
-        my $opts = $ask->();
-        return() unless $opts;
-        while ($opts !~ $kv_regex) {
-            warn "Invalid input received.\n";
-            $opts = $ask->();
-        }
-        return $opts;
-    }
-    return();
+	exists $_[0] or script_error('ask_opts requires an argument');
+	my ($sbo, $readme) = @_;
+	say "\n". $readme;
+	print "\nIt looks like $sbo has options; would you like to set any";
+	print ' when the slackbuild is run? [n] ';
+	if (<STDIN> =~ /^[Yy]/) {
+		my $ask = sub {
+			print "\nPlease supply any options here, or enter to skip: ";
+			chomp(my $opts = <STDIN>);
+			return() if $opts =~ /^\n/;
+			return $opts;
+		};
+		my $kv_regex = qr/[A-Z0-9]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/;
+		my $opts = $ask->();
+		return() unless $opts;
+		while ($opts !~ $kv_regex) {
+			warn "Invalid input received.\n";
+			$opts = $ask->();
+		}
+		return $opts;
+	}
+	return();
 }
 
 # for a given sbo, check for cmds/opts, prompt the user as appropriate
@@ -1099,7 +1099,7 @@ sub process_sbos {
 		NON_INT		=> 0,
 		@_
 	);
-    my $todo = $args{TODO};
+	my $todo = $args{TODO};
 	my $cmds = $args{CMDS};
 	my $opts = $args{OPTS};
 	my $locs = $args{LOCATIONS};
@@ -1129,22 +1129,22 @@ sub process_sbos {
 		}
 	}
 	my $count = 0 unless $args{NON_INT};
-    FIRST: for my $sbo (@$todo) {
+	FIRST: for my $sbo (@$todo) {
 		$count++;
 		my $options = 0;
 		$options = $$opts{$sbo} if defined $$opts{$sbo};
 		my $cmds = $$cmds{$sbo} if defined $$cmds{$sbo};
 		for my $cmd (@$cmds) {
-		    system($cmd) == 0 or warn "\"$cmd\" exited non-zero\n";
+			system($cmd) == 0 or warn "\"$cmd\" exited non-zero\n";
 		}
 		# switch compat32 on if upgrading/installing a -compat32
 		# else make sure compat32 is off
 		my $compat32 = $sbo =~ /-compat32$/ ? 1 : 0;
 		my ($version, $pkg, $src, $exit) = do_slackbuild(
-		    OPTS    => $options,
-		    JOBS    => $jobs,
-		    LOCATION  => $$locs{$sbo},
-		    COMPAT32  => $compat32,
+			OPTS      => $options,
+			JOBS      => $jobs,
+			LOCATION  => $$locs{$sbo},
+			COMPAT32  => $compat32,
 		);
 		if ($exit) {
 			my $fail = $version;
@@ -1164,36 +1164,36 @@ sub process_sbos {
 			}
 		}
 
-	    do_upgradepkg($pkg) unless $args{NOINSTALL};
-
-	    unless ($args{DISTCLEAN}) {
-	        make_clean(SBO => $sbo, SRC => $src, VERSION => $version)
-	            unless $args{NOCLEAN};
-	    } else {
-	        make_distclean(
-	            SBO     => $sbo,
-	            SRC     => $src,
-	            VERSION   => $version,
-	            LOCATION  => $$locs{$sbo},
-	        );
-	    }
-	    # move package to $config{PKG_DIR} if defined
-        unless ($config{PKG_DIR} eq 'FALSE') {
-            my $dir = $config{PKG_DIR};
-            unless (-d $dir) {
-                mkdir($dir) or warn "Unable to create $dir\n";
-            }
-            if (-d $dir) {
-                move($pkg, $dir), say "$pkg stored in $dir";
-            } else {
-                warn "$pkg left in $tmpd\n";
-            }
-        } elsif ($args{DISTCLEAN}) {
-            unlink $pkg;
-        }
-    }
+		do_upgradepkg($pkg) unless $args{NOINSTALL};
+
+		unless ($args{DISTCLEAN}) {
+			make_clean(SBO => $sbo, SRC => $src, VERSION => $version)
+				unless $args{NOCLEAN};
+		} else {
+			make_distclean(
+				SBO       => $sbo,
+				SRC       => $src,
+				VERSION   => $version,
+				LOCATION  => $$locs{$sbo},
+			);
+		}
+		# move package to $config{PKG_DIR} if defined
+		unless ($config{PKG_DIR} eq 'FALSE') {
+			my $dir = $config{PKG_DIR};
+			unless (-d $dir) {
+				mkdir($dir) or warn "Unable to create $dir\n";
+			}
+			if (-d $dir) {
+				move($pkg, $dir), say "$pkg stored in $dir";
+			} else {
+				warn "$pkg left in $tmpd\n";
+			}
+		} elsif ($args{DISTCLEAN}) {
+			unlink $pkg;
+		}
+	}
 	unlink for @symlinks;
-    return \@failures, $exit;
+	return \@failures, $exit;
 }
 
 # subroutine to print out failures
@@ -1204,5 +1204,5 @@ sub print_failures {
 		for my $failure (@$failures) {
 			warn "  $_: $$failure{$_}" for keys %$failure;
 		}
-    }
+	}
 }